diff --git a/bin/numabind_core_slurm b/bin/numabind_core_slurm
new file mode 100755
index 0000000000000000000000000000000000000000..f78124c9243ef034a2d4245d1c307fad59c2e987
--- /dev/null
+++ b/bin/numabind_core_slurm
@@ -0,0 +1,23 @@
+#!/bin/bash
+#NB_CORE=128
+Numactl='numactl'
+export IP=${SLURM_PROCID}
+
+if [ "x${IP}" != "x" ]
+then
+export LIP=${SLURM_LOCALID}
+export NP=${SLURM_NTASKS}
+export NN=${SLURM_NNODES}
+export NPN=$(( NP / NN ))
+export NB_CORE=${SLURM_JOB_CPUS_PER_NODE/(*)/}
+export NPC=$(( NB_CORE / NPN ))
+CORE=$(( LIP * NPC ))
+#echo IP=${IP} LIP=${LIP} NP=${NP} NN=${NN} NPN=${NPN} NPC=${NPC} HOST=`hostname` NB_CORE=${NB_CORE} CORE=${CORE}
+#
+# execution
+#
+exec ${Numactl} --physcpubind ${CORE} $*
+else
+exec ${Numactl} --physcpubind 0 $*
+fi
+
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index a56b264904c6332d208e916679d483f2cead2f9d..082ab6328083801e8ddd309de81db5d265bb516e 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2016-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2016-2020 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.
@@ -3756,6 +3756,9 @@ IF (.NOT.LFIELDLIST_ISINIT) THEN
RETURN
END IF
!
+if (kfrom > nmodel_allocated .or. kto > nmodel_allocated ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'FIELDLIST_GOTO_MODEL', 'kfrom or kto > nmodel_allocated' )
+!
! Initialize some pointers
!
!PW: TODO: check if still necessary as XRHODREFZ and XTHVREFZ are now initialiazed in ini_modeln even for KMI/=1 (29/01/2019)
diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90
index 9a2d05b6d6fe372ce51c922e91b467e545ed0b0b..ea98b0eedf5fd44edf7545347799c28335388319 100644
--- a/src/LIB/SURCOUCHE/src/mode_ga.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ga.f90
@@ -9,6 +9,7 @@
! J. Escobar 05/02/2015: use JPHEXT from MODD_PARAMETERS_ll
! P. Wautelet 14/12/2018: split from fmwrit_ll.f90
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! J. Escobar 11/02/2020: for GA, add some sync, & reduce size of MA heap <-> not used
!-----------------------------------------------------------------
#ifdef MNH_GA
MODULE MODE_GA
@@ -20,11 +21,11 @@ MODULE MODE_GA
INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3
!
INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
- integer :: heap=5*10**6, stack
+ integer :: heap=1*10**5, stack
logical :: gstatus_ga
INTEGER, PARAMETER :: ndim_GA = 3
INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA
- INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1
+ INTEGER,PARAMETER :: CI= 1 ,CJ=-1 ,CK=-1
INTEGER :: g_a
integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col
integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan
@@ -68,6 +69,8 @@ MODULE MODE_GA
call ga_initialize()
END IF
+ call ga_sync()
+
CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
IIU_ll = NIMAX_ll + 2*JPHEXT
IJU_ll = NJMAX_ll + 2*JPHEXT
@@ -92,9 +95,11 @@ MODULE MODE_GA
! reallocate the g_a , if need with bigger Z size
!
IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a)
+ call ga_sync()
IIU_ll_MAX = IIU_ll
IJU_ll_MAX = IJU_ll
IKU_ll_MAX = IKU_ll
+ !print*,"MNH_INIT_GA::nga_create=",MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a ; call flush(6)
gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
call ga_sync()
END IF
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index 4f3904e3d8d404b917a10cd9672e0833a34aba12..8e99f41615836f06432eb9b8836b2938882c9697 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -15,6 +15,7 @@
! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_byname_N3 and IO_Field_read_byfield_N3)
+! J. Escobar 11/02/2020: for GA & // IO, add update_halo + sync, & mpi_allreduce for error handling in // IO
!-----------------------------------------------------------------
MODULE MODE_IO_FIELD_READ
@@ -339,6 +340,11 @@ USE MODE_GA
USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
+#ifdef MNH_GA
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_ll , ONLY : ADD2DFIELD_ll,UPDATE_HALO_ll,CLEANLIST_ll
+#endif
+!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
@@ -355,7 +361,9 @@ INTEGER :: IHEXTOT
REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
#ifdef MNH_GA
-REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+TYPE(LIST_ll) ,POINTER :: TZFIELD_ll
+INTEGER :: IINFO_ll
#endif
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
@@ -435,16 +443,23 @@ IF (IRESP==0) THEN
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TPFIELD%CMNHNAME ; call flush(6)
call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
- call ga_sync
+ call ga_sync()
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ NULLIFY(TZFIELD_ll)
+ CALL ADD2DFIELD_ll(TZFIELD_ll,PFIELD )
+ CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELD_ll)
DEALLOCATE(ZFIELD_GA)
#else
! XY Scatter Field
@@ -501,6 +516,7 @@ USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
+USE MODI_GET_HALO
#endif
USE MODE_IO_TOOLS, ONLY: IO_Level2filenumber_get
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
@@ -516,7 +532,7 @@ TYPE TX_2DP
REAL,DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
!
-INTEGER :: IERR,IRESP,IRESP_TMP
+INTEGER :: IERR,IRESP,IRESP_TMP,IRESP_ISP
INTEGER :: IHEXTOT
INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
INTEGER :: JI,IXO,IXE,IYO,IYE
@@ -631,7 +647,8 @@ IF (IRESP==0) THEN
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
- DO JKK=1,IKU_ll
+ IRESP_ISP=0
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
TZFIELD = TPFIELD
@@ -659,6 +676,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
END IF
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T1)
TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
!
@@ -666,25 +684,30 @@ IF (IRESP==0) THEN
!
LO_ZPLAN(JPIZ) = JKK
HI_ZPLAN(JPIZ) = JKK
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TZFIELD%CMNHNAME ; call flush(6)
CALL NGA_PUT(G_A, LO_ZPLAN, HI_ZPLAN,ZSLICE_LL, LD_ZPLAN)
END IF
TZFILE => NULL()
END DO
- CALL GA_SYNC
+ CALL GA_SYNC()
!
- CALL MPI_BCAST(IRESP_TMP,1,MNHINT_MPI,IK_RANK-1,TZFILE%NMPICOMM,IERR)
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MNHINT_MPI,MPI_MIN,TPFILE%NMPICOMM,IRESP)
IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
CALL NGA_GET(G_A, LO_COL, HI_COL,ZFIELD_GA(1,1,1) , LD_COL)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ CALL GET_HALO(PFIELD)
DEALLOCATE(ZFIELD_GA)
#else
ALLOCATE(ZSLICE_ll(0,0))
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
INB_PROC_REAL = MIN(TPFILE%NSUBFILES_IOZ,ISNPROC)
ALLOCATE(REQ_TAB((ISNPROC-1)*INB_PROC_REAL))
ALLOCATE(T_TX2DP((ISNPROC-1)*INB_PROC_REAL))
@@ -725,6 +748,7 @@ IF (IRESP==0) THEN
ELSE IF (TZFILE%CFORMAT=='LFICDF4') THEN
CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
END IF
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T1)
TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
DO JI = 1,ISNPROC
@@ -745,8 +769,6 @@ IF (IRESP==0) THEN
TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
END IF
!
- CALL MPI_BCAST(IRESP_TMP,1,MNHINT_MPI,IK_RANK-1,TZFILE%NMPICOMM,IERR)
- IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
TZFILE => NULL()
END DO
!
@@ -808,6 +830,8 @@ IF (IRESP==0) THEN
DEALLOCATE(T_TX2DP)
DEALLOCATE(REQ_TAB)
!
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MNHINT_MPI,MPI_MIN,TPFILE%NMPICOMM,IRESP)
+ IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!Broadcast header only if IRESP==-111
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 1f02a2694aabd0ec0e22f4e69209b440d8ddf990..e90deedc52bde60629024130e015ef22bcbe33de 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -13,6 +13,7 @@
! P. Wautelet 12/04/2019: added pointers for C1D, L1D, N1D, X5D and X6D structures in TFIELDDATA
! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
! P. Wautelet 12/07/2019: add support for 1D array of dates
+! J. Escobar 11/02/2020: for GA & // IO, add sync, & mpi_allreduce for error handling in // IO
!-----------------------------------------------------------------
#define MNH_SCALARS_IN_SPLITFILES 0
@@ -592,8 +593,10 @@ CONTAINS
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
ZFIELD_GA = PFIELD
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
- call ga_sync
+ call ga_sync()
DEALLOCATE (ZFIELD_GA)
IF (ISP == TPFILE%NMASTER_RANK) THEN
!
@@ -601,6 +604,7 @@ CONTAINS
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
#else
@@ -692,7 +696,7 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ INTEGER :: IRESP,IRESP_ISP,IRESP_TMP
REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -800,6 +804,11 @@ CONTAINS
RETURN
END IF
!
+ ! Write the variable attributes in the non-split file
+ !
+ if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ call IO_Field_header_split_write_nc4( tpfile, tpfield, size( pfield, 3 ) )
+ !
!JUAN BG Z SLICE
!
!
@@ -814,23 +823,21 @@ CONTAINS
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
ZFIELD_GA = PFIELD
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
+ call ga_sync()
DEALLOCATE(ZFIELD_GA)
- call ga_sync
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
!
- ! Write the variable attributes in the non-split file
- !
- if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
- call IO_Write_field_header_split_nc4( tpfile, tpfield, size( pfield, 3 ) )
- !
! write the data
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
!
- DO JKK=1,IKU_ll
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
!
IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
@@ -849,12 +856,14 @@ CONTAINS
!
lo_zplan(JPIZ) = JKK
hi_zplan(JPIZ) = JKK
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM,JKK ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZSLICE_ll, ld_zplan)
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
!
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -868,6 +877,7 @@ CONTAINS
!
ALLOCATE(ZSLICE_ll(0,0))
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
INB_PROC_REAL = MIN(TPFILE%NSUBFILES_IOZ,ISNPROC)
Z_SLICE: DO JK=1,SIZE(PFIELD,3),INB_PROC_REAL
!
@@ -922,7 +932,7 @@ CONTAINS
!
! Write the variable attributes in the non-split file
!
- if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ if ( tpfile%nmaster_rank == isp .and. gnc4 ) &
call IO_Field_header_split_write_nc4( tpfile, tpfield, size( pfield, 3 ) )
!
! write the data
@@ -958,8 +968,9 @@ CONTAINS
END DO
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -978,6 +989,8 @@ CONTAINS
!JUAN BG Z SLICE
! end of MNH_GA
#endif
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MNHINT_MPI,MPI_MIN,TPFILE%NMPICOMM,IRESP)
+ IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
END IF ! multiprocesses execution
END IF
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 3beae194e79cd286494ed66c91f4aa40b070aa27..ad3d23d18a6dc71144b0cadca6fb6cbab319d911 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -16,6 +16,8 @@
! P. Wautelet 18/02/2019: bugfixes for nsubfiles_ioz
! P. Wautelet 05/03/2019: rename IO subroutines and modules
! P. Wautelet 12/03/2019: add TMAINFILE field in TFILEDATA
+! P. Wautelet 11/02/2020: bugfix: TDADFILE was wrongly constructed for output files
+! S. Donnier 28/02/2020: type STREAM needed for use of ECOCLIMAP SG
!-----------------------------------------------------------------
MODULE MODE_IO_MANAGE_STRUCT
!
@@ -255,7 +257,7 @@ DO IMI = 1, NMODEL
IF (IDX>0) THEN
OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD = IDX
WRITE (YDADNUMBER,FMT="('.',I3.3)") OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD
- OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE => OUT_MODEL(NDAD(IMI))%TBACKUPN(IDX)%TFILE
+ OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE => OUT_MODEL(NDAD(IMI))%TOUTPUTN(IDX)%TFILE
ELSE
OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD = -1
NULLIFY(OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE) !No dad file
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index 7fa766ccd96a2c9fd729efe0267a839efb40c242..c1c7c8c58508fa174249a3d5adbf62873763ab9c 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -17,6 +17,7 @@
! + no more process coordination for Z-split files
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
! P. Wautelet 19/09/2019: temporary workaround for netCDF bug if MNH_INT=8 (if netCDF fortran < 4.4.5)
+! P. Wautelet 11/02/2020: add 'dims' attribute in IO_Write_field_header_split_nc4
!-----------------------------------------------------------------
#ifdef MNH_IOCDF4
module mode_io_write_nc4
@@ -133,6 +134,10 @@ if ( istatus /= NF90_NOERR ) then
if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_header_split_write_nc4', 'NF90_PUT_ATT', &
'ndims for '//trim( tpfield%cmnhname ) )
+ istatus = NF90_PUT_ATT( incid, ivarid,'dims', ishape )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_header_split_write_nc4', 'NF90_PUT_ATT', &
+ 'dims for '//trim( tpfield%cmnhname ) )
+
if ( tpfield%ltimedep ) then
istatus = NF90_PUT_ATT( incid, ivarid,'time_dependent', 'yes' )
else
diff --git a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90 b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
index b10e2eea94b404e947df4e57f4a9c5ac5240c8b4..6a405483dbf3e11d5446d4f2db9ab0457babf08d 100644
--- a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
@@ -8,6 +8,7 @@
! P. Wautelet 03/10/2017: set IP and NPROC in INIT_NMNH_COMM_WORLD
! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
! P. Wautelet 21/11/2019: bugfix: close call could be done on a non-opened file
+! J. Escobar 11/02/2020: For GA , replace MPI_INIT_THREAD -> MPI_INIT
!-----------------------------------------------------------------
MODULE MODE_MNH_WORLD
IMPLICIT NONE
@@ -50,7 +51,7 @@ CONTAINS
CALL MPI_INITIALIZED(GISINIT, KINFO_ll)
IF (.NOT. GISINIT) THEN
#ifdef MNH_GA
- CALL MPI_INIT_thread(REQUIRED,PROVIDED,KINFO_ll)
+ CALL MPI_INIT(KINFO_ll)
#else
CALL MPI_INIT(KINFO_ll)
#endif
diff --git a/src/MNH/advecmet.f90 b/src/MNH/advecmet.f90
index 527febf154254736b76fc2d418571901ca7731a8..f165f3e06fb01afd306867a53d73898214c54798 100644
--- a/src/MNH/advecmet.f90
+++ b/src/MNH/advecmet.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -157,12 +157,10 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
!* 0.2 Declarations of local variables :
!
INTEGER :: JRR ! Loop index for moist variables
-INTEGER :: IKU
!
!
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
!* 1. COMPUTES THE ADVECTIVE TENDENCIES
! ---------------------------------
!
@@ -176,7 +174,7 @@ PRTHS(:,:,:) = PRTHS(:,:,:) &
!IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVY_BU_RTH')
!
PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM (1,IKU,1,PTHT(:,:,:)) )
+ -DZF( PRWCT(:,:,:) * MZM (PTHT(:,:,:)) )
!IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVZ_BU_RTH')
!
! Case with KRR moist variables
@@ -208,7 +206,7 @@ END DO
!
DO JRR=1,KRR
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM (1,IKU,1,PRT(:,:,:,JRR)) )
+ -DZF( PRWCT(:,:,:) * MZM (PRT(:,:,:,JRR)) )
END DO
!
!IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'ADVZ_BU_RRV')
@@ -230,7 +228,7 @@ IF (SIZE(PTKET,1) /= 0) THEN
! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVY_BU_RTKE')
!
PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM (1,IKU,1,PTKET(:,:,:)) )
+ -DZF( PRWCT(:,:,:) * MZM (PTKET(:,:,:)) )
! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVZ_BU_RTKE')
END IF
!
diff --git a/src/MNH/advecmet_4th.f90 b/src/MNH/advecmet_4th.f90
index 57ab588ade20114634aa7ff2e600891319bd0042..261ac95237afee599c8c4fdaf5da39cc1918422c 100644
--- a/src/MNH/advecmet_4th.f90
+++ b/src/MNH/advecmet_4th.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2020 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.
@@ -194,7 +194,6 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
INTEGER :: JRR ! Loop index for moist variables
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-INTEGER :: IKU
!
LOGICAL :: GTKEALLOC ! true if TKE arrays are not zero-sized
!
@@ -211,7 +210,6 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZMEANX, ZMEANY ! flux
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
GTKEALLOC = SIZE(PTKET,1) /= 0
-IKU=SIZE(XZHAT)
!
!-------------------------------------------------------------------------------
!
@@ -239,7 +237,7 @@ PRTHS(:,:,:) = PRTHS(:,:,:) &
!IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVY_BU_RTH')
!
PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM4(PTHT(:,:,:)) )
+ -DZF( PRWCT(:,:,:) * MZM4(PTHT(:,:,:)) )
!IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVZ_BU_RTH')
!
! Turbulence variables
@@ -262,7 +260,7 @@ IF ( GTKEALLOC ) THEN
! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVY_BU_RTKE')
!
PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM4(PTKET(:,:,:)) )
+ -DZF( PRWCT(:,:,:) * MZM4(PTKET(:,:,:)) )
! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVZ_BU_RTKE')
ENDIF
!
@@ -299,7 +297,7 @@ DO JRR=1, KRR
! IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),NBUDGET_RH,'ADVY_BU_RRH')
!
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM4(PRT(:,:,:,JRR)) )
+ -DZF( PRWCT(:,:,:) * MZM4(PRT(:,:,:,JRR)) )
! IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'ADVZ_BU_RRV')
! IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'ADVZ_BU_RRC')
! IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),NBUDGET_RR,'ADVZ_BU_RRR')
diff --git a/src/MNH/advecscalar.f90 b/src/MNH/advecscalar.f90
index 0efc3342f2d9ec36ab4de1745739d8b92d4ebddc..fa353914ed8751aa65d4e0b66f6741a30f3b51aa 100644
--- a/src/MNH/advecscalar.f90
+++ b/src/MNH/advecscalar.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -124,7 +124,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
!* 0.2 Declarations of local variables :
!
INTEGER :: JSV ! Loop index for Scalar Variables
-INTEGER :: IKU
!
!
!-------------------------------------------------------------------------------
@@ -132,8 +131,6 @@ INTEGER :: IKU
!* 1. COMPUTES THE ADVECTIVE TENDENCIES
! ---------------------------------
!
-IKU=SIZE(XZHAT)
-!
! Case with KSV Scalar Variables
DO JSV=1,KSV
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
@@ -157,7 +154,7 @@ END IF
!
DO JSV=1,KSV
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM (1,IKU,1, PSVT(:,:,:,JSV)) )
+ -DZF( PRWCT(:,:,:) * MZM (PSVT(:,:,:,JSV)) )
END DO
IF (LBUDGET_SV) THEN
DO JSV=1,KSV
diff --git a/src/MNH/advecscalar_4th.f90 b/src/MNH/advecscalar_4th.f90
index 2e0821a6b00395724e8b0ff0023d3587ac91ad7f..ce3082347400323f4f13ff31d3d4c9bcf2916015 100644
--- a/src/MNH/advecscalar_4th.f90
+++ b/src/MNH/advecscalar_4th.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###############################
@@ -156,7 +156,6 @@ TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
!
INTEGER :: IGRID ! localisation on the model grid
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZMEANX, ZMEANY ! fluxes
-INTEGER :: IKU
!
!-------------------------------------------------------------------------------
!
@@ -164,7 +163,6 @@ INTEGER :: IKU
! ------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-IKU=SIZE(XZHAT)
!
!-------------------------------------------------------------------------------
!
@@ -195,7 +193,7 @@ DO JSV=1,KSV
! IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+NBUDGET_SV1-1,'ADVY_BU_RSV')
!
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF(1,IKU,1, PRWCT(:,:,:) * MZM4(PSVT(:,:,:,JSV)) )
+ -DZF( PRWCT(:,:,:) * MZM4(PSVT(:,:,:,JSV)) )
! IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+NBUDGET_SV1-1,'ADVZ_BU_RSV')
ENDDO
!
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 4d1e9d9235681ed902c54e3cfb0a38420ac54a85..b99acba7d2ae4635b61085896a81382c21cb1703 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -138,6 +138,7 @@ END MODULE MODI_ADVECTION_METSV
!! the surface for the blowing snow scheme
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -154,6 +155,8 @@ USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAM_LIMA
USE MODD_PARAM_n
USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_BLOWSNOW
@@ -258,7 +261,7 @@ REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NBLOWSNOW_2D) :: ZRSNWCS_
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1,ZRHOX2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1,ZRHOY2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1,ZRHOZ2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR
! Temporary advected rhodj for PPM routines
!
INTEGER :: JS,JR,JSV,JSPL, JI, JJ ! Loop index
@@ -689,37 +692,154 @@ if ( lbudget_sv) then
end do
end if
-IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
+if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
+ if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
+ if (lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
+ if (lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
+ if (lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEADV', prrs (:, :, :, 3) )
+ if (lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEADV', prrs (:, :, :, 4) )
+ if (lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEADV', prrs (:, :, :, 5) )
+ if (lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEADV', prrs (:, :, :, 6) )
+ if (lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEADV', prrs (:, :, :, 7) )
+end if
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NEADV', prsvs(:, :, :, nsv_lima_nc) )
+ if ( lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NEADV', prsvs(:, :, :, nsv_lima_nr) )
+ if ( lcold ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NEADV', prsvs(:, :, :, nsv_lima_ni) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NEADV', prsvs(:, :, :, ji) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NEADV', prsvs(:, :, :, ji) )
+ end do
+end if
- ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
- ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
- ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
- ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+SELECT CASE ( HCLOUD )
+ CASE('ICE3','ICE4')
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ WHERE (PRRS(:,:,:,4) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,4)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,4) = 0.
+ END WHERE
+!
+! cloud
+ WHERE (PRRS(:,:,:,2) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,2) = 0.
+ END WHERE
+!
+! if rc or ri are positive, we can correct negative rv
+! cloud
+ WHERE ((PRRS(:,:,:,1) <0.) .AND. (PRRS(:,:,:,2)> 0.) )
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,2) = 0.
+ END WHERE
+! ice
+ IF(KRR > 3) THEN
+ WHERE ((PRRS(:,:,:,1) < 0.).AND.(PRRS(:,:,:,4) > 0.))
+ ZCOR(:,:,:)=MIN(-PRRS(:,:,:,1),PRRS(:,:,:,4))
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZCOR(:,:,:)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) -ZCOR(:,:,:)
+ END WHERE
+ END IF
+!
+ CASE('C2R2','KHKO')
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
! CALL GET_HALO(PRRS(:,:,:,2))
! CALL GET_HALO(PRSVS(:,:,:,2))
! CALL GET_HALO(PRSVS(:,:,:,3))
- WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
- PRSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
- PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
- END WHERE
- END DO
-
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
-END IF
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
+ PRSVS(:,:,:,1) = 0.0
+ END WHERE
+ DO JSV = 2, 3
+ WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,JSV) = 0.0
+ PRSVS(:,:,:,JSV) = 0.0
+ END WHERE
+ END DO
+ !
+ CASE('LIMA')
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+! Correction where rc<0 or Nc<0
+ IF (LWARM) THEN
+ WHERE (PRRS(:,:,:,2) < XRTMIN(2)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NC) < XCTMIN(2)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,2) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ END WHERE
+ END IF
+! Correction where rr<0 or Nr<0
+ IF (LWARM .AND. LRAIN) THEN
+ WHERE (PRRS(:,:,:,3) < XRTMIN(3)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NR) < XCTMIN(3)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,3)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,3) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,3) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+ END IF
+! Correction where ri<0 or Ni<0
+ IF (LCOLD) THEN
+ WHERE (PRRS(:,:,:,4) < XRTMIN(4)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NI) < XCTMIN(4)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,4)
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRRS(:,:,:,4) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ END WHERE
+ END IF
+!
+ PRSVS(:,:,:,:) = MAX( 0.0,PRSVS(:,:,:,:) )
+ PRRS(:,:,:,:) = MAX( 0.0,PRRS(:,:,:,:) )
+!
+END SELECT
+if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
+ if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEADV', prths(:, :, :) )
+ if (lbudget_rv) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEADV', prrs (:, :, :, 1) )
+ if (lbudget_rc) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEADV', prrs (:, :, :, 2) )
+ if (lbudget_rr) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEADV', prrs (:, :, :, 3) )
+ if (lbudget_ri) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEADV', prrs (:, :, :, 4) )
+ if (lbudget_rs) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEADV', prrs (:, :, :, 5) )
+ if (lbudget_rg) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEADV', prrs (:, :, :, 6) )
+ if (lbudget_rh) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEADV', prrs (:, :, :, 7) )
+end if
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NEADV', prsvs(:, :, :, nsv_lima_nc) )
+ if ( lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NEADV', prsvs(:, :, :, nsv_lima_nr) )
+ if ( lcold ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NEADV', prsvs(:, :, :, nsv_lima_ni) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), 'NEADV', prsvs(:, :, :, ji) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), 'NEADV', prsvs(:, :, :, ji) )
+ end do
+end if
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 596990fd7726b994457ce87aed044a3933d5a6dc..64a497958d0296f788ea7d87e77af64a9a9c0485 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -176,7 +176,6 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
INTEGER :: ISPLIT ! Number of splitting loops
INTEGER :: JSPL ! Loop index
REAL :: ZTSTEP ! Sub Time step
-INTEGER :: IIU, IJU, IKU ! array sizes
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
@@ -191,14 +190,9 @@ TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
!
IKE = SIZE(PWT,3) - JPVEXT
!
-IIU = SIZE(PWT,1)
-IJU = SIZE(PWT,2)
-IKU = SIZE(PWT,3)
-!
-!
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
-ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+ZMZM_RHODJ = MZM(PRHODJ)
if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index cb828e7443367ed648d0bfbcbb08355d98bd42f9..62787ea599d91b6def85a40a70d94cb1b97a3fd3 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -169,24 +169,17 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-INTEGER :: IKU
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
!
!-------------------------------------------------------------------------------
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKU = SIZE(XZHAT)
-IKB=1+JPVEXT
-IKE=IKU-JPVEXT
-
if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
-ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+ZMZM_RHODJ = MZM(PRHODJ)
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
! -------------------------------------
diff --git a/src/MNH/advecuvw.f90 b/src/MNH/advecuvw.f90
index 3ad38e2ec32cb5eebdaa7ec97d52df8ac6d31fdc..91a4fb5eb5a5c2c5278f36de0e8118759df58945 100644
--- a/src/MNH/advecuvw.f90
+++ b/src/MNH/advecuvw.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -129,13 +129,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
!
-INTEGER :: IKU
-!
-!
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
-!
!* 1. COMPUTES THE ADVECTIVE TENDANCIES
! ---------------------------------
!
@@ -148,8 +143,8 @@ PRUS(:,:,:) = PRUS(:,:,:) &
!IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'ADVY_BU_RU')
!
PRUS(:,:,:) = PRUS(:,:,:) &
- -DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM(1,IKU,1,PUT(:,:,:)) )
-!IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'ADVZ_BU_RU')
+ -DZF( MXM(PRWCT(:,:,:))*MZM(PUT(:,:,:)) )
+!IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU')
!
!
PRVS(:,:,:) = PRVS(:,:,:) &
@@ -161,21 +156,21 @@ PRVS(:,:,:) = PRVS(:,:,:) &
!IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADVY_BU_RV')
!
PRVS(:,:,:) = PRVS(:,:,:) &
- -DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM(1,IKU,1,PVT(:,:,:)) )
-!IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADVZ_BU_RV')
+ -DZF( MYM(PRWCT(:,:,:))*MZM(PVT(:,:,:)) )
+!IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV')
!
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(1,IKU,1,PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
-!IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADVX_BU_RW')
+ -DXF( MZM(PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
+!IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW')
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(1,IKU,1,PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
-!IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADVY_BU_RW')
+ -DYF( MZM(PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
+!IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW')
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF(1,IKU,1,PWT(:,:,:)) )
-!IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADVZ_BU_RW')
+ -DZM( MZF(PRWCT(:,:,:))*MZF(PWT(:,:,:)) )
+!IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW')
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advecuvw_2nd.f90 b/src/MNH/advecuvw_2nd.f90
index 9b0999450cbd6da96e0c9b934fb38d51e9a47bde..a8313c2f5e94de2a323694ca77fb9c364b3eab6f 100644
--- a/src/MNH/advecuvw_2nd.f90
+++ b/src/MNH/advecuvw_2nd.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 adiab 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_ADVECUVW_2ND
! ####################
@@ -117,13 +112,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
!
-INTEGER :: IKU
-!
-!
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
-!
!* 1. COMPUTES THE ADVECTIVE TENDANCIES
! ---------------------------------
!
@@ -134,7 +124,7 @@ PRUS(:,:,:) = PRUS(:,:,:) &
-DYF( MXM(PRVCT(:,:,:))*MYM(PUT(:,:,:)) )
!
PRUS(:,:,:) = PRUS(:,:,:) &
- -DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM(1,IKU,1,PUT(:,:,:)) )
+ -DZF( MXM(PRWCT(:,:,:))*MZM(PUT(:,:,:)) )
!
!
PRVS(:,:,:) = PRVS(:,:,:) &
@@ -144,17 +134,17 @@ PRVS(:,:,:) = PRVS(:,:,:) &
-DYM( MYF(PRVCT(:,:,:))*MYF(PVT(:,:,:)) )
!
PRVS(:,:,:) = PRVS(:,:,:) &
- -DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM(1,IKU,1,PVT(:,:,:)) )
+ -DZF( MYM(PRWCT(:,:,:))*MZM(PVT(:,:,:)) )
!
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(1,IKU,1,PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
+ -DXF( MZM(PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(1,IKU,1,PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
+ -DYF( MZM(PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF(1,IKU,1,PWT(:,:,:)) )
+ -DZM( MZF(PRWCT(:,:,:))*MZF(PWT(:,:,:)) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index 468515c425232c47bac036f26b642220c6ff9968..546f079c47ed5250daf1dc2707f9149ce663fa93 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2020 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 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 adiab 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
MODULE MODI_ADVECUVW_4TH
! ###########################
@@ -143,10 +138,6 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
!* 0.2 Declarations of local variables :
!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-INTEGER :: IKU
-!
TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
!
INTEGER :: IGRID ! localisation on the model grid
@@ -154,14 +145,6 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
!
!-------------------------------------------------------------------------------
!
-!* 1. COMPUTES THE DOMAIN DIMENSIONS
-! ------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-IKU=SIZE(XZHAT)
-!-------------------------------------------------------------------------------
-!
!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR MOMENTUM
! --------------------------------------------------
!
@@ -181,7 +164,7 @@ PRUS(:,:,:) = PRUS(:,:,:) &
-DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRUS(:,:,:) = PRUS(:,:,:) &
- -DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
+ -DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
!
!
IGRID = 3
@@ -200,7 +183,7 @@ PRVS(:,:,:) = PRVS(:,:,:) &
-DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRVS(:,:,:) = PRVS(:,:,:) &
- -DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
+ -DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
!
!
IGRID = 4
@@ -214,13 +197,13 @@ IGRID = 4
!!$ENDIF
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(1,IKU,1,PRUCT(:,:,:))*ZMEANX(:,:,:) )
+ -DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(1,IKU,1,PRVCT(:,:,:))*ZMEANY(:,:,:) )
+ -DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!
PRWS(:,:,:) = PRWS(:,:,:) &
- -DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
+ -DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advecuvw_weno_k.f90 b/src/MNH/advecuvw_weno_k.f90
index 44c2dd4a6fb2f4ebeb03412205f591bd94f562ea..704b470ea32641ce4f8d9b266bcd78965c8175b1 100644
--- a/src/MNH/advecuvw_weno_k.f90
+++ b/src/MNH/advecuvw_weno_k.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###########################
MODULE MODI_ADVECUVW_WENO_K
! ###########################
@@ -98,10 +99,6 @@ INTEGER :: IINFO_ll ! return code of parallel routine
!
REAL, DIMENSION(SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3)) :: ZMEAN, ZWORK
!
-INTEGER :: K_SCHEME
-INTEGER :: IKU
-INTEGER :: IWORK
-!
!------------------------- ADVECTION OF MOMENTUM ------------------------------
!
!
@@ -109,7 +106,6 @@ TZHALO2_UT => TPHALO2LIST ! 1rst add3dfield in model_n
TZHALO2_VT => TPHALO2LIST%NEXT ! 2nd add3dfield in model_n
TZHALO2_WT => TPHALO2LIST%NEXT%NEXT ! 3rst add3dfield in model_n
!
-IKU=SIZE(PUT,3)
! -------------------------------------------------------
!
SELECT CASE(KWENO_ORDER)
@@ -122,7 +118,7 @@ CASE(1) ! WENO 1
!
PRUS = PRUS - DYF(UP_MY(PUT,MXM(PRVCT)))
!
- PRUS = PRUS - DZF(1,IKU,1,UP_MZ(PUT,MXM(PRWCT)))
+ PRUS = PRUS - DZF(UP_MZ(PUT,MXM(PRWCT)))
!
! V component
!
@@ -130,15 +126,15 @@ CASE(1) ! WENO 1
!
PRVS = PRVS - DYM(UP_VY(PVT,MYF(PRVCT)))
!
- PRVS = PRVS - DZF(1,IKU,1,UP_MZ(PVT,MYM(PRWCT)))
+ PRVS = PRVS - DZF(UP_MZ(PVT,MYM(PRWCT)))
!
! W component
!
- PRWS = PRWS - DXF(UP_MX(PWT,MZM(1,IKU,1,PRUCT)))
+ PRWS = PRWS - DXF(UP_MX(PWT,MZM(PRUCT)))
!
- PRWS = PRWS - DYF(UP_MY(PWT,MZM(1,IKU,1,PRVCT)))
+ PRWS = PRWS - DYF(UP_MY(PWT,MZM(PRVCT)))
!
- PRWS = PRWS - DZM(1,IKU,1,UP_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+ PRWS = PRWS - DZM(UP_WZ(PWT,MZF(PRWCT)))
!
!
CASE(3) ! WENO 3
@@ -156,7 +152,7 @@ CASE(3) ! WENO 3
PRUS = PRUS - DYF(ZMEAN)
END IF
!
- PRUS = PRUS - DZF(1,IKU,1,WENO_K_2_MZ(PUT, MXM(PRWCT)))
+ PRUS = PRUS - DZF(WENO_K_2_MZ(PUT, MXM(PRWCT)))
!
! V component
!
@@ -169,22 +165,22 @@ CASE(3) ! WENO 3
CALL ADVEC_WENO_K_2_VY(HLBCY, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2)
PRVS = PRVS - DYM(ZMEAN)
!
- PRVS = PRVS - DZF(1,IKU,1,WENO_K_2_MZ(PVT, MYM(PRWCT)))
+ PRVS = PRVS - DZF(WENO_K_2_MZ(PVT, MYM(PRWCT)))
END IF
!
! W component
!
- ZWORK = MZM(1,IKU,1,PRUCT)
+ ZWORK = MZM(PRUCT)
CALL ADVEC_WENO_K_2_MX(HLBCX, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
PRWS = PRWS - DXF(ZMEAN)
!
IF (.NOT.L2D) THEN
- ZWORK = MZM(1,IKU,1,PRVCT)
+ ZWORK = MZM(PRVCT)
CALL ADVEC_WENO_K_2_MY(HLBCY, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
PRWS = PRWS - DYF(ZMEAN)
END IF
!
- PRWS = PRWS - DZM(1,IKU,1,WENO_K_2_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+ PRWS = PRWS - DZM(WENO_K_2_WZ(PWT,MZF(PRWCT)))
!
!
CASE(5) ! WENO 5
@@ -205,7 +201,7 @@ CASE(5) ! WENO 5
!
ZMEAN = WENO_K_3_MZ(PUT, MXM(PRWCT))
CALL GET_HALO(ZMEAN)! Update HALO - maybe not necessary (T.Lunet)
- PRUS = PRUS - DZF(1,IKU,1,ZMEAN)
+ PRUS = PRUS - DZF(ZMEAN)
!
! V component, only called in 3D case
!
@@ -223,27 +219,27 @@ CASE(5) ! WENO 5
!
ZMEAN = WENO_K_3_MZ(PVT, MYM(PRWCT))
CALL GET_HALO(ZMEAN)! Update HALO - maybe not necessary (T.Lunet)
- PRVS = PRVS - DZF(1,IKU,1,ZMEAN)
+ PRVS = PRVS - DZF(ZMEAN)
!
END IF
!
! W component
!
- ZWORK = MZM(1,IKU,1,PRUCT)
+ ZWORK = MZM(PRUCT)
CALL ADVEC_WENO_K_3_MX(HLBCX, PWT, ZWORK, ZMEAN)
CALL GET_HALO(ZMEAN)! Update HALO
PRWS = PRWS - DXF(ZMEAN)
!
IF (.NOT.L2D) THEN! 3D Case
- ZWORK = MZM(1,IKU,1,PRVCT)
+ ZWORK = MZM(PRVCT)
CALL ADVEC_WENO_K_3_MY(HLBCY, PWT, ZWORK, ZMEAN)
CALL GET_HALO(ZMEAN)! Update HALO
PRWS = PRWS - DYF(ZMEAN)
END IF
!
- ZMEAN = WENO_K_3_WZ(PWT,MZF(1,IKU,1,PRWCT))
+ ZMEAN = WENO_K_3_WZ(PWT,MZF(PRWCT))
CALL GET_HALO(ZMEAN)! Update HALO - maybe not necessary (T.Lunet)
- PRWS = PRWS - DZM(1,IKU,1,ZMEAN)
+ PRWS = PRWS - DZM(ZMEAN)
!
!
END SELECT
diff --git a/src/MNH/anel_balancen.f90 b/src/MNH/anel_balancen.f90
index 21c83f052591ee0cf8e0540429d0a661075c3a58..743c5b5c7f57048cb103e29372c2e9748c70dd21 100644
--- a/src/MNH/anel_balancen.f90
+++ b/src/MNH/anel_balancen.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -233,7 +233,7 @@ CALL MPPDB_CHECK3D(XWT,"anel_balancen3.1-after update halo::XWT",PRECISION)
!
ZRU(:,:,:) = MXM(XRHODJ) * XUT(:,:,:)
ZRV(:,:,:) = MYM(XRHODJ) * XVT(:,:,:)
-ZRW(:,:,:) = MZM(1,IKU,1,XRHODJ) * XWT(:,:,:)
+ZRW(:,:,:) = MZM(XRHODJ) * XWT(:,:,:)
ZTH(:,:,:) = XTHT(:,:,:)
ALLOCATE(ZRR(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),SIZE(XRT,4)))
ZRR(:,:,:,:) = XRT(:,:,:,:)
@@ -288,7 +288,7 @@ DEALLOCATE(ZBFY,ZTRIGSX,ZTRIGSY,ZRR,ZBF_SXP2_YP1_Z)
!20131112 appli update_halo_ll and associated operations
XUT(:,:,:) = ZRU(:,:,:) / MXM(XRHODJ)
XVT(:,:,:) = ZRV(:,:,:) / MYM(XRHODJ)
-XWT(:,:,:) = ZRW(:,:,:) / MZM(1,IKU,1,XRHODJ)
+XWT(:,:,:) = ZRW(:,:,:) / MZM(XRHODJ)
!20131112 appli update_halo_ll to XUT,XVT,XWT
CALL ADD3DFIELD_ll( TZFIELDS_ll, XUT, 'ANEL_BALANCE_n::XUT' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, XVT, 'ANEL_BALANCE_n::XVT' )
diff --git a/src/MNH/anti_diff.f90 b/src/MNH/anti_diff.f90
index d2dd37c190ac49f5609a93e584eaacb99e87d2ce..56372bfeccbfd1529118443c2bcef1ecc3f89675 100644
--- a/src/MNH/anti_diff.f90
+++ b/src/MNH/anti_diff.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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 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 adiab 2006/12/12 15:06:20
-!-----------------------------------------------------------------
! ##########################
MODULE MODI_ANTI_DIFF
! ##########################
@@ -156,44 +151,44 @@ IKE=IKU-JPVEXT
(MXM(PAS(:,:,:))+ZEPSILON)
ZB(:,:,:)=PRAVCT(:,:,:)*DYM(PAS(:,:,:)/PRHODJ(:,:,:))/ &
(MYM(PAS(:,:,:))+ZEPSILON)
- ZC(:,:,:)=PRAWCT(:,:,:)*DZM(1,IKU,1,PAS(:,:,:)/PRHODJ(:,:,:))/ &
- (MZM(1,IKU,1,PAS(:,:,:))+ZEPSILON)
+ ZC(:,:,:)=PRAWCT(:,:,:)*DZM(PAS(:,:,:)/PRHODJ(:,:,:))/ &
+ (MZM(PAS(:,:,:))+ZEPSILON)
!
! 1.2 Calculation antidiffusion velocities
! ------------------------------------
!
! u-component antidiffusive velocity
!
- PRAUCT(:,:,:)=PTSTEP/2.* ( &
+ PRAUCT(:,:,:)=PTSTEP/2.* ( &
ZA*( &
MXM(PRHODJ)*SIGN(1.,PRAUCT) &
/ZDBLTST- &
PRAUCT &
)- &
- PRAUCT*MXM(MYF(ZB)+MZF(1,IKU,1,ZC)) &
+ PRAUCT*MXM(MYF(ZB)+MZF(ZC)) &
)
!
! v-component antidiffusive velocity
!
- PRAVCT(:,:,:)=PTSTEP/2.* ( &
+ PRAVCT(:,:,:)=PTSTEP/2.* ( &
ZB*( &
MYM(PRHODJ)*SIGN(1.,PRAVCT) &
/ZDBLTST- &
PRAVCT &
)- &
- PRAVCT*MYM(MXF(ZA)+MZF(1,IKU,1,ZC)) &
+ PRAVCT*MYM(MXF(ZA)+MZF(ZC)) &
)
!
!
! w-component antidiffusive velocity
!
- PRAWCT(:,:,:)=PTSTEP/2.* ( &
+ PRAWCT(:,:,:)=PTSTEP/2.* ( &
ZC*( &
- MZM(1,IKU,1,PRHODJ)*SIGN(1.,PRAWCT) &
+ MZM(PRHODJ)*SIGN(1.,PRAWCT) &
/ZDBLTST- &
PRAWCT &
)- &
- PRAWCT*MZM(1,IKU,1,MXF(ZA)+MYF(ZB)) &
+ PRAWCT*MZM(MXF(ZA)+MYF(ZB)) &
)
!
! 1.3 Limit of the antidiffusive velocities to satisfy CFL<1
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index 2e28cb605cbceda8bc384f44e16d4b7f5e1501e3..a0095f8c355ebaf408bcee8d5bd4396754a85a59 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.f90
@@ -19,7 +19,7 @@ INTERFACE
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ, &
+ PRHODJ,PRHODREF, &
PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
!
REAL, INTENT(IN) :: PTSTEP ! time step dt
@@ -51,6 +51,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
@@ -71,7 +72,7 @@ END MODULE MODI_BOUNDARIES
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ, &
+ PRHODJ,PRHODREF, &
PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
! ####################################################################
!
@@ -173,7 +174,8 @@ END MODULE MODI_BOUNDARIES
!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
!! Modification 18/07/17 (Vionnet) Add blowing snow variables
-!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -195,6 +197,7 @@ USE MODD_BLOWSNOW_n
USE MODD_REF_n
USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
USE MODD_LBC_n, ONLY : XPOND
+USE MODD_GRID_n, ONLY : XZZ
!
USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND, LWARM, LCOLD
!
@@ -210,6 +213,8 @@ USE MODI_CH_BOUNDARIES
!
USE MODE_ll
!
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODI_SET_CONC_LIMA
!
IMPLICIT NONE
!
@@ -248,6 +253,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
@@ -310,6 +316,9 @@ LOGICAL :: GFFTMP
!
INTEGER :: JI,JJ
!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
+!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
@@ -969,7 +978,11 @@ END SELECT
END IF
!
!
-IF (CCLOUD == 'LIMA' .AND. IMI == 1) THEN
+IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
+
+ ZSVT=PSVT
+ ZRT=PRT
+
IF (GFIRSTCALLLIMA) THEN
ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
GFIRSTCALLLIMA = .FALSE.
@@ -981,23 +994,53 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1) THEN
IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
ENDDO
- ENDIF
+ ENDIF
+ CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
+ DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_CCN_FREE+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+ DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_IFN_FREE+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
- DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN from MACC
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_CCN_FREE+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
- DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN from MACC
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_IFN_FREE+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
+ CALL SET_CONC_LIMA('NONE',PRHODREF,ZRT,ZSVT)
+ IF (NSV_LIMA_NC.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NC)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
+ PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
+ PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
+ PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NR.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NR)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
+ PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
+ PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
+ PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NI.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NI)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
+ PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
+ PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
+ PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
+ ENDIF
+ END IF
+
+END IF
+!
!
IF (LUSECHEM .AND. IMI == 1) THEN
IF (GFIRSTCALL1) THEN
diff --git a/src/MNH/compute_exner_from_ground.f90 b/src/MNH/compute_exner_from_ground.f90
index cbb64d0376d42b3af52447f12503b78531513f23..60225dbf11bd04c14b13258431b8ffbfcc084e8d 100644
--- a/src/MNH/compute_exner_from_ground.f90
+++ b/src/MNH/compute_exner_from_ground.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 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.
@@ -150,7 +150,7 @@ ZGSCPD = XG/XCPD
!* 2. COMPUTATION OF THE EXNER FUNCTION AT FLUX POINTS
! ------------------------------------------------
!
-ZZM=MZF(1,IKU,1,PZFLUX)
+ZZM=MZF(PZFLUX)
PEXNFLUX(:,:,IKB)=PEXNSURF2D(:,:)
IF (LCARTESIAN .OR. LTHINSHELL) THEN
ZD1=0.
diff --git a/src/MNH/compute_exner_from_top.f90 b/src/MNH/compute_exner_from_top.f90
index e195e725de1cf4e020487bbf3f2de6e052415b76..4048672a15b4470c3aa6d6987e61d26f8d219b36 100644
--- a/src/MNH/compute_exner_from_top.f90
+++ b/src/MNH/compute_exner_from_top.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 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.
@@ -149,7 +149,7 @@ ZGSCPD = XG/XCPD
!* 2. COMPUTATION OF THE EXNER FUNCTION AT FLUX POINTS
! ------------------------------------------------
!
-ZZM=MZF(1,IKU,1,PZFLUX)
+ZZM=MZF(PZFLUX)
PEXNFLUX(:,:,IKE+1)=PEXNTOP2D(:,:)
IF (LCARTESIAN .OR. LTHINSHELL) THEN
ZD1=0.
diff --git a/src/MNH/compute_r00.f90 b/src/MNH/compute_r00.f90
index 855c8370861141e3424b9c672d3d0e4122d1a3b9..5b7c686508c5c690de357cfabbbd28710b36f0b6 100644
--- a/src/MNH/compute_r00.f90
+++ b/src/MNH/compute_r00.f90
@@ -113,7 +113,6 @@ LOGICAL :: GSTART
INTEGER :: INBR_START
REAL :: ZXMAX,ZYMAX,ZZMAX ! domain extrema
INTEGER, DIMENSION(100) :: NBRFILES
-INTEGER :: IKU
TYPE(TFIELDDATA) :: TZFIELD
TYPE(TFILEDATA),POINTER :: TZTRACFILE
!
@@ -124,7 +123,6 @@ TYPE(TFILEDATA),POINTER :: TZTRACFILE
!
TZTRACFILE => NULL()
ZSPVAL=-1.E+11
-IKU=SIZE(XZHAT)
!
!-------------------------------------------------------------------------------
!
@@ -193,7 +191,7 @@ ZXOR=0.5 * (XXHAT(2)+XXHAT(3))
ZYOR=0.5 * (XYHAT(2)+XYHAT(3))
ZDX= XXHAT(3)-XXHAT(2)
ZDY= XYHAT(3)-XYHAT(2)
-ZZL=MZF(1,IKU,1,XZZ)
+ZZL=MZF(XZZ)
ZZL(:,:,NKU)=2*XZZ(:,:,NKU)-ZZL(:,:,NKU-1)
ZXMAX=ZXOR+(NIU-3)*ZDX
ZYMAX=ZYOR+(NJU-3)*ZDY
diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90
index 8154936aa184ad41e9cbf27287af028c42cf315f..a5b30eff1e82af71bb0b62302f1a30666ad63bea 100644
--- a/src/MNH/contrav.f90
+++ b/src/MNH/contrav.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -70,9 +70,6 @@ END MODULE MODI_CONTRAV
!!
!! EXTERNAL
!! --------
-!! MXF, MYF, MZM : Shuman functions (mean operators)
-!!
-!! Module MODI_SHUMAN : Interface for Shuman functions
!!
!!
!! IMPLICIT ARGUMENTS
@@ -112,7 +109,6 @@ USE MODD_GRID_n, ONLY: XZZ
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODE_ll
!
-USE MODI_SHUMAN
USE MODI_GET_HALO
!
USE MODE_MPPDB
diff --git a/src/MNH/convection.f90 b/src/MNH/convection.f90
index 2738ac854fe50aabff8b02554b43b0c6f41b6c79..f80a0c0890a70519dac4d25e2daf92f70a644258 100644
--- a/src/MNH/convection.f90
+++ b/src/MNH/convection.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 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.
@@ -396,9 +396,9 @@ END IF
!* 1. Center all fields on thermo levels
! ----------------------------------
!
-ZWORK(:,:,:) = MZF(1,IKU,1, PZZ(:,:,:) )
+ZWORK(:,:,:) = MZF( PZZ(:,:,:) )
ZZZ(:,:,:) = ZWORK(:,:,:)
-ZWORK(:,:,:) = MZF(1,IKU,1, PWT(:,:,:) )
+ZWORK(:,:,:) = MZF( PWT(:,:,:) )
ZWT(:,:,:) = ZWORK(:,:,:)
ZWORK(:,:,:) = MXF( PUT(:,:,:) )
ZUT(:,:,:) = ZWORK(:,:,:)
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index dc3107d54dd4857b1857c4a2692638d4e9a4c3c8..113521daf887dcd7e673028de0a58f81dc1aa64b 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -455,9 +455,6 @@ IF ( ALLOCATED(XUFRC) .AND. KCALL == 4 ) THEN
DEALLOCATE(XGYTHFRC)
DEALLOCATE(XPGROUNDFRC)
END IF
-IF ( ALLOCATED(XWTFRC) .AND. KCALL == 4 ) THEN
- DEALLOCATE(XWTFRC)
-END IF
!
!* 12. Module MODD_ICE_CONC$n
!
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 38c7bba55cb86e02d0f9edc6ad19b085f384dacf..934b3447a3e135da7947c7fb823d1907f91b83fa 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -229,6 +229,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!!
!-------------------------------------------------------------------------------
!
@@ -272,7 +273,8 @@ USE MODD_SALT
USE MODD_PASPOL
USE MODD_CONDSAMP
USE MODD_MEAN_FIELD
-USE MODD_DRAGTREE
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
!
!
USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS,&
@@ -544,6 +546,12 @@ VSIGQSAT = 0.02
LDRAGTREE = .FALSE.
LDEPOTREE = .FALSE.
XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/dflux_corr.f90 b/src/MNH/dflux_corr.f90
index 20b2b79cbce459f9f3a16947abb5d81c2246d97f..fec030ec7aa25c9434f803dea97a2853cf983a1d 100644
--- a/src/MNH/dflux_corr.f90
+++ b/src/MNH/dflux_corr.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 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.
@@ -204,7 +204,7 @@ PFY(:,:,:) = (0.5+SIGN(0.5,PRVCT(:,:,:)))*MIN( PFY(:,:,:),ZFOUT(:,:,:) ) &
ZFOUT(:,:,2:IKU) = -ZBETAOUT(:,:,1:IKU-1) ! Second limiter
ZFOUT(:,:,1) = 0.0
!
-PFZ(:,:,:) = PRWCT(:,:,:) * MZM (1,IKU,1,PAT(:,:,:))
+PFZ(:,:,:) = PRWCT(:,:,:) * MZM (PAT(:,:,:))
PFZ(:,:,:) = (0.5+SIGN(0.5,PRWCT(:,:,:)))*MIN( PFZ(:,:,:),ZFOUT(:,:,:) ) &
+(0.5-SIGN(0.5,PRWCT(:,:,:)))*MAX( PFZ(:,:,:),ZBETAOUT(:,:,:) )
!
diff --git a/src/MNH/diagnos_les_mf.f90 b/src/MNH/diagnos_les_mf.f90
index 31fa13da74a1fc2c0444f1495a15a465801a4214..f537b04f36ac1617a2b8590e1deee9cdd8d0ed52 100644
--- a/src/MNH/diagnos_les_mf.f90
+++ b/src/MNH/diagnos_les_mf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2020 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.
@@ -151,83 +151,83 @@ CALL SECOND_MNH2(ZTIME1)
ZWORK(:,:,:)=RESHAPE(PWTHMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT(MZF(1,KKU,1,ZWORK) ,ZTHLMFFLX_LES )
+ CALL LES_VER_INT(MZF(ZWORK) ,ZTHLMFFLX_LES )
CALL LES_MEAN_ll(ZTHLMFFLX_LES,LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WTHLMF(:,NLES_CURRENT_TCOUNT,1))
ZWORK(:,:,:)=RESHAPE(PWRTMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZRTMFFLX_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZRTMFFLX_LES )
CALL LES_MEAN_ll (ZRTMFFLX_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WRTMF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PWUMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZUMFFLX_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZUMFFLX_LES )
CALL LES_MEAN_ll (ZUMFFLX_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WUMF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PWVMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZVMFFLX_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZVMFFLX_LES )
CALL LES_MEAN_ll (ZVMFFLX_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WVMF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PWTHVMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZTHVMFFLX_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZTHVMFFLX_LES )
CALL LES_MEAN_ll (ZTHVMFFLX_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PTHL_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZTHLUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZTHLUP_MF_LES )
CALL LES_MEAN_ll (ZTHLUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_THLUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PRT_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZRTUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZRTUP_MF_LES )
CALL LES_MEAN_ll (ZRTUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_RTUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PRV_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZRVUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZRVUP_MF_LES )
CALL LES_MEAN_ll (ZRVUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_RVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PRC_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZRCUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZRCUP_MF_LES )
CALL LES_MEAN_ll (ZRCUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_RCUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PRI_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZRIUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZRIUP_MF_LES )
CALL LES_MEAN_ll (ZRIUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_RIUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PEMF(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZEMF_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZEMF_MF_LES )
CALL LES_MEAN_ll (ZEMF_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_MASSFLUX(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PDETR(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZDETR_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZDETR_MF_LES )
CALL LES_MEAN_ll (ZDETR_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_DETR(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PENTR(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZENTR_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZENTR_MF_LES )
CALL LES_MEAN_ll (ZENTR_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_ENTR(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PW_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZWUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZWUP_MF_LES )
CALL LES_MEAN_ll (ZWUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_WUP_MF(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PFRAC_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZFRACUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZFRACUP_MF_LES )
CALL LES_MEAN_ll (ZFRACUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_FRACUP(:,NLES_CURRENT_TCOUNT,1) )
ZWORK(:,:,:)=RESHAPE(PTHV_UP(:,:),(/ KIU,KJU,KKU /) )
- CALL LES_VER_INT( MZF(1,KKU,1,ZWORK) ,ZTHVUP_MF_LES )
+ CALL LES_VER_INT( MZF(ZWORK) ,ZTHVUP_MF_LES )
CALL LES_MEAN_ll (ZTHVUP_MF_LES , LLES_CURRENT_CART_MASK, &
X_LES_SUBGRID_THVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
diff --git a/src/MNH/drag_bld.f90 b/src/MNH/drag_bld.f90
new file mode 100644
index 0000000000000000000000000000000000000000..02de3d18214954b08f6539e041d493dd5dcaeb90
--- /dev/null
+++ b/src/MNH/drag_bld.f90
@@ -0,0 +1,236 @@
+!MNH_LIC Copyright 2019-2020 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_DRAG_BLD
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE DRAG_BLD(PTSTEP, PUT, PVT, PTKET, PRHODJ, PZZ, PRUS, PRVS, PRTKES )
+ !
+ REAL, INTENT(IN) :: PTSTEP ! Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+ !
+ END SUBROUTINE DRAG_BLD
+
+ END INTERFACE
+
+END MODULE MODI_DRAG_BLD
+!
+! ###################################################################
+SUBROUTINE DRAG_BLD(PTSTEP, PUT, PVT, PTKET, PRHODJ, PZZ, PRUS, PRVS, PRTKES )
+ ! ###################################################################
+ !
+ !!**** *DRAG_BLD_n * -
+ !!
+ !! PURPOSE
+ !! -------
+ !
+ ! Drag force due to buildings
+ !
+ !!** METHOD
+ !! ------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! R. Schoetter
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 09/2019
+ !!---------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ USE MODD_CONF
+ USE MODD_CST
+ USE MODD_DRAGBLDG_n
+ USE MODD_DYN
+ USE MODD_DYN_n
+ USE MODD_GROUND_PAR
+ USE MODD_PGDFIELDS
+ USE MODD_NSV
+ USE MODI_MNHGET_SURF_PARAM_n
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ REAL, INTENT(IN) :: PTSTEP ! Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+ !
+ !* 0.2 Declarations of local variables :
+ !
+ INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
+ INTEGER :: JI, JJ, JK ! loop index
+ INTEGER :: INFO_ll
+ !
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
+ ZUS, ZVS, ZTKES, ZTKET
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZCDRAG, ZDENSITY
+ !
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZH_BUILD_PGD
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZWALL_O_HOR_PGD
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZFRAC_TOWN_PGD
+ !
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
+ ZH_BLD,ZF_BLD ! Building height, frontal density
+ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
+ !
+ !* 0.3 Initialization
+ !
+ IIU = SIZE(PUT,1)
+ IJU = SIZE(PUT,2)
+ IKU = SIZE(PUT,3)
+ !
+ ZUS (:,:,:) = 0.0
+ ZVS (:,:,:) = 0.0
+ ZTKES (:,:,:) = 0.0
+ !
+ ZH_BLD (:,:) = 0.
+ ZF_BLD (:,:) = 0.
+ !
+ ZCDRAG (:,:,:) = 0.
+ ZDENSITY (:,:,:) = 0.
+ !
+ ALLOCATE(ZFRAC_TOWN_PGD(IIU,IJU))
+ ALLOCATE(ZH_BUILD_PGD(IIU,IJU))
+ ALLOCATE(ZWALL_O_HOR_PGD(IIU,IJU))
+ !
+ ZFRAC_TOWN_PGD (:,:) = XUNDEF
+ ZH_BUILD_PGD (:,:) = XUNDEF
+ ZWALL_O_HOR_PGD (:,:) = XUNDEF
+ !
+ CALL MNHGET_SURF_PARAM_n( PTOWN=ZFRAC_TOWN_PGD, &
+ PBUILD_HEIGHT=ZH_BUILD_PGD, &
+ PWALL_O_HOR=ZWALL_O_HOR_PGD )
+ !
+ ! FIXME: Some values of ZFRAC_TOWN_PGD are 999. This is a bit strange since the
+ ! TOWN fraction should be defined everywhere.
+ ! It is set to 0.0 provisionally
+ !
+ WHERE(ZFRAC_TOWN_PGD(:,:).GT.1.0) ZFRAC_TOWN_PGD(:,:)=0.0
+ !
+ ! The values for wall density and building height are set to 0.0 where the Town fraction is 0.0
+ ! For the wall density this would not be necessary since it will be multiplied by the town
+ ! fraction anyway.
+ !
+ WHERE(ZFRAC_TOWN_PGD(:,:).EQ.0.0)
+ ZWALL_O_HOR_PGD(:,:) = 0.0
+ ZH_BUILD_PGD(:,:) = 0.0
+ ENDWHERE
+ !
+ ! For buildings, the frontal wall area density is calculated [m^2(walls facing the wind)/m^2]
+ ! The division by PI means that cylindrical buildings are assumed (circle perimeter = PI*D, circle frontal area = D)
+ ! [m^2(walls facing the wind)/m^2]=[m^2(wall)/m^2(town)*m^2(town)/m^2/PI]
+ ! It will be assumed that the frontal wall area is equally distributed with height (all buildings same height)
+ !
+ ZH_BLD(:,:) = ZH_BUILD_PGD(:,:)
+ ZF_BLD(:,:) = ZFRAC_TOWN_PGD(:,:)*ZWALL_O_HOR_PGD(:,:)/XPI
+ !
+ DEALLOCATE(ZFRAC_TOWN_PGD)
+ DEALLOCATE(ZH_BUILD_PGD)
+ DEALLOCATE(ZWALL_O_HOR_PGD)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
+ ! -------------------------------------
+ !
+ ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ ZTKET(:,:,:) = PTKET(:,:,:)
+ !-------------------------------------------------------------------------------
+ !
+ !* 1. Computations of wind tendency due to canopy drag
+ ! ------------------------------------------------
+ !
+ ! Ext = - Cdrag * u- * u- * Sv tree canopy drag
+ ! - u'w'(ground) * Sh horizontal surfaces (ground)
+ ! ------------------------------
+ !
+ DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for buildings
+ !
+ IF (ZH_BLD(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH_BLD(JI,JJ) ) THEN
+ !
+ ! FIXME: Check literature values for the drag coefficient here
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2
+ !
+ ! A uniform distribution of building heights is assumed
+ !
+ ZDENSITY(JI,JJ,JK) = ZF_BLD(JI,JJ) / ZH_BLD(JI,JJ)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ !
+ !* 1.2 Drag force by wall surfaces
+ ! ---------------------------
+ !
+ !* drag force by vertical surfaces
+ !
+ ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+ !
+ ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+ !
+ PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
+ !
+ PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
+ !
+ !* 3. Computations of TKE tendency due to canopy drag
+ ! ------------------------------------------------
+ !* 3.1 Creation of TKE by wake
+ ! -----------------------
+ !
+ ! from Kanda and Hino (1994)
+ !
+ ! Ext = + Cd * u+^3 * Sv/Vair vertical surfaces or trees
+ !
+ ! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
+ ! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
+ !
+ ZTKES(:,:,:) = ZTKET(:,:,:) + &
+ PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3
+ !
+ PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
+ !
+END SUBROUTINE DRAG_BLD
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index 4c7a185cfe8fd37c73b44376f32b39c3f0023557..30c901a69dd0f4b54f77617cdee7a60ae0fa5db8 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -27,16 +27,12 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
!
-!
-
END SUBROUTINE DRAG_VEG
END INTERFACE
@@ -73,7 +69,9 @@ SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
!! S. Donier 06/2015 : bug surface aerosols
!! C.Lac 07/2016 : Add droplet deposition
!! C.Lac 10/2017 : Correction on deposition
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! C. Lac 02/2020: correction missing condition for budget on RC and SV
!!---------------------------------------------------------------
!
!
@@ -115,15 +113,12 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
!
-!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
@@ -133,12 +128,12 @@ INTEGER :: JI, JJ, JK ! loop index
REAL, DIMENSION(:,:), ALLOCATABLE :: ZH_TREE_PGD ! surface cover types
REAL, DIMENSION(:,:), ALLOCATABLE :: ZLAI_PGD ! surface cover types
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
- ZWORK1, ZWORK2, ZWORK3, ZUT, ZVT, &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
ZUS, ZVS, ZTKES, ZTKET
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
ZCDRAG, ZDENSITY
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
- ZVH,ZLAI ! LAI, Vegetation height
+ ZH,ZLAI ! LAI, Vegetation height
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
:: GDEP
@@ -146,10 +141,6 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
!
!
-IIU = SIZE(PUT,1)
-IJU = SIZE(PUT,2)
-IKU = SIZE(PUT,3)
-
if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
@@ -160,18 +151,33 @@ if ( odepotree ) then
call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
end if
-ZVH(:,:)=0.
-ZLAI(:,:)=0.
-ZCDRAG(:,:,:)=0.
-ZDENSITY(:,:,:)=0.
+IIU = SIZE(PUT,1)
+IJU = SIZE(PUT,2)
+IKU = SIZE(PUT,3)
+!
+ZUS (:,:,:) = 0.0
+ZVS (:,:,:) = 0.0
+ZTKES (:,:,:) = 0.0
+!
+ZH (:,:) = 0.
+ZLAI (:,:) = 0.
+!
+ZCDRAG (:,:,:) = 0.
+ZDENSITY (:,:,:) = 0.
!
ALLOCATE(ZH_TREE_PGD(IIU,IJU))
ALLOCATE(ZLAI_PGD(IIU,IJU))
!
+ZH_TREE_PGD (:,:) = XUNDEF
+ZLAI_PGD (:,:) = XUNDEF
+!
CALL MNHGET_SURF_PARAM_n(PH_TREE=ZH_TREE_PGD,PLAI_TREE=ZLAI_PGD)
!
-ZVH(:,:)=ZH_TREE_PGD(:,:)
-ZLAI(:,:)=ZLAI_PGD(:,:)
+ZH (:,:) = ZH_TREE_PGD(:,:)
+ZLAI(:,:) = ZLAI_PGD(:,:)
+!
+WHERE ( ZH (:,:).GT.998.0 ) ZH (:,:) = 0.0
+WHERE ( ZLAI (:,:).GT.998.0 ) ZLAI (:,:) = 0.0
!
DEALLOCATE(ZH_TREE_PGD)
DEALLOCATE(ZLAI_PGD)
@@ -182,9 +188,9 @@ DEALLOCATE(ZLAI_PGD)
!* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
! -------------------------------------
!
-ZUT(:,:,:) = PUT(:,:,:)
-ZVT(:,:,:) = PVT(:,:,:)
-ZTKET(:,:,:) = PTKET(:,:,:)
+ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ZTKET(:,:,:) = PTKET(:,:,:)
!-------------------------------------------------------------------------------
!
!* 1. Computations of wind tendency due to canopy drag
@@ -199,35 +205,46 @@ ZTKET(:,:,:) = PTKET(:,:,:)
! ------------------------------
!
GDEP(:,:,:) = .FALSE.
+!
DO JJ=2,(IJU-1)
- DO JI=2,(IIU-1)
- IF (ZVH(JI,JJ) /= 0) THEN
- DO JK=2,(IKU-1)
- IF ((ZVH(JI,JJ)+PZZ(JI,JJ,2))<PZZ(JI,JJ,JK)) EXIT
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
- IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
- GDEP(JI,JJ,JK) = .TRUE.
- ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
- IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
- END IF
- ZCDRAG(JI,JJ,JK) = 0.2 !0.075
- ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (ZVH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
- ZVH(JI,JJ)**3)-&
- (0.30*((ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
- (ZVH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
- ZVH(JI,JJ), 0.)
-
-
- END DO
- END IF
- END DO
-END DO
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for vegetation
+ !
+ IF (ZH(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH(JI,JJ) ) THEN
+ !
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
+ IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
+ GDEP(JI,JJ,JK) = .TRUE.
+ ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
+ IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
+ ENDIF
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2 !0.075
+ ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (ZH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
+ ZH(JI,JJ)**3)-&
+ (0.30*((ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
+ (ZH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
+ ZH(JI,JJ), 0.)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ENDDO
+!
! To exclude the first vertical level already dealt in rain_ice or rain_c2r2_khko
GDEP(:,:,2) = .FALSE.
!
@@ -236,15 +253,15 @@ GDEP(:,:,2) = .FALSE.
!
!* drag force by vertical surfaces
!
-ZUS(:,:,:)= ZUT(:,:,:)/(1 + ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*PTSTEP &
- *SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
+ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
!
-ZVS(:,:,:)= ZVT(:,:,:)/(1 + ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*PTSTEP &
- *SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
+ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
!
-PRUS(:,:,:)=PRUS(:,:,:)+((ZUS(:,:,:)-ZUT(:,:,:))*PRHODJ(:,:,:))/PTSTEP
+PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
!
-PRVS(:,:,:)=PRVS(:,:,:)+((ZVS(:,:,:)-ZVT(:,:,:))*PRHODJ(:,:,:))/PTSTEP
+PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
!
IF (ODEPOTREE) THEN
ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
@@ -294,14 +311,11 @@ END IF
! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
!
-!ZTKES(:,:,:)= (ZTKET(:,:,:) + (ZCDRAG(:,:,:)* ZDENSITY(:,:,:) &
-! *(SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))**3)) /&
-! (1.+(2.*ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2)))
-ZTKES(:,:,:)= (ZTKET(:,:,:) + (ZCDRAG(:,:,:)* ZDENSITY(:,:,:) &
- *(SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))**3))*PTSTEP /&
- (1.+PTSTEP*ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
+ZTKES(:,:,:)= ( ZTKET(:,:,:) + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3 ) / &
+ ( 1. + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2))
!
-PRTKES(:,:,:)=PRTKES(:,:,:)+((ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP)
+PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index ad9f3773d84569ef947e06cf4b5ab0431430f5c6..efc0e518999897364ba4ef04a6a3461289d00189 100644
--- a/src/MNH/dyn_sources.f90
+++ b/src/MNH/dyn_sources.f90
@@ -242,28 +242,28 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
ELSE ! NO THINSHELL approximation
if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
- ZWORK3(:,:,:) = 1.0 / ( XRADIUS + MZF(1,IKU,1,PZZ(:,:,:)) )
+ ZWORK3(:,:,:) = 1.0 / ( XRADIUS + MZF(PZZ(:,:,:)) )
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU )
ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU )
CALL MPPDB_CHECK3DM("DYN_SOOURCES:ZWORK3,ZWORK1,ZWORK2",PRECISION,&
& ZWORK3,ZWORK1,ZWORK2,&
& MXM( MYF(ZRVT*PVT) * ZWORK2 * ZWORK3 ) , &
- & MXM( ( MYF(PVT) * ZWORK1 - MZF(1,IKU,1,PWT) ) * ZWORK3 ) ,&
- & MYF(PVT) * ZWORK1 - MZF(1,IKU,1,PWT) , &
- & MYF(PVT) , MZF(1,IKU,1,PWT) , MXM(PWT) , MYM(PWT) )
+ & MXM( ( MYF(PVT) * ZWORK1 - MZF(PWT) ) * ZWORK3 ) ,&
+ & MYF(PVT) * ZWORK1 - MZF(PWT) , &
+ & MYF(PVT) , MZF(PWT) , MXM(PWT) , MYM(PWT) )
CALL MPPDB_CHECK3DM("DYN_SOOURCES:SUITE",PRECISION,&
& MXM(ZRVT),MXM(PVT),MXM(PWT),MXM(ZWORK1),MXM(ZWORK2),MXM(ZWORK3) )
!
PRUS(:,:,:) = PRUS &
+ MXM( MYF(ZRVT*PVT) * ZWORK2 * ZWORK3 ) &
- + ZRUT * MXM( ( MYF(PVT) * ZWORK1 - MZF(1,IKU,1,PWT) ) * ZWORK3 )
+ + ZRUT * MXM( ( MYF(PVT) * ZWORK1 - MZF(PWT) ) * ZWORK3 )
!
PRVS(:,:,:) = PRVS &
- MYM( MXF(ZRUT*PUT) * ZWORK1 * ZWORK3 ) &
- - ZRVT * MYM( (MXF(PUT) * ZWORK2 + MZF(1,IKU,1,PWT) ) * ZWORK3 )
+ - ZRVT * MYM( (MXF(PUT) * ZWORK2 + MZF(PWT) ) * ZWORK3 )
!
PRWS(:,:,:) = PRWS &
- +MZM(1,IKU,1, ( MXF(ZRUT*PUT) + MYF(ZRVT*PVT) ) * ZWORK3 )
+ +MZM( ( MXF(ZRUT*PUT) + MYF(ZRVT*PVT) ) * ZWORK3 )
if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
END IF
@@ -293,11 +293,11 @@ IF (LCORIO) THEN
ZWORK1(:,:,:) = SPREAD( PCORIOX(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
ZWORK2(:,:,:) = SPREAD( PCORIOY(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
!
- PRUS(:,:,:) = PRUS - MXM( ZWORK2 * MZF(1,IKU,1,PWT) )
+ PRUS(:,:,:) = PRUS - MXM( ZWORK2 * MZF(PWT) )
!
- PRVS(:,:,:) = PRVS - MYM( ZWORK1 * MZF(1,IKU,1,PWT) )
+ PRVS(:,:,:) = PRVS - MYM( ZWORK1 * MZF(PWT) )
!
- PRWS(:,:,:) = PRWS + MZM( 1,IKU,1,ZWORK2 * MXF(PUT) + ZWORK1 * MYF(PVT) )
+ PRWS(:,:,:) = PRWS + MZM( ZWORK2 * MXF(PUT) + ZWORK1 * MYF(PVT) )
if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'COR', prws(:, :, :) )
END IF
@@ -341,8 +341,8 @@ IF( .NOT.L1D ) THEN
!
PRTHS(:,:,:) = PRTHS(:,:,:) + PRHODJ(:,:,:) &
* ( ( XRD + XRV * PRT(:,:,:,1) ) * ZCPD_OV_RD / ZWORK1(:,:,:) - 1. ) &
- * PTHT(:,:,:)/PEXNREF(:,:,:)*MZF(1,IKU,1,PWT(:,:,:))*(ZG_OV_CPD/PTHVREF(:,:,:) &
- -ZD1*4./7.*PEXNREF(:,:,:)/( XRADIUS+MZF(1,IKU,1,PZZ(:,:,:)) ))
+ * PTHT(:,:,:)/PEXNREF(:,:,:)*MZF(PWT(:,:,:))*(ZG_OV_CPD/PTHVREF(:,:,:) &
+ -ZD1*4./7.*PEXNREF(:,:,:)/( XRADIUS+MZF(PZZ(:,:,:)) ))
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
END IF
diff --git a/src/MNH/eddyUV_flux_one_wayn.f90 b/src/MNH/eddyUV_flux_one_wayn.f90
index e6cae0cb995d7ee6cd62aa4fb0fc074ddc764496..93c8fe46c51316c64ea58845e09213866a46fb96 100644
--- a/src/MNH/eddyUV_flux_one_wayn.f90
+++ b/src/MNH/eddyUV_flux_one_wayn.f90
@@ -96,7 +96,6 @@ INTEGER:: IDTRATIO_KMI_1 ! Ratio between the time step of the son and the model
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX2 ! Work array=Dad interpolated flux field
! on the son grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIV_UV! Work array=DIV of ZFLUX2
-INTEGER :: IKU
!
INTEGER :: IDIMX,IDIMY
INTEGER :: IID, IRESP
@@ -105,7 +104,6 @@ INTEGER :: IID, IRESP
!
! test of temporal synchronisation between the model 1 and the son KMI
!
-IKU=SIZE(XZHAT)
IDTRATIO_KMI_1=1
DO JMI=2,KMI
IDTRATIO_KMI_1=IDTRATIO_KMI_1*NDTRATIO(JMI)
@@ -138,7 +136,7 @@ IF (ISYNCHRO==1 .OR. IDTRATIO_KMI_1 == 1) THEN
ZFLUX2(IIE,:,:) = ZFLUX2(IIE-1,:,:)
ZFLUX2(IIE+1,:,:) = ZFLUX2(IIE,:,:)
- ZDIV_UV(:,:,:) = GX_U_M(1,IKU,1,ZFLUX2,XDXX,XDZZ,XDZX)
+ ZDIV_UV(:,:,:) = GX_U_M(ZFLUX2,XDXX,XDZZ,XDZX)
! Lateral boundary conditions
ZDIV_UV(IIB,:,:) =0.0
diff --git a/src/MNH/eddyUV_fluxn.f90 b/src/MNH/eddyUV_fluxn.f90
index 924e2dd2b67a7daa0c0d58ea21e97a2dc0c378b3..f4879b6031859028fd3dba4e8e23c4a87a52b070 100644
--- a/src/MNH/eddyUV_fluxn.f90
+++ b/src/MNH/eddyUV_fluxn.f90
@@ -209,7 +209,7 @@ ZCORIOZ(:,:,:)= SPREAD(XCORIOZ(:,:),3,IKU)
ZLAT3D(:,:,:) = SPREAD(XLAT(:,:),3,IKU)
!
! relative vorticity
-ZVOZ(:,:,:)=GX_V_UV(1,IKU,1,PVM,XDXX,XDZZ,XDZX)
+ZVOZ(:,:,:)=GX_V_UV(PVM,XDXX,XDZZ,XDZX)
ZVOZ(:,:,2)=ZVOZ(:,:,3)
ZVOZ(:,:,1)=ZVOZ(:,:,3)
!
@@ -422,7 +422,7 @@ PVU_FLUX_M(:,:,:) = ZUV_FLUX(:,:,:)
! -----------------------------
!
! Take the divergence of the momentum flux
-ZDIV_UV(:,:,:) = GX_U_M(1,IKU,1,ZUV_FLUX,XDXX,XDZZ,XDZX)
+ZDIV_UV(:,:,:) = GX_U_M(ZUV_FLUX,XDXX,XDZZ,XDZX)
! Lateral boundary conditions
ZDIV_UV(IIB,:,:)=0.0
diff --git a/src/MNH/eddy_flux_one_wayn.f90 b/src/MNH/eddy_flux_one_wayn.f90
index 14b7d035b08df04c37c8f162499a8c1e4ac67962..40773ec8d8d091754aa4856860b87bd7be004815 100644
--- a/src/MNH/eddy_flux_one_wayn.f90
+++ b/src/MNH/eddy_flux_one_wayn.f90
@@ -92,7 +92,6 @@ INTEGER:: IDTRATIO_KMI_1 ! Ratio between the time step of the son and the model
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX2 ! Work array=Dad interpolated flux field
! on the son grid
-INTEGER :: IKU
!
INTEGER :: IDIMX,IDIMY
INTEGER :: IID, IRESP
@@ -101,7 +100,6 @@ INTEGER :: IID, IRESP
!
! test of temporal synchronisation between the model 1 and the son KMI
!
-IKU=SIZE(XZHAT)
IDTRATIO_KMI_1=1
DO JMI=2,KMI
IDTRATIO_KMI_1=IDTRATIO_KMI_1*NDTRATIO(JMI)
@@ -126,7 +124,7 @@ IF (ISYNCHRO==1 .OR. IDTRATIO_KMI_1 == 1) THEN
HLBCX,HLBCY,TFIELDLIST(IID)%TFIELD_X3D(1)%DATA,ZFLUX2)
! operator GX_U_M used for gradient of v'T' (flux point) placed at a mass point
- XRTHS_EDDY_FLUX(:,:,:) = - XRHODJ(:,:,:)* GX_U_M(1,IKU,1,ZFLUX2,XDXX,XDZZ,XDZX)
+ XRTHS_EDDY_FLUX(:,:,:) = - XRHODJ(:,:,:)* GX_U_M(ZFLUX2,XDXX,XDZZ,XDZX)
! w'T' (EDDY_FLUX_MODEL(1)%XWTH_FLUX_M) of model1 interpolation on the son grid put into ZFLUX2
ZFLUX2 = 0.
@@ -139,7 +137,7 @@ IF (ISYNCHRO==1 .OR. IDTRATIO_KMI_1 == 1) THEN
! DIV(W'T') put into the source term
XRTHS_EDDY_FLUX(:,:,:) = XRTHS_EDDY_FLUX(:,:,:) &
- - XRHODJ(:,:,:)* GZ_W_M(1,IKU,1,ZFLUX2,XDZZ)
+ - XRHODJ(:,:,:)* GZ_W_M(ZFLUX2,XDZZ)
DEALLOCATE(ZFLUX2)
diff --git a/src/MNH/eddy_fluxn.f90 b/src/MNH/eddy_fluxn.f90
index aa3148e7c226c5c0633dd8bf52e56aa4bca45ee3..ed52def268d0ea872591a158078514d3fef3316e 100644
--- a/src/MNH/eddy_fluxn.f90
+++ b/src/MNH/eddy_fluxn.f90
@@ -230,7 +230,7 @@ ZBETA(:,:,:) = GX_M_U(1,IKU,1,ZCORIOZ(:,:,:),XDXX,XDZZ,XDZX)
ZCORIOZ(:,:,:)= MXM(ZCORIOZ(:,:,:))
! Dry Brunt Vaisal frequency
-ZWORK32(:,:,:)=DZM(1,IKU,1,PTHM(:,:,:))/ MZM(1,IKU,1,PTHM(:,:,:))
+ZWORK32(:,:,:)=DZM(PTHM(:,:,:))/ MZM(PTHM(:,:,:))
DO JK=1,(IKE+1)
DO JJ=1,(IJE+1)
DO JI=1,(IIE+1)
@@ -245,7 +245,7 @@ ENDDO
ZND(:,:,:) = MXM(ZND(:,:,:))
!! latitudinal gradient of TH
ZDTHM_DY(:,:,:) = GX_M_U(1,IKU,1,PTHM,XDXX,XDZZ,XDZX)
-ZDTHM_DZ(:,:,:) = MXM(GZ_M_M(1,IKU,1,PTHM,XDZZ))
+ZDTHM_DZ(:,:,:) = MXM(GZ_M_M(PTHM,XDZZ))
! density scale height
ZH(:,:,:) = PTHM(:,:,:) * XRD * (XG**(-1))
ZH(:,:,:) = MXM(ZH)
@@ -430,9 +430,9 @@ ENDIF
! --------------------
! operator GX_U_M used for gradient of v'T' (flux point) placed at a mass point
!
-ZDIV_YTHFLUX(:,:,:) = GX_U_M(1,IKU,1,ZVTH_FLUX,XDXX,XDZZ,XDZX)
+ZDIV_YTHFLUX(:,:,:) = GX_U_M(ZVTH_FLUX,XDXX,XDZZ,XDZX)
!
-ZDIV_ZTHFLUX(:,:,:) = GZ_W_M(1,IKU,1,ZWTH_FLUX,XDZZ)
+ZDIV_ZTHFLUX(:,:,:) = GZ_W_M(ZWTH_FLUX,XDZZ)
!
! Control test for the sign of the flux
diff --git a/src/MNH/elec_fieldn.f90 b/src/MNH/elec_fieldn.f90
index ee38a7d922012e96176c2fc8e7394fa9d2915386..e6da7d7693844e48104d165456247a87aa077cf4 100644
--- a/src/MNH/elec_fieldn.f90
+++ b/src/MNH/elec_fieldn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -99,7 +99,7 @@ INTEGER :: IRESP ! Return code of FM routines
INTEGER :: ILENG ! Length of the data field in LFIFM file
INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
-INTEGER :: IIU,IJU,IKU ! array sizes in I,J,K
+INTEGER :: IIU,IJU ! array sizes in I,J,K
INTEGER :: JI,JJ,JK !loop index on the vertical levels
INTEGER :: IINFO_ll
!
@@ -117,8 +117,7 @@ CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
CALL GET_DIM_EXT_ll('B',IIU,IJU)
!
IKB = 1 + JPVEXT
-IKU = SIZE(PEFIELDU,3)
-IKE = IKU - JPVEXT
+IKE = SIZE(PEFIELDU,3) - JPVEXT
!
ALLOCATE(ZDV_SOURCE(SIZE(PQ_SOURCE,1),SIZE(PQ_SOURCE,2),SIZE(PQ_SOURCE,3)))
ALLOCATE(ZPHIT(SIZE(PQ_SOURCE,1),SIZE(PQ_SOURCE,2),SIZE(PQ_SOURCE,3)))
@@ -226,9 +225,9 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZPHIT, 'ELEC_FIELD_n::ZPHIT' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
-PEFIELDU(:,:,:) = PRHODJ(:,:,:) * GX_M_M(1,IKU,1,ZPHIT,XDXX,XDZZ,XDZX)
-PEFIELDV(:,:,:) = PRHODJ(:,:,:) * GY_M_M(1,IKU,1,ZPHIT,XDYY,XDZZ,XDZY)
-PEFIELDW(:,:,:) = PRHODJ(:,:,:) * GZ_M_M(1,IKU,1,ZPHIT,XDZZ)
+PEFIELDU(:,:,:) = PRHODJ(:,:,:) * GX_M_M(ZPHIT,XDXX,XDZZ,XDZX)
+PEFIELDV(:,:,:) = PRHODJ(:,:,:) * GY_M_M(ZPHIT,XDYY,XDZZ,XDZY)
+PEFIELDW(:,:,:) = PRHODJ(:,:,:) * GZ_M_M(ZPHIT,XDZZ)
!
IF (PRESENT(PPHIT)) PPHIT(:,:,:) = - PRHODJ(:,:,:) * ZPHIT(:,:,:)
!
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index 665de2a84e479f2e36bd304fe3699e0d5edc7c36..a272d44733c0c9d0ed35dd117e91f9183be0f2f2 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -281,7 +281,6 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant w
!* 0.2 DECLARATIONS OF LOCAL VARIABLES
!
INTEGER:: JSV ! loop counters
-INTEGER :: IKU
INTEGER :: IIB, IIE ! index of first and last inner mass points along x
INTEGER :: IJB, IJE ! index of first and last inner mass points along y
real, dimension(:,:,:), allocatable :: zrhodjontime
@@ -289,7 +288,6 @@ real, dimension(:,:,:), allocatable :: zrhodjontime
!------------------------------------------------------------------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKU=SIZE(XZHAT)
!
!* 1. ASSELIN FILTER
!
@@ -547,8 +545,7 @@ IF (LBU_ENABLE) THEN
if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep )
- if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', pws (:, :, :) * Mzm( 1, iku, 1, prhodj(:, :, :) ) &
- / ptstep )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep )
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', pths (:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', ptkes(:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', prs (:, :, :, 1) * prhodj(:, :, :) / ptstep )
@@ -566,8 +563,7 @@ IF (LBU_ENABLE) THEN
if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep )
- if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', pws (:, :, :) * Mzm( 1, iku, 1, prhodj(:, :, :) ) &
- / ptstep )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep )
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', pths (:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', ptkes(:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', prs (:, :, :, 1) * prhodj(:, :, :) / ptstep )
@@ -582,7 +578,6 @@ IF (LBU_ENABLE) THEN
call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', psvs(:, :, :, jsv) * prhodj(:, :, :) / ptstep )
end do
end if
-
END IF
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/exchange.f90 b/src/MNH/exchange.f90
index 5587e5331b307d7edfc6bc7469b8c8738b7d3d87..c175d25f3466bb3811307c8d197793e018962f52 100644
--- a/src/MNH/exchange.f90
+++ b/src/MNH/exchange.f90
@@ -132,14 +132,12 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS,PRSVS !
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JRR,JSV ! loop counters
!
-INTEGER :: IKU
INTEGER :: ILUOUT ! logical unit numbers of output-listing
INTEGER :: IRESP ! IRESP : return-code if a problem appears
!in LFI subroutines at the open of the file
REAL :: ZRATIO, ZMASSTOT, ZMASSPOS
!------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
ILUOUT = TLUOUT%NLU
!
!* 1. TRANSFORMS THE SOURCE TERMS INTO PROGNOSTIC VARIABLES
@@ -149,7 +147,7 @@ ILUOUT = TLUOUT%NLU
!
PRUS(:,:,:) = PRUS(:,:,:)*PTSTEP / MXM(PRHODJ)
PRVS(:,:,:) = PRVS(:,:,:)*PTSTEP / MYM(PRHODJ)
-PRWS(:,:,:) = PRWS(:,:,:)*PTSTEP / MZM(1,IKU,1,PRHODJ)
+PRWS(:,:,:) = PRWS(:,:,:)*PTSTEP / MZM(PRHODJ)
!
! 1.b Meteorological scalar variables
!
diff --git a/src/MNH/fct_met.f90 b/src/MNH/fct_met.f90
index 3597b264c76bdd1c2228a2871090b789ca3af7c9..7c9a24d7e876246c65a3f6f4ed6c2846894dab7a 100644
--- a/src/MNH/fct_met.f90
+++ b/src/MNH/fct_met.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -148,10 +148,8 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
REAL :: ZMINR,ZMINTKE
! Absolute minimum values of
! water substances, TKE
-INTEGER :: IKU
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HMET group
!
!
@@ -170,8 +168,8 @@ IKU=SIZE(XZHAT)
! IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVY_BU_RTH')
!
PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DZF(1,IKU,1,PRWCT(:,:,:)*MZM (1,IKU,1,PTHT(:,:,:)))
-! IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'ADVZ_BU_RTH')
+ - DZF(PRWCT(:,:,:)*MZM (PTHT(:,:,:)))
+! IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
!
!* 1.2 No condensation case: Vapor ---> advected by a FCT scheme
!
@@ -191,9 +189,9 @@ IKU=SIZE(XZHAT)
! IF (LBUDGET_RV) &
! CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVY_BU_RRV')
!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(1,IKU,1,ZFZ(:,:,:))
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZFZ(:,:,:))
! IF (LBUDGET_RV) &
-! CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVZ_BU_RRV')
+! CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
END IF
!
!* 1.3 No ice case: rv+rc ---> advected by the FCT scheme
@@ -207,7 +205,7 @@ IKU=SIZE(XZHAT)
!
ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (1,IKU,1,PRT(:,:,:,2)) !
+ ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
!
ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
@@ -223,10 +221,10 @@ IKU=SIZE(XZHAT)
! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVY_BU_RRV')
! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'ADVY_BU_RRC')
!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(1,IKU,1,ZRTFZ(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF(1,IKU,1, ZFZ(:,:,:))
-! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVZ_BU_RRV')
-! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'ADVZ_BU_RRC')
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
+! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
+! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
!
END IF
!
@@ -243,7 +241,7 @@ IKU=SIZE(XZHAT)
!
ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (1,IKU,1,PRT(:,:,:,2)) !
+ ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
!
ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv+ri fluxes deduction
@@ -255,13 +253,13 @@ IKU=SIZE(XZHAT)
PRRS(:,:,:,2) = PRRS(:,:,:,2) - DYF( ZFY(:,:,:))
! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'ADVY_BU_RRC')
!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF(1,IKU,1, ZFZ(:,:,:))
-! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), NBUDGET_RC,'ADVZ_BU_RRC')
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
+! IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
!
!
ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,4)) !
ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,4)) ! CENtred scheme for ri
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (1,IKU,1,PRT(:,:,:,4)) !
+ ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,4)) !
!
ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
@@ -277,10 +275,10 @@ IKU=SIZE(XZHAT)
! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVY_BU_RRV')
! IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4), NBUDGET_RI,'ADVY_BU_RRI')
!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(1,IKU,1,ZRTFZ(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DZF(1,IKU,1, ZFZ(:,:,:))
-! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), NBUDGET_RV,'ADVZ_BU_RRV')
-! IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4), NBUDGET_RI,'ADVZ_BU_RRI')
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - DZF( ZFZ(:,:,:))
+! IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
+! IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
!
END IF
!
@@ -298,8 +296,8 @@ IKU=SIZE(XZHAT)
PRRS(:,:,:,3) = PRRS(:,:,:,3) - DYF( ZFY(:,:,:))
! IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3), NBUDGET_RR,'ADVY_BU_RRR')
!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DZF(1,IKU,1, ZFZ(:,:,:))
-! IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3), NBUDGET_RR,'ADVZ_BU_RRR')
+ PRRS(:,:,:,3) = PRRS(:,:,:,3) - DZF( ZFZ(:,:,:))
+! IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
!
END IF
!
@@ -327,13 +325,13 @@ IKU=SIZE(XZHAT)
! IF (JRR==7.AND.LBUDGET_RH) &
! CALL BUDGET (PRRS(:,:,:,7),NBUDGET_RH,'ADVY_BU_RRH')
!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DZF(1,IKU,1,ZFZ(:,:,:))
- ! IF (JRR==5.AND.LBUDGET_RS) &
- ! CALL BUDGET (PRRS(:,:,:,5),NBUDGET_RS,'ADVZ_BU_RRS')
- ! IF (JRR==6.AND.LBUDGET_RG) &
- ! CALL BUDGET (PRRS(:,:,:,6),NBUDGET_RG,'ADVZ_BU_RRG')
- ! IF (JRR==7.AND.LBUDGET_RH) &
- ! CALL BUDGET (PRRS(:,:,:,7),NBUDGET_RH,'ADVZ_BU_RRH')
+ PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DZF(ZFZ(:,:,:))
+! IF (JRR==5.AND.LBUDGET_RS) &
+! CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
+! IF (JRR==6.AND.LBUDGET_RG) &
+! CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
+! IF (JRR==7.AND.LBUDGET_RH) &
+! CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
!
END DO
!
@@ -354,8 +352,8 @@ IKU=SIZE(XZHAT)
PRTKES(:,:,:) = PRTKES(:,:,:) - DYF(ZFY(:,:,:))
! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVY_BU_RTKE')
!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DZF(1,IKU,1,ZFZ(:,:,:))
-! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,NBUDGET_TKE,'ADVZ_BU_RTKE')
+ PRTKES(:,:,:) = PRTKES(:,:,:) - DZF(ZFZ(:,:,:))
+! IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
!
END IF
!
diff --git a/src/MNH/fct_scalar.f90 b/src/MNH/fct_scalar.f90
index f3641c63b0285f94b06dda82004ef3b5b7358a75..e0832c60e8729fb718cd275c1e6f056cd0c62a2e 100644
--- a/src/MNH/fct_scalar.f90
+++ b/src/MNH/fct_scalar.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -135,11 +135,9 @@ INTEGER :: JSV
!
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
:: ZFX ,ZFY ,ZFZ ! Advective flux components for each
-INTEGER :: IKU
!
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HSV group
!
!
@@ -158,9 +156,9 @@ IKU=SIZE(XZHAT)
! IF (LBUDGET_SV) &
! CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'ADVY_BU_RSV')
!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DZF(1,IKU,1,ZFZ(:,:,:))
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DZF(ZFZ(:,:,:))
! IF (LBUDGET_SV) &
-! CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'ADVZ_BU_RSV')
+! CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index 55b5db9c4bf12ca54f13e17b2b6cdec2357bd3db..3cd873895ccd911ef791e4700cda3fde6ded209a 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -181,7 +181,6 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
INTEGER :: IIB, IIE ! index values of the first and last inner mass points along x
INTEGER :: IJB, IJE ! index values of the first and last inner mass points along y
INTEGER :: IKB, IKE ! index values of the first and last inner mass points along z
-INTEGER :: IKU
INTEGER :: II, IJ, IK, IL, IM, IPOINT ! loop indexes
INTEGER :: IX, IY, IZ
INTEGER :: IXOR, IYOR ! origin of the extended subdomain
@@ -336,7 +335,6 @@ CALL MYPROC_ELEC_ll(IPROC)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PRT,3) - JPVEXT
-IKU = SIZE(PRT,3)
!
! global indexes of the local subdomains origin
CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
@@ -383,7 +381,7 @@ IF (GEFIRSTCALL) THEN
!
ZXMASS(IIB:IIE) = 0.5 * (XXHAT(IIB:IIE) + XXHAT(IIB+1:IIE+1))
ZYMASS(IJB:IJE) = 0.5 * (XYHAT(IJB:IJE) + XYHAT(IJB+1:IJE+1))
- ZZMASS = MZF(1,IKU,1,PZZ)
+ ZZMASS = MZF(PZZ)
ZPRES_COEF = EXP(ZZMASS/8400.)
ZSCOORD_SEG(:,:,:) = 0.0
ISAVE_STATUS = 1
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index a5e3075881810e2674b03563c18a306926f9e03a..ef75e5383198891f83377c714ad9f49413b01c43 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -29,6 +29,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -53,7 +55,7 @@ END MODULE MODI_FORCING
! ######################################################################
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -188,6 +190,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -497,7 +501,7 @@ ELSE
!
ALLOCATE(ZZA(SIZE(PWT,1),SIZE(PWT,2),SIZE(PWT,3)))
ALLOCATE(ZZF(SIZE(PWT,1),SIZE(PWT,2),SIZE(PWT,3)))
- ZZA(:,:,:) = MZF(1,IKU,1, PZZ(:,:,:) )
+ ZZA(:,:,:) = MZF( PZZ(:,:,:) )
ZZA(:,:,IKU) = 2.0*PZZ(:,:,IKU) - ZZA(:,:,IKU-1)
ZDZHAT_INV_IKU = 1.0 / ( PZHAT(IKU)-PZHAT(IKU-1) )
!
@@ -567,7 +571,7 @@ ELSE
END DO
CALL GET_HALO(ZWF)
!
- ZZF(:,:,:) = MZF(1,IKU,1, PZZ(:,:,:) )
+ ZZF(:,:,:) = MZF( PZZ(:,:,:) )
ZZF(:,:,IKU) = 2.0*PZZ(:,:,IKU)-ZZF(:,:,IKU-1)
!
DO JL=1,IKU-1
@@ -606,7 +610,7 @@ END IF
!!
!! Ligne to add if you want W in Pa/s in namelist instead of m/s (omega = - w/(rho*g))
!!
-!ZWF(:,:,:) = - ZWF(:,:,:)/(XG*MZM(1,IKU,1,(PRHODJ(:,:,:)/PJ(:,:,:))))
+!ZWF(:,:,:) = - ZWF(:,:,:)/(XG*MZM((PRHODJ(:,:,:)/PJ(:,:,:))))
!
!!============================
!
@@ -630,7 +634,7 @@ END DO
!
! store large scale w in module to be used later
! in convection scheme
-XWTFRC(:,:,:) = ZWF(:,:,:)
+PWTFRC(:,:,:) = ZWF(:,:,:)
!
!* computes evolution of forcing wind
WHERE(PUFRC_PAST==XUNDEF) PUFRC_PAST = ZUF(:,:,:)
@@ -657,49 +661,49 @@ ALLOCATE(ZRWCF(SIZE(PWT,1),SIZE(PWT,2),SIZE(PWT,3)))
!* 4.1 integration of vertical motion (upstream scheme)
!
IF (LVERT_MOTION_FRC) THEN
- ZDZZ(:,:,:) = DZM(1,IKU,1,MZF(1,IKU,1,PZZ(:,:,:)))
+ ZDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
ZDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1) ! same delta z in IKU and IKU -1
!
- ZRWCF(:,:,:) = ZWF(:,:,:) * MZM(1,IKU,1,PRHODJ(:,:,:)) / ZDZZ(:,:,:)
+ ZRWCF(:,:,:) = ZWF(:,:,:) * MZM(PRHODJ(:,:,:)) / ZDZZ(:,:,:)
ZRWCF(:,:,1) = - ZRWCF(:,:,3) ! Mirror hypothesis
!
! forced vertical transport of U and V
!
- ZDZZ(:,:,:) = MXF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PUT(:,:,:))
+ ZDZZ(:,:,:) = MXF(ZRWCF(:,:,:)) *DZM(PUT(:,:,:))
PRUS(:,:,:) = PRUS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
- ZDZZ(:,:,:) = MYF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PVT(:,:,:))
+ ZDZZ(:,:,:) = MYF(ZRWCF(:,:,:)) *DZM(PVT(:,:,:))
PRVS(:,:,:) = PRVS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
!
! forced vertical transport of W
!
IF( .NOT.L1D ) THEN
- ZDZZ(:,:,:) = MZF(1,IKU,1,ZRWCF(:,:,:)) *DZF(1,IKU,1,PWT(:,:,:))
+ ZDZZ(:,:,:) = MZF(ZRWCF(:,:,:)) *DZF(PWT(:,:,:))
PRWS(:,:,:) = PRWS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END IF
!
! forced vertical transport of THETA
!
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTHT(:,:,:))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(PTHT(:,:,:))
PRTHS(:,:,:) = PRTHS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
!
! forced vertical transport of TKE (if allocated)
!
IF( SIZE(PTKET) == SIZE(ZDZZ) ) THEN
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTKET(:,:,:))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(PTKET(:,:,:))
PRTKES(:,:,:) = PRTKES(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END IF
!
! forced vertical transport of water variables
!
DO JL = 1 , SIZE(PRRS,4)
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PRT(:,:,:,JL))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(PRT(:,:,:,JL))
PRRS(:,:,:,JL) = PRRS(:,:,:,JL) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END DO
!
! forced vertical transport of scalar variables
!
DO JL = 1 , SIZE(PRSVS,4)
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PSVT(:,:,:,JL))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(PSVT(:,:,:,JL))
PRSVS(:,:,:,JL) = PRSVS(:,:,:,JL) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END DO
!
@@ -780,7 +784,7 @@ PVFRC_PAST(:,:,:) = ZVF(:,:,:)
!
IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
!
- ZDZZ(:,:,:) = DZM(1,IKU,1,MZF(1,IKU,1,PZZ(:,:,:)))
+ ZDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
ZDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1)
!
! define the mask where the relaxation is to be applied
@@ -795,7 +799,7 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','FORCING','wrong CRELAX_HEIGHT_TYPE option')
END SELECT
- WHERE ( MZF(1,IKU,1,PZZ(:,:,:)) .LE. XRELAX_HEIGHT_FRC )
+ WHERE ( MZF(PZZ(:,:,:)) .LE. XRELAX_HEIGHT_FRC )
GRELAX_MASK_FRC = .FALSE.
END WHERE
!
diff --git a/src/MNH/gdiv.f90 b/src/MNH/gdiv.f90
index f11b44f7ce0296f6025e7e9de8cb0b7f39cb0438..b22065908c6e897d61706999fd1374582060f1d4 100644
--- a/src/MNH/gdiv.f90
+++ b/src/MNH/gdiv.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ################
MODULE MODI_GDIV
! ################
@@ -71,13 +66,6 @@ END MODULE MODI_GDIV
!! EXTERNAL
!! --------
!! SUBROUTINE CONTRAV : compute the contavariant components
-!! Shuman operators :
-!! FUNCTION DXF : compute finite difference along x for a variable
-!! localized at a flux side
-!! FUNCTION DYF : compute finite difference along y for a variable
-!! localized at a flux side
-!! FUNCTION DZF : compute finite difference along z for a variable
-!! localized at a flux side
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -114,7 +102,6 @@ END MODULE MODI_GDIV
!
USE MODD_PARAMETERS
USE MODD_CONF
-USE MODI_SHUMAN
USE MODI_CONTRAV
!
USE MODE_ll
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index 950d731b8edcb3f46b7512f56438d59c3c615ce9..6246b73a4e2dd7cf3dd5244b3d5ffc6db3b523a3 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -15,6 +15,7 @@
! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! 2017 V.Vionnet blow snow
+! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -42,6 +43,8 @@ USE MODD_CONF_n
USE MODD_CURVCOR_n
!USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
USE MODD_DUMMY_GR_FIELD_n
USE MODD_DYN_n
USE MODD_DYNZD_n
@@ -153,6 +156,8 @@ CALL CONF_GOTO_MODEL(KFROM, KTO)
CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
!CALL DEEP_CONVECTION_GOTO_MODEL(KFROM, KTO)
CALL DIM_GOTO_MODEL(KFROM, KTO)
+CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
+CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL DYN_GOTO_MODEL(KFROM, KTO)
CALL DYNZD_GOTO_MODEL(KFROM,KTO)
diff --git a/src/MNH/gradient_m.f90 b/src/MNH/gradient_m.f90
index 3fed55910b986173a0ac6aefd185ccbe603fe746..b5ec025aacf1a6c83e0c74f0e68406ff736ab119 100644
--- a/src/MNH/gradient_m.f90
+++ b/src/MNH/gradient_m.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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$
-!-----------------------------------------------------------------
! ######################
MODULE MODI_GRADIENT_M
! ######################
@@ -14,9 +10,8 @@
INTERFACE
!
!
-FUNCTION GX_M_M(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -27,9 +22,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
END FUNCTION GX_M_M
!
!
-FUNCTION GY_M_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -40,10 +34,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
END FUNCTION GY_M_M
!
!
-FUNCTION GZ_M_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_M_M)
+FUNCTION GZ_M_M(PA,PDZZ) RESULT(PGZ_M_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -107,7 +99,7 @@ END MODULE MODI_GRADIENT_M
!
!
! #######################################################
- FUNCTION GX_M_M(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
+ FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_M_M)
! #######################################################
!
!!**** *GX_M_M* - Cartesian Gradient operator:
@@ -173,8 +165,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -194,7 +184,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
!
IF (.NOT. LFLAT) THEN
PGX_M_M(:,:,:)= (DXF(MXM(PA(:,:,:))) - &
- MZF(KKA,KKU,KL,MXF(PDZX)*DZM(KKA,KKU,KL,PA(:,:,:)) &
+ MZF(MXF(PDZX)*DZM(PA(:,:,:)) &
/PDZZ(:,:,:)) ) /MXF(PDXX(:,:,:))
ELSE
PGX_M_M(:,:,:)=DXF(MXM(PA(:,:,:))) / MXF(PDXX(:,:,:))
@@ -206,7 +196,7 @@ END FUNCTION GX_M_M
!
!
! #######################################################
- FUNCTION GY_M_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
+ FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
! #######################################################
!
!!**** *GY_M_M* - Cartesian Gradient operator:
@@ -270,8 +260,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -291,7 +279,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
!
!
IF (.NOT. LFLAT) THEN
- PGY_M_M(:,:,:)= (DYF(MYM(PA))-MZF(KKA,KKU,KL,MYF(PDZY)*DZM(KKA,KKU,KL,PA)&
+ PGY_M_M(:,:,:)= (DYF(MYM(PA))-MZF(MYF(PDZY)*DZM(PA)&
/PDZZ) ) /MYF(PDYY)
ELSE
PGY_M_M(:,:,:)= DYF(MYM(PA))/MYF(PDYY)
@@ -304,9 +292,9 @@ END FUNCTION GY_M_M
!
!
!
-! #######################################################
- FUNCTION GZ_M_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_M_M)
-! #######################################################
+! #############################################
+ FUNCTION GZ_M_M(PA,PDZZ) RESULT(PGZ_M_M)
+! #############################################
!
!!**** *GZ_M_M* - Cartesian Gradient operator:
!! computes the gradient in the cartesian Z
@@ -364,8 +352,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -381,7 +367,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
!* 1. DEFINITION of GZ_M_M
! --------------------
!
-PGZ_M_M(:,:,:)= MZF(KKA,KKU,KL, DZM(KKA,KKU,KL,PA(:,:,:))/PDZZ(:,:,:) )
+PGZ_M_M(:,:,:)= MZF( DZM(PA(:,:,:))/PDZZ(:,:,:) )
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/gradient_u.f90 b/src/MNH/gradient_u.f90
index 20526e75efcfa6028c3bf69cfeda117598752815..3d32ffa807c906ac2984bbbb8e83b00936d619a4 100644
--- a/src/MNH/gradient_u.f90
+++ b/src/MNH/gradient_u.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
MODULE MODI_GRADIENT_U
! ######################
@@ -15,9 +10,8 @@
INTERFACE
!
!
-FUNCTION GX_U_M(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -28,10 +22,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
END FUNCTION GX_U_M
!
!
-FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
+FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -42,10 +34,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
END FUNCTION GY_U_UV
!
!
-FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
+FUNCTION GZ_U_UW(PA,PDZZ) RESULT(PGZ_U_UW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -61,7 +51,7 @@ END MODULE MODI_GRADIENT_U
!
!
! #######################################################
- FUNCTION GX_U_M(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
+ FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX) RESULT(PGX_U_M)
! #######################################################
!
!!**** *GX_U_M* - Cartesian Gradient operator:
@@ -126,8 +116,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -147,7 +135,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
!
IF (.NOT. LFLAT) THEN
PGX_U_M(:,:,:)= ( DXF(PA) - &
- MZF(KKA,KKU,KL,MXF(PDZX*DZM(KKA,KKU,KL,PA)) / PDZZ ) &
+ MZF(MXF(PDZX*DZM(PA)) / PDZZ ) &
) / MXF(PDXX)
ELSE
PGX_U_M(:,:,:)= DXF(PA) / MXF(PDXX)
@@ -159,7 +147,7 @@ END FUNCTION GX_U_M
!
!
! #########################################################
- FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
+ FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
! #########################################################
!
!!**** *GY_U_UV* - Cartesian Gradient operator:
@@ -225,8 +213,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -245,7 +231,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
! ---------------------
!
IF (.NOT. LFLAT) THEN
- PGY_U_UV(:,:,:)= (DYM(PA)- MZF(KKA,KKU,KL, MYM( DZM(KKA,KKU,KL,PA)/&
+ PGY_U_UV(:,:,:)= (DYM(PA)- MZF( MYM( DZM(PA)/&
MXM(PDZZ) ) *MXM(PDZY) ) ) / MXM(PDYY)
ELSE
PGY_U_UV(:,:,:)= DYM(PA) / MXM(PDYY)
@@ -257,7 +243,7 @@ END FUNCTION GY_U_UV
!
!
! #######################################################
- FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
+ FUNCTION GZ_U_UW(PA,PDZZ) RESULT(PGZ_U_UW)
! #######################################################
!
!!**** *GZ_U_UW - Cartesian Gradient operator:
@@ -315,8 +301,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -332,7 +316,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
!* 1. DEFINITION of GZ_U_UW
! ---------------------
!
-PGZ_U_UW(:,:,:)= DZM(KKA,KKU,KL,PA) / MXM(PDZZ)
+PGZ_U_UW(:,:,:)= DZM(PA) / MXM(PDZZ)
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/gradient_uv.f90 b/src/MNH/gradient_uv.f90
index b7c3e35fa1d9117c3c412ecc17cc77c32a5dd83a..8e1822ef37d0fb1f04ebe7a6f9a7eb8c4e19b64c 100644
--- a/src/MNH/gradient_uv.f90
+++ b/src/MNH/gradient_uv.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
MODULE MODI_GRADIENT_UV
! #######################
@@ -15,9 +10,8 @@
INTERFACE
!
!
-FUNCTION GX_UV_V(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_UV_V)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GX_UV_V(PA,PDXX,PDZZ,PDZX) RESULT(PGX_UV_V)
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UV point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -28,10 +22,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_UV_V ! result V point
END FUNCTION GX_UV_V
!
!
-FUNCTION GY_UV_U(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_UV_U)
+FUNCTION GY_UV_U(PA,PDYY,PDZZ,PDZY) RESULT(PGY_UV_U)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UV point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -49,7 +41,7 @@ END MODULE MODI_GRADIENT_UV
!
!
! #########################################################
- FUNCTION GX_UV_V(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_UV_V)
+ FUNCTION GX_UV_V(PA,PDXX,PDZZ,PDZX) RESULT(PGX_UV_V)
! #########################################################
!
!!**** *GX_UV_V* - Cartesian Gradient operator:
@@ -112,8 +104,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UV point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -133,7 +123,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_UV_V ! result V point
!
IF (.NOT. LFLAT) THEN
PGX_UV_V(:,:,:)= ( DXF(PA) - &
- MZF(KKA,KKU,KL, MXF( MYM(PDZX)*DZM(KKA,KKU,KL,PA)/MYM(PDZZ) ) ) &
+ MZF( MXF( MYM(PDZX)*DZM(PA)/MYM(PDZZ) ) ) &
) / MXF(MYM(PDXX))
ELSE
PGX_UV_V(:,:,:)= DXF(PA) / MXF(MYM(PDXX))
@@ -145,7 +135,7 @@ END FUNCTION GX_UV_V
!
!
! #########################################################
- FUNCTION GY_UV_U(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_UV_U)
+ FUNCTION GY_UV_U(PA,PDYY,PDZZ,PDZY) RESULT(PGY_UV_U)
! #########################################################
!
!!**** *GY_UV_U* - Cartesian Gradient operator:
@@ -216,8 +206,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UV point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -237,7 +225,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_UV_U ! result U point
!
IF (.NOT. LFLAT) THEN
PGY_UV_U(:,:,:)= ( DYF(PA) - &
- MZF(KKA,KKU,KL, MYF( MXM(PDZY)*DZM(KKA,KKU,KL,PA)/MXM(PDZZ) ) ) &
+ MZF( MYF( MXM(PDZY)*DZM(PA)/MXM(PDZZ) ) ) &
) / MYF(MXM(PDYY))
ELSE
PGY_UV_U(:,:,:)= DYF(PA) / MYF(MXM(PDYY))
diff --git a/src/MNH/gradient_uw.f90 b/src/MNH/gradient_uw.f90
index 5ef1c9622f649501ad3f610d1430d9c72c8e7a7a..946b85c836ad48ef71050ed74081bdf2d6fc1ab0 100644
--- a/src/MNH/gradient_uw.f90
+++ b/src/MNH/gradient_uw.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
MODULE MODI_GRADIENT_UW
! #######################
@@ -15,9 +10,7 @@
INTERFACE
!
!
-FUNCTION GX_UW_W(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_UW_W)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GX_UW_W(PA,PDXX,PDZZ,PDZX) RESULT(PGX_UW_W)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -28,10 +21,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_UW_W ! result W point
END FUNCTION GX_UW_W
!
!
-FUNCTION GZ_UW_U(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_UW_U)
+FUNCTION GZ_UW_U(PA,PDZZ) RESULT(PGZ_UW_U)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -47,7 +38,7 @@ END MODULE MODI_GRADIENT_UW
!
!
! #########################################################
- FUNCTION GX_UW_W(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_UW_W)
+ FUNCTION GX_UW_W(PA,PDXX,PDZZ,PDZX) RESULT(PGX_UW_W)
! #########################################################
!
!!**** *GX_UW_W* - Cartesian Gradient operator:
@@ -111,8 +102,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise*
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -132,10 +121,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_UW_W ! result W point
!
IF (.NOT. LFLAT) THEN
PGX_UW_W(:,:,:)= ( DXF(PA) - &
- MZF(KKA,KKU,KL, MXF(MZF(KKA,KKU,KL, PDZX)*DZF(KKA,KKU,KL,PA)) / MZF(KKA,KKU,KL,PDZZ) ) &
- ) / MXF(MZM(KKA,KKU,KL,PDXX))
+ MZF( MXF(MZF( PDZX)*DZF(PA)) / MZF(PDZZ) ) &
+ ) / MXF(MZM(PDXX))
ELSE
- PGX_UW_W(:,:,:)= DXF(PA) / MXF(MZM(KKA,KKU,KL,PDXX))
+ PGX_UW_W(:,:,:)= DXF(PA) / MXF(MZM(PDXX))
END IF
!
!----------------------------------------------------------------------------
@@ -144,7 +133,7 @@ END FUNCTION GX_UW_W
!
!
! ###############################################
- FUNCTION GZ_UW_U(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_UW_U)
+ FUNCTION GZ_UW_U(PA,PDZZ) RESULT(PGZ_UW_U)
! ###############################################
!
!!**** *GZ_UW_U* - Cartesian Gradient operator:
@@ -205,8 +194,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the UW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -222,7 +209,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_UW_U ! result U point
!* 1. DEFINITION of GZ_UW_U
! ---------------------
!
-PGZ_UW_U(:,:,:)= DZF(KKA,KKU,KL,PA) / MXM(MZF(KKA,KKU,KL,PDZZ))
+PGZ_UW_U(:,:,:)= DZF(PA) / MXM(MZF(PDZZ))
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/gradient_v.f90 b/src/MNH/gradient_v.f90
index 98a7349d7e7e75282666378f3a5d5b527bee7fac..12c1be749d779a02648de8bb380dbdf9004a2907 100644
--- a/src/MNH/gradient_v.f90
+++ b/src/MNH/gradient_v.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
MODULE MODI_GRADIENT_V
! ######################
@@ -15,10 +10,8 @@
INTERFACE
!
!
-FUNCTION GY_V_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
+FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -28,10 +21,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
!
END FUNCTION GY_V_M
!
-FUNCTION GX_V_UV(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
+FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -42,10 +33,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
END FUNCTION GX_V_UV
!
!
-FUNCTION GZ_V_VW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_V_VW)
+FUNCTION GZ_V_VW(PA,PDZZ) RESULT(PGZ_V_VW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -61,7 +50,7 @@ END MODULE MODI_GRADIENT_V
!
!
! #######################################################
- FUNCTION GY_V_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
+ FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY) RESULT(PGY_V_M)
! #######################################################
!
!!**** *GY_V_M* - Cartesian Gradient operator:
@@ -125,8 +114,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -146,7 +133,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
!
IF (.NOT. LFLAT) THEN
PGY_V_M(:,:,:)= (DYF(PA) - &
- MZF(KKA,KKU,KL, MYF(PDZY*DZM(KKA,KKU,KL,PA))/PDZZ ) &
+ MZF( MYF(PDZY*DZM(PA))/PDZZ ) &
) / MYF(PDYY)
ELSE
PGY_V_M(:,:,:)= DYF(PA) / MYF(PDYY)
@@ -158,7 +145,7 @@ END FUNCTION GY_V_M
!
!
! #########################################################
- FUNCTION GX_V_UV(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
+ FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
! #########################################################
!
!!**** *GX_V_UV* - Cartesian Gradient operator:
@@ -223,8 +210,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -243,7 +228,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
! ---------------------
!
IF (.NOT. LFLAT) THEN
- PGX_V_UV(:,:,:)= ( DXM(PA)- MZF(KKA,KKU,KL, MXM( DZM(KKA,KKU,KL,PA)/&
+ PGX_V_UV(:,:,:)= ( DXM(PA)- MZF( MXM( DZM(PA)/&
MYM(PDZZ) ) *MYM(PDZX) ) ) / MYM(PDXX)
ELSE
PGX_V_UV(:,:,:)= DXM(PA) / MYM(PDXX)
@@ -255,7 +240,7 @@ END FUNCTION GX_V_UV
!
!
! #######################################################
- FUNCTION GZ_V_VW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_V_VW)
+ FUNCTION GZ_V_VW(PA,PDZZ) RESULT(PGZ_V_VW)
! #######################################################
!
!!**** *GZ_V_VW - Cartesian Gradient operator:
@@ -314,8 +299,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -331,7 +314,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
!* 1. DEFINITION of GZ_V_VW
! ---------------------
!
-PGZ_V_VW(:,:,:)= DZM(KKA,KKU,KL,PA) / MYM(PDZZ)
+PGZ_V_VW(:,:,:)= DZM(PA) / MYM(PDZZ)
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/gradient_vw.f90 b/src/MNH/gradient_vw.f90
index 6d82cb972c21769d5c8ee2c1f63d7825b7598b37..864be89c8f615f811549b8c3298727341d9cba59 100644
--- a/src/MNH/gradient_vw.f90
+++ b/src/MNH/gradient_vw.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
MODULE MODI_GRADIENT_VW
! #######################
@@ -15,9 +10,7 @@
INTERFACE
!
!
-FUNCTION GY_VW_W(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_VW_W)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION GY_VW_W(PA,PDYY,PDZZ,PDZY) RESULT(PGY_VW_W)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the VW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -28,10 +21,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_VW_W ! result W point
END FUNCTION GY_VW_W
!
!
-FUNCTION GZ_VW_V(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_VW_V)
+FUNCTION GZ_VW_V(PA,PDZZ) RESULT(PGZ_VW_V)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the VW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -47,7 +38,7 @@ END MODULE MODI_GRADIENT_VW
!
!
! #########################################################
- FUNCTION GY_VW_W(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_VW_W)
+ FUNCTION GY_VW_W(PA,PDYY,PDZZ,PDZY) RESULT(PGY_VW_W)
! #########################################################
!
!!**** *GY_VW_W* - Cartesian Gradient operator:
@@ -111,8 +102,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the VW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -132,10 +121,10 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_VW_W ! result W point
!
IF (.NOT. LFLAT) THEN
PGY_VW_W(:,:,:)= ( DYF(PA) - &
- MZF(KKA,KKU,KL, MYF(MZF(KKA,KKU,KL,PDZY)*DZF(KKA,KKU,KL,PA)) / MZF(KKA,KKU,KL,PDZZ) ) &
- ) / MYF(MZM(KKA,KKU,KL,PDYY))
+ MZF( MYF(MZF(PDZY)*DZF(PA)) / MZF(PDZZ) ) &
+ ) / MYF(MZM(PDYY))
ELSE
- PGY_VW_W(:,:,:)= DYF(PA) / MYF(MZM(KKA,KKU,KL,PDYY))
+ PGY_VW_W(:,:,:)= DYF(PA) / MYF(MZM(PDYY))
END IF
!
!----------------------------------------------------------------------------
@@ -144,7 +133,7 @@ END FUNCTION GY_VW_W
!
!
! ###############################################
- FUNCTION GZ_VW_V(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_VW_V)
+ FUNCTION GZ_VW_V(PA,PDZZ) RESULT(PGZ_VW_V)
! ###############################################
!
!!**** *GZ_VW_V* - Cartesian Gradient operator:
@@ -205,8 +194,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the VW point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -222,7 +209,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_VW_V ! result V point
!* 1. DEFINITION of GZ_VW_V
! ---------------------
!
-PGZ_VW_V(:,:,:)= DZF(KKA,KKU,KL,PA) / MYM(MZF(KKA,KKU,KL,PDZZ))
+PGZ_VW_V(:,:,:)= DZF(PA) / MYM(MZF(PDZZ))
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/gradient_w.f90 b/src/MNH/gradient_w.f90
index a1bfeed203020e73b27adbda43e96e0fbddc985f..1ef8f6916a266f0dc74a2cd5b8a79dceb85b979d 100644
--- a/src/MNH/gradient_w.f90
+++ b/src/MNH/gradient_w.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
MODULE MODI_GRADIENT_W
! ######################
@@ -15,10 +10,8 @@
INTERFACE
!
!
-FUNCTION GZ_W_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_W_M)
+FUNCTION GZ_W_M(PA,PDZZ) RESULT(PGZ_W_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -26,10 +19,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
!
END FUNCTION GZ_W_M
!
-FUNCTION GX_W_UW(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
+FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -40,10 +31,8 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
END FUNCTION GX_W_UW
!
!
-FUNCTION GY_W_VW(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
+FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -61,7 +50,7 @@ END MODULE MODI_GRADIENT_W
!
!
! #######################################################
- FUNCTION GZ_W_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_W_M)
+ FUNCTION GZ_W_M(PA,PDZZ) RESULT(PGZ_W_M)
! #######################################################
!
!!**** *GZ_W_M* - Cartesian Gradient operator:
@@ -114,8 +103,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -131,7 +118,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
!* 1. DEFINITION of GZ_W_M
! --------------------
!
-PGZ_W_M(:,:,:)= DZF(KKA,KKU,KL,PA(:,:,:))/(MZF(KKA,KKU,KL,PDZZ(:,:,:)))
+PGZ_W_M(:,:,:)= DZF(PA(:,:,:))/(MZF(PDZZ(:,:,:)))
!
!----------------------------------------------------------------------------
!
@@ -139,7 +126,7 @@ END FUNCTION GZ_W_M
!
!
! #########################################################
- FUNCTION GX_W_UW(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
+ FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
! #########################################################
!
!!**** *GX_W_UW* - Cartesian Gradient operator:
@@ -194,8 +181,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -214,11 +199,11 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
! ---------------------
!
IF (.NOT. LFLAT) THEN
- PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(KKA,KKU,KL,PDXX(:,:,:))) &
- -DZM(KKA,KKU,KL,MXM(MZF(KKA,KKU,KL,PA(:,:,:))))*PDZX(:,:,:) &
- /( MZM(KKA,KKU,KL,PDXX(:,:,:))*MXM(PDZZ(:,:,:)) )
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:))) &
+ -DZM(MXM(MZF(PA(:,:,:))))*PDZX(:,:,:) &
+ /( MZM(PDXX(:,:,:))*MXM(PDZZ(:,:,:)) )
ELSE
- PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(KKA,KKU,KL,PDXX(:,:,:)))
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:)))
END IF
!
!----------------------------------------------------------------------------
@@ -227,7 +212,7 @@ END FUNCTION GX_W_UW
!
!
! #########################################################
- FUNCTION GY_W_VW(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
+ FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
! #########################################################
!
!!**** *GY_W_VW* - Cartesian Gradient operator:
@@ -282,8 +267,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -302,11 +285,11 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
! ---------------------
!
IF (.NOT. LFLAT) THEN
- PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(KKA,KKU,KL,PDYY(:,:,:))) &
- -DZM(KKA,KKU,KL,MYM(MZF(KKA,KKU,KL,PA(:,:,:))))*PDZY(:,:,:) &
- /( MZM(KKA,KKU,KL,PDYY(:,:,:))*MYM(PDZZ(:,:,:)) )
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:))) &
+ -DZM(MYM(MZF(PA(:,:,:))))*PDZY(:,:,:) &
+ /( MZM(PDYY(:,:,:))*MYM(PDZZ(:,:,:)) )
ELSE
- PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(KKA,KKU,KL,PDYY(:,:,:)))
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:)))
END IF
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
index a5664d1b4e4c011960fdff1eee0f9678a495ab6e..72d0c1649e522a6b44541baa3b2ace50d7147061 100644
--- a/src/MNH/gravity.f90
+++ b/src/MNH/gravity.f90
@@ -135,7 +135,6 @@ REAL :: ZRV_OV_RD ! = RV / RD
INTEGER :: JWATER ! loop index on the different types of water
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
ZWORK1, ZWORK2
-INTEGER :: IKU
!
!-------------------------------------------------------------------------------
!
@@ -143,8 +142,6 @@ INTEGER :: IKU
!* 1. COMPUTES THE GRAVITY TERM
! -------------------------
!
-IKU=SIZE(PTHT,3)
-!
IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
!
IF(KRR > 0) THEN
@@ -173,7 +170,7 @@ IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
!
! compute the gravity term
!
- PRWS(:,:,:) = PRWS + XG * MZM(1,IKU,1, ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
+ PRWS(:,:,:) = PRWS + XG * MZM( ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
!
! the extrapolation for the PTHT and the THVREF must be the same at the
! ground
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 3e3ef2d61044ac6567ffe81d4194de9c108bc9b6..aaf7c903b00284edd640ad3b20351a6d641362f9 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -163,6 +163,7 @@ END MODULE MODI_ICE_ADJUST
!! or to call it on S variables
!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 24/02/2020: bugfix: corrected budget name (DEPI->CDEPI) for ice_adjust
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 6c2e8d0f2ddb9e9ac0472b283b842a7691f85ede..af5bfea3dce88fd0d6df9e2ec7a942c87295e7d3 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -101,10 +101,14 @@ contains
!! C. Barthe 01/2016 Add budget for LIMA
!! C.Lac 10/2016 Add budget for droplet deposition
!! S. Riette 11/2016 New budgets for ICE3/ICE4
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! P .Wautelet 09/03/2020: add missing budgets for electricity
!-------------------------------------------------------------------------------
!
@@ -862,7 +866,8 @@ if ( lbu_rth ) then
tzsource%clongname = 'dissipation'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, ndisshth )
- gcond = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NETUR'
tzsource%clongname = 'negative correction induced by turbulence'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, nneturth )
@@ -882,7 +887,8 @@ if ( lbu_rth ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, nadvth )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NEADV'
tzsource%clongname = 'negative correction induced by advection'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, nneadvth )
@@ -1043,7 +1049,8 @@ if ( lbu_rth ) then
tzsource%clongname = 'vapor condensation or cloud water evaporation'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, ncondth )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negative correction induced by condensation'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, gcond, nneconth )
@@ -1238,7 +1245,8 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%clongname = 'horizontal turbulent diffusion'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, nhturbrv )
- gcond = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NETUR'
tzsource%clongname = 'negative correction induced by turbulence'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, nneturrv )
@@ -1258,7 +1266,8 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, nadvrv )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NEADV'
tzsource%clongname = 'negative correction induced by advection'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, nneadvrv )
@@ -1331,7 +1340,8 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%clongname = 'deposition on ice'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, ncdepirv )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negative correction induced by condensation'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, gcond, nneconrv )
@@ -1427,7 +1437,8 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%clongname = 'horizontal turbulent diffusion'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, nhturbrc )
- gcond = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NETUR'
tzsource%clongname = 'negative correction induced by turbulence'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, nneturrc )
@@ -1442,7 +1453,8 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, nadvrc )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NEADV'
tzsource%clongname = 'negative correction induced by advection'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, nneadvrc )
@@ -1591,7 +1603,8 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%clongname = 'vapor condensation or cloud water evaporation'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, ncondrc )
- gcond = hcloud == 'KHKO' .or. hcloud == 'C2R2'
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
tzsource%cmnhname = 'NECON'
tzsource%clongname = 'negative correction induced by condensation'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, gcond, nneconrc )
@@ -1663,6 +1676,12 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%clongname = 'relaxation'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nrelrr )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nneturrr )
+
gcond = lvisc .and. lvisc_r
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -1673,6 +1692,12 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nadvrr )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nneadvrr )
+
gcond = hcloud /= 'NONE'
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -1788,6 +1813,12 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%cmnhname = 'SFR'
tzsource%clongname = 'spontaneous freezing'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nsfrrr )
+
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, gcond, nneconrr )
end if
! Budget of RRI
@@ -1871,6 +1902,12 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%clongname = 'horizontal turbulent diffusion'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, nhturbri )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, nneturri )
+
gcond = lvisc .and. lvisc_r
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -1881,6 +1918,12 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, nadvri )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, nneadvri )
+
gcond = hcloud /= 'NONE'
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2008,6 +2051,12 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%cmnhname = 'CDEPI'
tzsource%clongname = 'condensation/deposition on ice'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, ncdepiri )
+
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, gcond, nneconri )
end if
! Budget of RRS
@@ -2076,6 +2125,12 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%clongname = 'relaxation'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, nrelrs )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, nneturrs )
+
gcond = lvisc .and. lvisc_r
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -2086,6 +2141,12 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, nadvrs )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, nneadvrs )
+
gcond = hcloud /= 'NONE'
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2169,6 +2230,12 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%cmnhname = 'DRYH'
tzsource%clongname = 'dry growth of hail'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, ndryhrs )
+
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, gcond, nneconrs )
end if
! Budget of RRG
@@ -2237,6 +2304,12 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%clongname = 'relaxation'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, nrelrg )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, nneturrg )
+
gcond = lvisc .and. lvisc_r
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -2247,6 +2320,12 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, nadvrg )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, nneadvrg )
+
gcond = hcloud /= 'NONE'
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2344,6 +2423,12 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%cmnhname = 'DRYH'
tzsource%clongname = 'dry growth of hail'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, ndryhrg )
+
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, gcond, nneconrg )
end if
! Budget of RRH
@@ -2412,6 +2497,12 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tzsource%clongname = 'relaxation'
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, nrelrh )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, nneturrh )
+
gcond = lvisc .and. lvisc_r
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -2422,6 +2513,12 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tzsource%clongname = 'total advection'
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, nadvrh )
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, nneadvrh )
+
gcond = hcloud /= 'NONE'
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2476,6 +2573,12 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, ncorrrh )
+
+ gcond = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, gcond, nneconrh )
end if
! Budgets of RSV (scalar variables)
@@ -2677,6 +2780,16 @@ SV_BUDGETS: do jsv = 1, ksv
! LIMA case
SV_LIMA: if ( jsv == nsv_lima_nc ) then
! Cloud droplets concentration
+ gcond = lwarm_lima
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
+ gcond = lwarm_lima
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = .true.
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2772,9 +2885,24 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%clongname = 'adjustment to saturation'
call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+ gcond = lwarm_lima
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
else if ( jsv == nsv_lima_nr ) then SV_LIMA
! Rain drops concentration
+ gcond = lwarm_lima .and. lrain_lima
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
+ gcond = lwarm_lima .and. lrain_lima
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = .true.
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2860,9 +2988,24 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%clongname = 'hail melting'
call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+ gcond = lwarm_lima .and. lrain_lima
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
! Free CCN concentration
+ gcond = .true.
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
+ gcond = .true.
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = .true.
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2888,6 +3031,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%clongname = 'scavenging'
call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+ gcond = .true.
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
! Activated CCN concentration
@@ -2899,6 +3047,16 @@ SV_BUDGETS: do jsv = 1, ksv
else if ( jsv == nsv_lima_ni ) then SV_LIMA
! Pristine ice crystals concentration
+ gcond = lcold_lima
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
+ gcond = lcold_lima
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = .true.
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -2993,9 +3151,24 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%clongname = 'adjustment to saturation'
call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+ gcond = lcold_lima
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
! Free IFN concentration
+ gcond = .true.
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negative correction induced by turbulence'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
+ gcond = .true.
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negative correction induced by advection'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = .true.
tzsource%cmnhname = 'NEGA'
tzsource%clongname = 'negative correction'
@@ -3013,6 +3186,11 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%clongname = 'adjustment to saturation'
call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+ gcond = .true.
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negative correction induced by condensation'
+ call Budget_source_add( tbudgets(ibudget), tzsource, gcond, igroup )
+
gcond = lscav_lima
tzsource%cmnhname = 'SCAV'
tzsource%clongname = 'scavenging'
diff --git a/src/MNH/ini_field_elec.f90 b/src/MNH/ini_field_elec.f90
index a4fa7cd9bdf038b73c0cd2c6a88a0ebb9357fba3..c5dcbb79a30d93761faecc41871205996584c396 100644
--- a/src/MNH/ini_field_elec.f90
+++ b/src/MNH/ini_field_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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.
@@ -100,7 +100,6 @@ CHARACTER(LEN=4), DIMENSION(2) :: ZLBCY ! y-direction LBC type
!
INTEGER :: JK ! loop over the vertical levels
INTEGER :: IINFO_ll !
-INTEGER :: IKB,IKE,IKU ! Indices for the first and last point along vertical
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZMASS, ZWORK, ZWORK1, ZWORK2
!
@@ -112,9 +111,6 @@ TYPE(LIST_ll),POINTER :: TZFIELDS_ll ! list of fields to exchange
!* 1. INITIALIZATIONS
! ---------------
!
-IKB = 1 + JPVEXT
-IKE = SIZE(PZZ,3) - JPVEXT
-IKU = SIZE(PZZ,3)
ZLBCX = 'OPEN' ! forced LBC
ZLBCY = 'OPEN' ! forced LBC
!
@@ -172,7 +168,7 @@ XEFIELDW(:,:,SIZE(PDZZ,3)) = 2. * XEFIELDW(:,:,SIZE(PDZZ,3)-1) - &
XEFIELDW(:,:,SIZE(PDZZ,3)-2)
! Computing the mobility of small positive (negative) ions at Mass-point
-ZZMASS = MZF(1,IKU,1, PZZ ) ! altitude at mass point
+ZZMASS = MZF( PZZ ) ! altitude at mass point
DO JK = 2,SIZE(PZZ,3)-1
XMOBIL_POS(:,:,JK) = XF_POS * EXP( XEXPMOB* ZZMASS(:,:,JK) )
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index 718eebb464b59a2d271a80cfbab03dceacc418fd..c6f6b991f6edda384225b3e5c44563d215674ae1 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -53,7 +53,7 @@ END MODULE MODI_INI_MICRO_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! P.Wautelet 01/2019: bug: add missing allocations
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-!!
+! C. Lac 02/2020: add missing allocation of INPRC and ACPRC with deposition
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -161,9 +161,9 @@ ELSE
ALLOCATE(XACPRR(0,0))
END IF
!
-IF (( CCLOUD(1:3) == 'ICE' .AND.LSEDIC) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.LSEDC) .OR. &
- ( CCLOUD=='LIMA' .AND.MSEDC)) THEN
+IF (( CCLOUD(1:3) == 'ICE' .AND.(LSEDIC .OR. LDEPOSC)) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.(LSEDC .OR. LDEPOC)) .OR. &
+ ( CCLOUD=='LIMA' .AND.(MSEDC .OR. MDEPOC))) THEN
ALLOCATE(XINPRC(IIU,IJU))
ALLOCATE(XACPRC(IIU,IJU))
XINPRC(:,:)=0.0
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 46a9f3910ae216567911cc090e0a3687569da0be..0cb003caf9cff5babb56206e5b09504dd11fd08a 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -288,6 +288,7 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -327,7 +328,7 @@ USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV
USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
USE MODD_DIM_n
USE MODD_DRAG_n
-USE MODD_DRAGTREE
+USE MODD_DRAGTREE_n
USE MODD_DUST
use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, &
NMAX_WVL_SW_DUST=>NMAX_WVL_SW, &
@@ -1484,7 +1485,17 @@ ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
!
ALLOCATE(ZJ(IIU,IJU,IKU))
!
-!* 3.10 Forcing variables (Module MODD_FRC)
+!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn)
+!
+IF ( LFORCING ) THEN
+ ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF
+ ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
+ ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
+ELSE
+ ALLOCATE(XWTFRC(0,0,0))
+ ALLOCATE(XUFRC_PAST(0,0,0))
+ ALLOCATE(XVFRC_PAST(0,0,0))
+END IF
!
IF (KMI == 1) THEN
IF ( LFORCING ) THEN
@@ -1516,15 +1527,6 @@ IF (KMI == 1) THEN
ALLOCATE(XTENDUFRC(0,0))
ALLOCATE(XTENDVFRC(0,0))
END IF
- IF ( LFORCING ) THEN
- ALLOCATE(XWTFRC(IIU,IJU,IKU))
- ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
- ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
- ELSE
- ALLOCATE(XWTFRC(0,0,0))
- ALLOCATE(XUFRC_PAST(0,0,0))
- ALLOCATE(XVFRC_PAST(0,0,0))
- END IF
ELSE
!Do not allocate because they are the same on all grids (not 'n' variables)
END IF
diff --git a/src/MNH/ini_spawn_lsn.f90 b/src/MNH/ini_spawn_lsn.f90
index 75354a3f53f1b94993a020d953d37ad8232e4f84..3e31fdc9bb522c60f03c41674d8d2fdb8d1fceef 100644
--- a/src/MNH/ini_spawn_lsn.f90
+++ b/src/MNH/ini_spawn_lsn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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.
@@ -501,9 +501,9 @@ IF ( GVERT_INTERP ) THEN
!
IKU = SIZE(PZZ,3)
!
- ZZLS2=MZF(1,IKU,1,ZZLS1)
+ ZZLS2=MZF(ZZLS1)
ZZLS2(:,:,IKU)=2.*ZZLS2(:,:,IKU-1)-ZZLS2(:,:,IKU-2)
- ZZSS=MZF(1,IKU,1,PZZ)
+ ZZSS=MZF(PZZ)
ZZSS(:,:,IKU)=2.*ZZSS(:,:,IKU-1)-ZZSS(:,:,IKU-2)
!
CALL COEF_VER_INTERP_LIN(ZZLS2,ZZSS,IKLIN,ZCOEFLIN)
@@ -707,7 +707,7 @@ IF ( GVERT_INTERP ) THEN
!
ZZLS1=MYM(ZZLS2)
ZZLS1(:,1,:)=2.*ZZLS1(:,2,:)-ZZLS1(:,3,:)
- ZZSS=MZF(1,IKU,1,PZZ)
+ ZZSS=MZF(PZZ)
ZZSS(:,:,IKU)=2.*ZZSS(:,:,IKU-1)-ZZSS(:,:,IKU-2)
ZZSS=MYM(ZZSS)
ZZSS(:,1,:)=2.*ZZSS(:,2,:)-ZZSS(:,3,:)
diff --git a/src/MNH/ini_spectren.f90 b/src/MNH/ini_spectren.f90
index 1d6bc3eefe6e98c6b53edb1a4346b1c613ed793b..1067f2ceffdbf2de2b8de02dcf94039a76a01378 100644
--- a/src/MNH/ini_spectren.f90
+++ b/src/MNH/ini_spectren.f90
@@ -58,7 +58,7 @@ USE MODD_CTURB
USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
-USE MODD_DRAGTREE
+USE MODD_DRAGTREE_n
USE MODD_DUST
USE MODD_DYN
USE MODD_DYN_n
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index 219e12397615e3a52af8ccd216f6eafc00f2ff9d..da26379bfef33982e86a2702a2be47a155524698 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.f90
@@ -64,23 +64,27 @@ END MODULE MODI_INI_SURFSTATION_n
!! -------------
!! P. Tulet 15/01/2002
!! A. Lemonsu 19/11/2002
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! R. Schoetter 11/2019: work for cartesian coordinates + parallel.
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONF
+USE MODD_DIM_n
USE MODD_DYN_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
+USE MODD_SHADOWS_n
USE MODD_STATION_n
USE MODD_TYPE_DATE
+USE MODD_VAR_ll, ONLY: IP
!
+USE MODE_GATHER_ll
USE MODE_GRIDPROJ
USE MODE_ll
USE MODE_MSG
@@ -107,6 +111,7 @@ REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
INTEGER :: ISTORE ! number of storage instants
INTEGER :: ILUOUT ! logical unit
+INTEGER :: IIU_ll,IJU_ll,IRESP
!
!----------------------------------------------------------------------------
ILUOUT = TLUOUT%NLU
@@ -234,7 +239,6 @@ INTEGER :: JII !
INTEGER :: IIU, IJU !
!
IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
- LSTATLAT = .TRUE.
DO JII=1,NUMBSTAT
CALL GET_DIM_EXT_ll ('B',IIU,IJU)
CALL SM_XYHAT(PLATOR,PLONOR, &
@@ -242,11 +246,20 @@ IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
TSTATION%X(JII), TSTATION%Y(JII) )
ENDDO
ELSE
- LSTATLAT = .FALSE.
DO JII=1,NUMBSTAT
- TSTATION%X(JII) = XXHAT(TSTATION%I(JII))
- TSTATION%Y(JII) = XYHAT(TSTATION%I(JII))
CALL GET_DIM_EXT_ll ('B',IIU,IJU)
+ IIU_ll=NIMAX_ll + 2 * JPHEXT
+ IJU_ll=NJMAX_ll + 2 * JPHEXT
+ ALLOCATE(XXHAT_ll (IIU_ll))
+ ALLOCATE(XYHAT_ll (IJU_ll))
+ !
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,XXHAT_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,XYHAT_ll,IRESP)
+ TSTATION%X(JII) = XXHAT_ll(TSTATION%I(JII))
+ TSTATION%Y(JII) = XYHAT_ll(TSTATION%J(JII))
+ IF (LCARTESIAN) THEN
+ XRPK = -1
+ ENDIF
CALL SM_LATLON(PLATOR,PLONOR, &
TSTATION%X(JII), TSTATION%Y(JII), &
TSTATION%LAT(JII), TSTATION%LON(JII) )
diff --git a/src/MNH/ini_tke_eps.f90 b/src/MNH/ini_tke_eps.f90
index f0aba674f3ec36a83f1284b8fa33713cfd7af53f..c76c795b5e67772a14cd56384910110c2a55a010 100644
--- a/src/MNH/ini_tke_eps.f90
+++ b/src/MNH/ini_tke_eps.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -117,7 +117,7 @@ TYPE(LIST_ll), POINTER :: TPINITHALO3D_ll ! pointer for the
!
!* 0.2 Declaration of local variables
!
-INTEGER :: IKB,IKE,IKU! index value for the first and last inner
+INTEGER :: IKB,IKE ! index value for the first and last inner
! mass points
INTEGER :: JKK ! vertical loop index
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZDELTZ ! vertical
@@ -128,7 +128,6 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZDELTZ ! vertical
!
IKB=1+JPVEXT
IKE=SIZE(PTHT,3)-JPVEXT
-IKU=SIZE(PTHT,3)
!
!* 1. TKE DETERMINATION
! -----------------
@@ -150,9 +149,9 @@ IF (HGETTKET == 'INIT' ) THEN
!
! determines TKE
PTKET(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(1,IKU,1,MXF(MZM(1,IKU,1,PUT)))**2 &
- +DZF(1,IKU,1,MYF(MZM(1,IKU,1,PVT)))**2) / ZDELTZ &
- -(XG/PTHVREF)*XCSHF*DZF(1,IKU,1,MZM(1,IKU,1,PTHT)) &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
) / ZDELTZ
! positivity control
WHERE (PTKET < XTKEMIN) PTKET=XTKEMIN
diff --git a/src/MNH/initial_guess.f90 b/src/MNH/initial_guess.f90
index 6cffec168e49103fc509f7691bb965cd582fcbf9..9c99cca628b157bc5568c9bdfdd70db706ccaeab 100644
--- a/src/MNH/initial_guess.f90
+++ b/src/MNH/initial_guess.f90
@@ -187,12 +187,10 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT, PSVT
!* 0.2 declarations of local variables
!
INTEGER :: JRR, JSV
-INTEGER :: IKU
REAL :: ZINVTSTEP
!
!-------------------------------------------------------------------------------
!
-IKU=SIZE(XZHAT)
!* 1. COMPUTES THE INVERSE OF THE APPLICABLE TIMESTEP
! -----------------------------------------------
!
@@ -206,7 +204,7 @@ ZINVTSTEP = 1./PTSTEP
! forward-in-time time-marching scheme
PRUS = PUT * ZINVTSTEP * MXM(PRHODJ)
PRVS = PVT * ZINVTSTEP * MYM(PRHODJ)
-PRWS = PWT * ZINVTSTEP * MZM(1,IKU,1,PRHODJ)
+PRWS = PWT * ZINVTSTEP * MZM(PRHODJ)
!
! *** meteorological variables
!
diff --git a/src/MNH/interp3d.f90 b/src/MNH/interp3d.f90
index b5c2faa9db31d4193d7dae0c2f67abba16c4af5b..d6a05a70bba723815e295e7c8738e1f9a8e423b9 100644
--- a/src/MNH/interp3d.f90
+++ b/src/MNH/interp3d.f90
@@ -1,14 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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 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$
-!-----------------------------------------------------------------
+!###################
MODULE MODI_INTERP3D
-!#################################
+!###################
!
INTERFACE
SUBROUTINE INTERP3D(PFIELD,KGRID,PSVAL,PPLEV,PFIELDAP)
@@ -88,7 +85,6 @@ INTEGER :: IIE,IJE,IPU ! End of usefull area
INTEGER :: IIB,IJB,IKB ! Begining of usefull area
REAL, DIMENSION(SIZE(XPABST,1),SIZE(XPABST,2),SIZE(XPABST,3)) :: ZPTH ! pressure for grid points corresponding to KGRID type
REAL :: ZREF,ZXP,ZXM,ZDIXEPS ! pressure values and epsilon value
-INTEGER :: IKU
!-------------------------------------------------------------------------------
!
!* 1.
@@ -96,7 +92,6 @@ INTEGER :: IKU
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IPU=SIZE(PFIELDAP,3)
IKB=1 +JPVEXT
-IKU=SIZE(XZHAT)
ZDIXEPS=10.*EPSILON(1.)
!
SELECT CASE (KGRID)
@@ -109,7 +104,7 @@ SELECT CASE (KGRID)
ZPTH(:,:,:)=MYM(XPABST(:,:,:))
ZPTH(:,1,:)=2.*ZPTH(:,2,:) - ZPTH(:,3,:)
CASE(4)
- ZPTH(:,:,:)=MZM(1,IKU,1,XPABST(:,:,:))
+ ZPTH(:,:,:)=MZM(XPABST(:,:,:))
ZPTH(:,:,1)=2.*ZPTH(:,:,2) - ZPTH(:,:,3)
END SELECT
!
diff --git a/src/MNH/ion_drift.f90 b/src/MNH/ion_drift.f90
index 73edec604ea8572b9418b0181fabd74761dfcc78..b3187ca833f755e9a0ad1ab341f829d89d26c633 100644
--- a/src/MNH/ion_drift.f90
+++ b/src/MNH/ion_drift.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -74,7 +74,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
INTEGER :: IIB, IIE ! index of first and last inner mass points along x
INTEGER :: IJB, IJE ! index of first and last inner mass points along y
INTEGER :: IKB, IKE ! index of first and last inner mass points along z
-INTEGER :: IKU
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZDRIFTX
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZDRIFTY
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZDRIFTZ
@@ -95,7 +94,6 @@ NULLIFY(TZFIELDS_ll)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PSVT,3) - JPVEXT
-IKU = SIZE(PSVT,3)
!
!
!-------------------------------------------------------------------------------
@@ -166,7 +164,7 @@ ZDRIFTY(:,:,:) = -MYM(ZDRIFTY(:,:,:)) ! Put components at flux sides
! z-component of div term
ZDRIFTZ(:,:,:) = PSVT(:,:,:,NSV_ELECBEG) * XMOBIL_POS(:,:,:)
ZDRIFTZ(:,:,:) = ZDRIFTZ(:,:,:) * XEFIELDW(:,:,:)
-ZDRIFTZ(:,:,:) = -MZM(1,IKU,1,ZDRIFTZ(:,:,:)) ! Put components at flux sides
+ZDRIFTZ(:,:,:) = -MZM(ZDRIFTZ(:,:,:)) ! Put components at flux sides
!
IF (LWEST_ll( )) ZDRIFTX(IIB-1,:,:) = ZDRIFTX(IIB,:,:)
IF (LEAST_ll( )) ZDRIFTX(IIE+1,:,:) = ZDRIFTX(IIE,:,:)
@@ -192,7 +190,7 @@ ZDRIFTY(:,:,:) = +MYM(ZDRIFTY(:,:,:)) ! Put components at flux sides
! z-component of div term
ZDRIFTZ(:,:,:) = PSVT(:,:,:,NSV_ELECEND) * XMOBIL_NEG(:,:,:)
ZDRIFTZ(:,:,:) = ZDRIFTZ(:,:,:) * XEFIELDW(:,:,:)
-ZDRIFTZ(:,:,:) = +MZM(1,IKU,1,ZDRIFTZ(:,:,:)) ! Put components at flux sides
+ZDRIFTZ(:,:,:) = +MZM(ZDRIFTZ(:,:,:)) ! Put components at flux sides
!
IF (LWEST_ll( )) ZDRIFTX(IIB-1,:,:) = ZDRIFTX(IIB,:,:)
diff --git a/src/MNH/lap_m.f90 b/src/MNH/lap_m.f90
index a16fd80611ef94e9a60d6cc9707f68bdf3833ab3..f1936c828237a3c61b7f54fcb0ab6ee86376396a 100644
--- a/src/MNH/lap_m.f90
+++ b/src/MNH/lap_m.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! #################
MODULE MODI_LAP_M
! #################
@@ -211,7 +212,7 @@ IF(.NOT. L2D) THEN
ZV = MYM(PRHODJ) * ZV
ENDIF
!
-ZW = MZM(1,IKU,1,PRHODJ) * GZ_M_W(1,IKU,1,PY,PDZZ)
+ZW = MZM(PRHODJ) * GZ_M_W(1,IKU,1,PY,PDZZ)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/les_budget.f90 b/src/MNH/les_budget.f90
index 4ad63f048213dd5898db2b6cd09ae89c755a539b..da9b09c2022185ae5f4e27524d17ab32eb9f08ff 100644
--- a/src/MNH/les_budget.f90
+++ b/src/MNH/les_budget.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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.
@@ -399,7 +399,7 @@ INTEGER :: IINFO_ll
ZRHODJ(:,:,:) = MYM(XCURRENT_RHODJ)
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE ('Z')
- ZRHODJ(:,:,:) = MZM(1,IKU,1,XCURRENT_RHODJ)
+ ZRHODJ(:,:,:) = MZM(XCURRENT_RHODJ)
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE DEFAULT
ZRHODJ(:,:,:) = XCURRENT_RHODJ
@@ -417,7 +417,7 @@ INTEGER :: IINFO_ll
CASE ('Y')
ZS(:,:,:) = MYF(ZS)
CASE ('Z')
- ZS(:,:,:) = MZF(1,IKU,1,ZS)
+ ZS(:,:,:) = MZF(ZS)
END SELECT
CALL LES_ANOMALY_FIELD(ZS,PANOM)
diff --git a/src/MNH/les_budget_tendn.f90 b/src/MNH/les_budget_tendn.f90
index 88f033d8e0ad92ba150a3bd6117ab9ffcd27a223..35652009d4ca465bc5b6a480747514fc6822b28a 100644
--- a/src/MNH/les_budget_tendn.f90
+++ b/src/MNH/les_budget_tendn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 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 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 les 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
MODULE MODI_LES_BUDGET_TEND_n
! #######################
@@ -134,7 +129,7 @@ ALLOCATE(ZSV_ANOM (IIU,IJU,NLES_K,NSV))
CALL LES_ANOMALY_FIELD(MXF(XUT),ZU_ANOM)
CALL LES_ANOMALY_FIELD(MYF(XVT),ZV_ANOM)
-CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWT),ZW_ANOM)
+CALL LES_ANOMALY_FIELD(MZF(XWT),ZW_ANOM)
CALL LES_ANOMALY_FIELD(ZTHL,ZTHL_ANOM)
CALL LES_ANOMALY_FIELD(ZRT,ZRT_ANOM)
DO JSV=1,NSV
diff --git a/src/MNH/les_cloud_masksn.f90 b/src/MNH/les_cloud_masksn.f90
index daeb189e9c4857293aa878d87b0c9ad65e92d079..9b9bbf3b2bec186d39db42ade3c6b34e8bd54806 100644
--- a/src/MNH/les_cloud_masksn.f90
+++ b/src/MNH/les_cloud_masksn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2020 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 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 les 2006/10/16 14:59:17
-!-----------------------------------------------------------------
! #######################
SUBROUTINE LES_CLOUD_MASKS_n
! #######################
@@ -170,7 +165,7 @@ ZWORK1D=0.
ZWORK3D=0.
ZWORK3DB=0.
!
-CALL LES_VER_INT(MZF(1,IKU,1,XWT), ZW_LES)
+CALL LES_VER_INT(MZF(XWT), ZW_LES)
IF (NSV_CS>0) THEN
DO JSV=NSV_CSBEG, NSV_CSEND
CALL LES_VER_INT( XSVT(:,:,:,JSV), &
diff --git a/src/MNH/les_ini_timestepn.f90 b/src/MNH/les_ini_timestepn.f90
index 505067d9d0fa2bb49778609fb8bc01fff4989ad5..996e6b628416f82131d0db585616732d9aaf08a2 100644
--- a/src/MNH/les_ini_timestepn.f90
+++ b/src/MNH/les_ini_timestepn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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.
@@ -357,7 +357,7 @@ CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
!
CALL LES_ANOMALY_FIELD(MXF(XUT),XU_ANOM)
CALL LES_ANOMALY_FIELD(MYF(XVT),XV_ANOM)
-CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWT),XW_ANOM)
+CALL LES_ANOMALY_FIELD(MZF(XWT),XW_ANOM)
CALL LES_ANOMALY_FIELD(ZTHL,XTHL_ANOM)
IF (LUSERV) CALL LES_ANOMALY_FIELD(ZRT,XRT_ANOM)
DO JSV=1,NSV
diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90
index 3eae3fc04d59c273e750b89bb0ef769ad7e3d3f9..aca09170f137177acc0c2a77d5394c067a7f302d 100644
--- a/src/MNH/lesn.f90
+++ b/src/MNH/lesn.f90
@@ -1,8 +1,7 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/lesn.f90,v $
!-----------------------------------------------------------------
! #################
SUBROUTINE LES_n
@@ -200,7 +199,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZWORK !
!
INTEGER :: IRR ! moist variables counter
INTEGER :: JSV ! scalar variables counter
-INTEGER :: IIU, IJU,IKU ! array sizes
+INTEGER :: IIU, IJU ! array sizes
INTEGER :: IKE,IKB
INTEGER :: JI, JJ, JK ! loop counters
INTEGER :: IIU_ll, IJU_ll ! total domain I size (fin)
@@ -225,8 +224,7 @@ IIU_ll = IIMAX_ll+JPHEXT
IJU_ll = IJMAX_ll+JPHEXT
IIA_ll=JPHEXT+1
IJA_ll=JPHEXT+1
-IKU=SIZE(XVT,3)
-IKE=IKU-JPVEXT
+IKE=SIZE(XVT,3)-JPVEXT
IKB=1+JPVEXT
CALL GET_DIM_EXT_ll('B',IIU,IJU)
!
@@ -485,7 +483,7 @@ ELSE
END IF
!
! computation of mass flux
-ZMASSF=MZM(1,IKU,1,ZRHO)*XWT
+ZMASSF=MZM(ZRHO)*XWT
!
!-------------------------------------------------------------------------------
!
@@ -512,25 +510,25 @@ CALL LES_VER_INT( XTHP, ZTP_LES )
CALL LES_VER_INT( XTR, ZTR_LES )
CALL LES_VER_INT( XDISS, ZDISS_LES )
CALL LES_VER_INT( XLEM, ZLM_LES )
-CALL LES_VER_INT( GZ_M_M(1,IKU,1,XPABST,XDZZ), ZDPDZ_LES )
+CALL LES_VER_INT( GZ_M_M(XPABST,XDZZ), ZDPDZ_LES )
!
CALL LES_VER_INT( MXF(XUT) ,ZU_LES )
CALL LES_VER_INT( MYF(XVT) ,ZV_LES )
-CALL LES_VER_INT( MZF(1,IKU,1,XWT) ,ZW_LES )
-CALL LES_VER_INT( MZF(1,IKU,1,ZMASSF) ,ZMF_LES)
+CALL LES_VER_INT( MZF(XWT) ,ZW_LES )
+CALL LES_VER_INT( MZF(ZMASSF) ,ZMF_LES)
CALL LES_VER_INT( XTHT ,ZTH_LES )
-CALL LES_VER_INT( MXF(MZF(1,IKU,1,GZ_U_UW(1,IKU,1,XUT,XDZZ))), ZDUDZ_LES )
-CALL LES_VER_INT( MYF(MZF(1,IKU,1,GZ_V_VW(1,IKU,1,XVT,XDZZ))), ZDVDZ_LES )
-CALL LES_VER_INT( GZ_W_M(1,IKU,1,XWT,XDZZ), ZDWDZ_LES )
+CALL LES_VER_INT( MXF(MZF(GZ_U_UW(XUT,XDZZ))), ZDUDZ_LES )
+CALL LES_VER_INT( MYF(MZF(GZ_V_VW(XVT,XDZZ))), ZDVDZ_LES )
+CALL LES_VER_INT( GZ_W_M(XWT,XDZZ), ZDWDZ_LES )
CALL LES_VER_INT( ZEXN, ZEXN_LES)
!
-CALL LES_VER_INT( GZ_M_M(1,IKU,1,XTHT,XDZZ), ZDTHDZ_LES )
+CALL LES_VER_INT( GZ_M_M(XTHT,XDZZ), ZDTHDZ_LES )
!
CALL LES_VER_INT(ZRHO, ZRHO_LES)
!
IF (LUSERV) CALL LES_VER_INT(ZTHV, ZTHV_LES)
CALL LES_VER_INT(ZTHL, ZTHL_LES)
-CALL LES_VER_INT( GZ_M_M(1,IKU,1,ZTHL,XDZZ), ZDTHLDZ_LES )
+CALL LES_VER_INT( GZ_M_M(ZTHL,XDZZ), ZDTHLDZ_LES )
!
CALL LES_VER_INT( XTKET ,ZTKE_LES)
IRR = 0
@@ -538,7 +536,7 @@ IF (LUSERV) THEN
IRR = IRR + 1
CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRV_LES )
CALL LES_VER_INT( ZRT(:,:,:) ,ZRT_LES )
- CALL LES_VER_INT( GZ_M_M(1,IKU,1,ZRT,XDZZ), ZDRTDZ_LES )
+ CALL LES_VER_INT( GZ_M_M(ZRT,XDZZ), ZDRTDZ_LES )
CALL LES_VER_INT( ZREHU(:,:,:) ,ZREHU_LES)
END IF
IF (LUSERC) THEN
@@ -637,7 +635,7 @@ END IF
IF (NSV>0) THEN
DO JSV=1,NSV
CALL LES_VER_INT( XSVT(:,:,:,JSV), ZSV_LES(:,:,:,JSV) )
- CALL LES_VER_INT( GZ_M_M(1,IKU,1,XSVT(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
+ CALL LES_VER_INT( GZ_M_M(XSVT(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
END DO
END IF
!
@@ -870,7 +868,7 @@ END DO
!
IF (NLES_CURRENT_TCOUNT==1) THEN
ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
- CALL LES_VER_INT( MZF(1,IKU,1,XZZ) ,ZZ_LES )
+ CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
DEALLOCATE(ZZ_LES)
CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
@@ -885,7 +883,7 @@ END IF
!
CALL SPEC_VER_INT(IMI, MXF(XUT) ,ZU_SPEC )
CALL SPEC_VER_INT(IMI, MYF(XVT) ,ZV_SPEC )
-CALL SPEC_VER_INT(IMI, MZF(1,IKU,1,XWT) ,ZW_SPEC )
+CALL SPEC_VER_INT(IMI, MZF(XWT) ,ZW_SPEC )
CALL SPEC_VER_INT(IMI, XTHT ,ZTH_SPEC )
IF (LUSERC) CALL SPEC_VER_INT(IMI, ZTHL ,ZTHL_SPEC)
IRR = 0
diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90
index c38fb972d5fbb3584a0323634f0942659430846a..74ea0d31cd6d50dca68459280cee6cbc1b5a86ad 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/lima.f90
@@ -14,7 +14,7 @@ INTERFACE
PRHODREF, PEXNREF, PDZZ, &
PRHODJ, PPABSM, PPABST, &
NCCN, NIFN, NIMM, &
- PTHM, PTHT, PRT, PSVT, PW_NU, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
PEVAP3D )
@@ -41,7 +41,7 @@ INTEGER, INTENT(IN) :: NCCN ! for array size declarati
INTEGER, INTENT(IN) :: NIFN ! for array size declarations
INTEGER, INTENT(IN) :: NIMM ! for array size declarations
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
@@ -71,7 +71,7 @@ END MODULE MODI_LIMA
PRHODREF, PEXNREF, PDZZ, &
PRHODJ, PPABSM, PPABST, &
NCCN, NIFN, NIMM, &
- PTHM, PTHT, PRT, PSVT, PW_NU, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
PEVAP3D )
@@ -96,8 +96,10 @@ END MODULE MODI_LIMA
!! -------------
!! Original 15/03/2018
!!
-!! B.Vié 02/2019 : minor correction on budget
+! B. Vie 02/2019: minor correction on budget
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! P. Wautelet 26/02/2020: bugfix: corrected condition to write budget CORR_BU_RRS
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!
!* 0. DECLARATIONS
! ------------
@@ -155,7 +157,7 @@ INTEGER, INTENT(IN) :: NCCN ! for array size declarati
INTEGER, INTENT(IN) :: NIFN ! for array size declarations
INTEGER, INTENT(IN) :: NIMM ! for array size declarations
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
@@ -193,7 +195,7 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFS
!
! Other 3D thermodynamical variables
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZEXN, ZT, ZTM
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZEXN, ZT
!
! Packed prognostic & thermo variables
@@ -674,7 +676,7 @@ IF (LWARM .AND. LDEPOC) THEN
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0
+ GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0 .AND. ZRCT(:,:,IKB) >0 .AND. ZCCT(:,:,IKB) >0
WHERE (GDEP)
ZRCS(:,:,IKB) = ZRCS(:,:,IKB) - XVDEPOC * ZRCT(:,:,IKB) / PDZZ(:,:,IKB)
ZCCS(:,:,IKB) = ZCCS(:,:,IKB) - XVDEPOC * ZCCT(:,:,IKB) / PDZZ(:,:,IKB)
@@ -734,18 +736,11 @@ IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
!* 2. Nucleation processes
! --------------------
!
-!
-IF( LACTIT ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
-!
CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, ZEXN, PPABST, ZT, ZTM, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, &
- ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT )
+ PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
+ ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZCCT, ZCRT, ZCIT, &
+ ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT )
!
! Saving sources before microphysics time-splitting loop
!
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index db514c5ff444a6ec46f23be4273f9332c229de55..91d1b4d348c72e60e9b904c741ca4c5a72843d45 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -1134,8 +1134,8 @@ DEALLOCATE(ZCTMIN)
!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
!
IF ( .NOT. OSUBG_COND ) THEN
-! WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
- WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
+! WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
ZW(:,:,:) = 1.
ELSEWHERE
ZW(:,:,:) = 0.
diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90
index f7ef813095a0e02ac59946c7093d8bd3df2f251c..11c08da021a3b016ed3f1ddde9f2a116bf70d114 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.f90
@@ -8,9 +8,9 @@
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
USE MODD_IO, ONLY: TFILEDATA
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
@@ -22,8 +22,8 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -40,9 +40,9 @@ END SUBROUTINE LIMA_CCN_ACTIVATION
END INTERFACE
END MODULE MODI_LIMA_CCN_ACTIVATION
! #############################################################################
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
! #############################################################################
!
!!
@@ -87,6 +87,7 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
@@ -123,8 +124,8 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -198,9 +199,10 @@ IKE=SIZE(PRHODREF,3) - JPVEXT
! Saturation vapor mixing ratio and radiative tendency
!
ZEPS= XMV / XMD
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
-IF (LACTIT) ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
+!IF (LACTIT) ZTDT(:,:,:) = (PT(:,:,:)-PTM(:,:,:))/PTSTEP ! dT/dt
!
! find locations where CCN are available
!
@@ -220,13 +222,13 @@ IF( LACTIT ) THEN
ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
ELSE
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
END IF
INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
@@ -251,7 +253,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZRHODREF(INUCT))
ALLOCATE(ZEXNREF(INUCT))
DO JL=1,INUCT
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
@@ -422,7 +424,7 @@ IF( INUCT >= 1 ) THEN
END WHERE
ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
!
- PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
(PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
diff --git a/src/MNH/lima_droplets_autoconversion.f90 b/src/MNH/lima_droplets_autoconversion.f90
index 2f2c911100c174146817e1ab5db7e2ae87966098..f88eb265d4d599ecdbb43cf0035fef6923c2212e 100644
--- a/src/MNH/lima_droplets_autoconversion.f90
+++ b/src/MNH/lima_droplets_autoconversion.f90
@@ -57,7 +57,7 @@ END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+!! B. Vie 02/03/2020 : missing CC process
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -125,11 +125,11 @@ WHERE( PRCT(:)>XRTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
! min (80 microns, D_h, D_r)
ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC
!
- P_CC_AUTO(:) = 0.
+ P_CC_AUTO(:) = -ZW3(:)
P_CR_AUTO(:) = ZW3(:)
!
PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
- PA_CC(:) = PA_CC(:)
+ PA_CC(:) = PA_CC(:) + P_CC_AUTO(:)
PA_RR(:) = PA_RR(:) - P_RC_AUTO(:)
PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
END WHERE
diff --git a/src/MNH/lima_inst_procs.f90 b/src/MNH/lima_inst_procs.f90
index fe22db3a839f9a512f80485587ac6f7d6cfab536..a03eed7e3af5aa42c376955b9d8094bde1204feb 100644
--- a/src/MNH/lima_inst_procs.f90
+++ b/src/MNH/lima_inst_procs.f90
@@ -95,7 +95,7 @@ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE,
!-------------------------------------------------------------------------------
!
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, NMOD_CCN, NMOD_IFN
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LWARM, LRAIN
!
USE MODI_LIMA_DROPS_BREAK_UP
USE MODI_LIMA_DROPS_HOM_FREEZING
diff --git a/src/MNH/lima_nucleation_procs.f90 b/src/MNH/lima_nucleation_procs.f90
index a7b7c98499b1a58c0c8a962cc8d5ff8ff6b5b9dc..4f3fb00b136386359fbe84b9eb62ea0657c7d3de 100644
--- a/src/MNH/lima_nucleation_procs.f90
+++ b/src/MNH/lima_nucleation_procs.f90
@@ -8,11 +8,11 @@
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
+ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -25,7 +25,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
@@ -50,13 +50,13 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
END SUBROUTINE LIMA_NUCLEATION_PROCS
END INTERFACE
END MODULE MODI_LIMA_NUCLEATION_PROCS
-! #############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
-! #############################################################################
+! ############################################################################
+SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
+! ############################################################################
!
!! PURPOSE
!! -------
@@ -69,9 +69,9 @@ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ,
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
@@ -106,7 +106,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
@@ -151,9 +151,9 @@ IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 ) THEN
end if
end if
- CALL LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT)
+ CALL LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
if ( lbu_enable ) then
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
diff --git a/src/MNH/lima_sedimentation.f90 b/src/MNH/lima_sedimentation.f90
index 88a0a544ba43209e515ae2bf972eff8a57b79714..365ae0f23362e17a84e8f9ab1682d8dc165f38dd 100644
--- a/src/MNH/lima_sedimentation.f90
+++ b/src/MNH/lima_sedimentation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2018-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-2020 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.
@@ -65,6 +65,7 @@ END MODULE MODI_LIMA_SEDIMENTATION
!! B.Vie 02/2019 Desactivate (comment) the heat transport by droplets
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! B. Vie 03/2020: disable temperature change of droplets by air temperature
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -230,7 +231,7 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZY)
!
PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,KKB)/XRHOLW/NSPLITSED(KID) ! in m/s
- PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
+ !PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
END IF
END DO
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
index d47b2f25e1b24a9899d5dd731239c1d6551fc584..e1d141829a82859f73a51d6cff2726aa19f83012 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.f90
@@ -128,6 +128,8 @@ END MODULE MODI_LIMA_WARM
!! J. Escobar : for real*4 , use XMNH_HUGE
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! B. Vie 03/02/2020: correction of activation of water deposition on the ground
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -220,16 +222,16 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
PCCS, & ! Cloud water C. source
PCRS ! Rain water C. source
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNFS ! CCN C. available source
!used as Free ice nuclei for
!HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNAS ! Cloud C. nuclei C. source
!used as Free ice nuclei for
!IMMERSION freezing
!
!
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZT, ZTM
+ :: ZT
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
integer :: idx
@@ -271,15 +273,15 @@ IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
!
IF ( NMOD_CCN .GE. 1 ) THEN
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ZNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ ZNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
ELSE
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ZNFS(:,:,:,:) = 0.
+ ZNAS(:,:,:,:) = 0.
END IF
!
!-------------------------------------------------------------------------------
@@ -304,11 +306,6 @@ WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
END WHERE
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-IF( OACTIT ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
!
!-------------------------------------------------------------------------------
!
@@ -347,7 +344,7 @@ IF (LDEPOC) THEN
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0
+ GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0 .AND. PRCT(:,:,2) >0 .AND. PCCT(:,:,2) >0
WHERE (GDEP)
PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
@@ -373,14 +370,14 @@ IF ( LACTI .AND. NMOD_CCN > 0 ) THEN
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
- CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+ CALL LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, ZT, PTHM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, ZNFS, ZNAS )
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
@@ -389,7 +386,7 @@ IF ( LACTI .AND. NMOD_CCN > 0 ) THEN
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
END IF ! LACTI
@@ -473,14 +470,12 @@ IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
!
IF ( NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZNAS(:,:,:,:)
END IF
!
-!++cb++
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-!--cb--
+IF (ALLOCATED(ZNFS)) DEALLOCATE(ZNFS)
+IF (ALLOCATED(ZNAS)) DEALLOCATE(ZNAS)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 4bfbe6f8ccb07aed3271cdfd769d848ab81bfc13..55fac0b764ba0269a66b103e052de5dc33425232 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -9,7 +9,7 @@
!
INTERFACE
SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
PRCM, PRVT, PRCT, PRRT, &
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
!
@@ -28,8 +28,8 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -53,7 +53,7 @@ END INTERFACE
END MODULE MODI_LIMA_WARM_NUCL
! #############################################################################
SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
PRCM, PRVT, PRCT, PRRT, &
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
! #############################################################################
@@ -105,7 +105,7 @@ END MODULE MODI_LIMA_WARM_NUCL
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -141,8 +141,8 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -222,13 +222,7 @@ IJE=SIZE(PRHODREF,2) - JPHEXT
IKB=1+JPVEXT
IKE=SIZE(PRHODREF,3) - JPVEXT
!
-!++cb++
-!ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-!--cb--
ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-!++cb++
-!ZRTMIN(:) = XRTMIN(:) / PTSTEP
-!--cb--
ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
! Saturation vapor mixing ratio and radiative tendency
@@ -236,11 +230,12 @@ ZCTMIN(:) = XCTMIN(:) / PTSTEP
ZEPS= XMV / XMD
!
ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
!! ZDRC(:,:,:) = 0.
-IF (OACTIT) THEN
- ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+IF (OACTIT .AND. SIZE(PTM).GT.0) THEN
+ ZTDT(:,:,:) = PTM(:,:,:) ! dThRad
+! ZTDT(:,:,:) = (PT(:,:,:)-PTM(:,:,:))/PTSTEP ! dT/dt
!!! JPP
!!! JPP
!!! ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
@@ -251,7 +246,7 @@ IF (OACTIT) THEN
!! BV - W and drc/dt effect should not be included in ZTDT (already accounted for in the computations) ?
!!
!! ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
-!! (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
+!! (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
END IF
!
! find locations where CCN are available
@@ -272,13 +267,13 @@ IF( OACTIT ) THEN
ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
ELSE
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
END IF
INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
@@ -306,7 +301,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZEXNREF(INUCT))
DO JL=1,INUCT
ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
@@ -484,7 +479,7 @@ IF( INUCT >= 1 ) THEN
!
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
+ ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
(PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
!
diff --git a/src/MNH/metrics.f90 b/src/MNH/metrics.f90
index 6d292f948693ed1cdceb775cefb07e519eefd63a..b973e0920ed8e38b3ed6371269cfe5cd342a7a0b 100644
--- a/src/MNH/metrics.f90
+++ b/src/MNH/metrics.f90
@@ -1,14 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! ###################
MODULE MODI_METRICS
! ###################
@@ -162,7 +156,7 @@ ELSE
ZD1=1.
END IF
IF (.NOT.LCARTESIAN) THEN
- ZDZZ(:,:,:) = MZF(1,IKU,1, 1.+ ZD1*PZZ(:,:,:)/XRADIUS)
+ ZDZZ(:,:,:) = MZF( 1.+ ZD1*PZZ(:,:,:)/XRADIUS)
DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PDXX(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDXHAT(JI) /PMAP(JI,JJ)
PDYY(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDYHAT(JJ) /PMAP(JI,JJ)
@@ -201,7 +195,7 @@ PDZY(:,:,:) = DYM(PZZ(:,:,:))
!* 4. COMPUTE PDZZ :
! -------------
!
-PDZZ(:,:,:) = DZM(1,IKU,1,MZF(1,IKU,1,PZZ(:,:,:)))
+PDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
PDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1) ! same delta z in IKU and IKU -1
PDZZ(:,:,1) = PDZZ(:,:,2) ! same delta z in 1 and 2
!20131024
diff --git a/src/MNH/mnhget_surf_paramn.f90 b/src/MNH/mnhget_surf_paramn.f90
index da6c4608943b601d01edfbb2a234079a68c551cb..ff527fcf295540f0ec92cf3c285998a33b3f0cb2 100644
--- a/src/MNH/mnhget_surf_paramn.f90
+++ b/src/MNH/mnhget_surf_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 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.
@@ -9,15 +9,19 @@
INTERFACE
SUBROUTINE MNHGET_SURF_PARAM_n(PCOVER,PSEA,KCOVER,PRN,PH,PLE,PLEI,PGFLUX, &
PT2M,PQ2M,PHU2M,PZON10M,PMER10M,PZS,PTOWN,&
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, PWALL_O_HOR, &
+ PBUILD_HEIGHT,PNATURE )
!
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCOVER ! cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PSEA ! sea fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PNATURE ! nature fraction
INTEGER, INTENT(OUT), OPTIONAL :: KCOVER ! number of cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBARE ! Bare soil fraction
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE !
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Tree leaf area index [m^2(leaf)/m^2(nature)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE ! Tree height [m]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PRN ! Net radiation at surface (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PH ! Sensible heat flux (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PLE ! Total Latent heat flux (W/m2)
@@ -38,7 +42,8 @@ END MODULE MODI_MNHGET_SURF_PARAM_n
! ########################################
SUBROUTINE MNHGET_SURF_PARAM_n(PCOVER,PSEA,KCOVER,PRN,PH,PLE,PLEI,PGFLUX, &
PT2M,PQ2M,PHU2M,PZON10M,PMER10M,PZS,PTOWN,&
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, PWALL_O_HOR, &
+ PBUILD_HEIGHT,PNATURE )
! ########################################
!
!!**** *MNHGET_SURF_PARAM_n* - gets some surface fields on MESONH grid
@@ -74,6 +79,8 @@ END MODULE MODI_MNHGET_SURF_PARAM_n
!! S. Donier 06/2015 : bug surface aerosols
!! 06/2016 (G.Delautier) phasage surfex 8
!! 01/2018 (G.Delautier) SURFEX 8.1
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! P. Wautelet 11/03/2020: bugfix: add present checks before working on optional arrays
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -101,10 +108,13 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCOVER ! cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PSEA ! sea fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PNATURE ! nature fraction
INTEGER, INTENT(OUT), OPTIONAL :: KCOVER ! number of cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBARE ! Bare soil fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE !
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE !
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PRN ! Net radiation at surface (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PH ! Sensible heat flux (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PLE ! Total Latent heat flux (W/m2)
@@ -137,6 +147,8 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE! nature fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZTOWN ! town fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZVH
REAL, DIMENSION(:), ALLOCATABLE :: ZLAI
+REAL, DIMENSION(:), ALLOCATABLE :: ZWALL_O_HOR ! Facade surface density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:), ALLOCATABLE :: ZBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), ALLOCATABLE :: ZBARE ! bare soil fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZZS ! orography
REAL, DIMENSION(:), ALLOCATABLE :: ZRN ! net radiation at surface (W/m2)
@@ -170,8 +182,9 @@ IF (PRESENT(PCOVER)) THEN
DEALLOCATE(ZCOVER)
END IF
!
-IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. &
- PRESENT(PBARE) .OR. PRESENT(PLAI_TREE) .OR. PRESENT(PH_TREE)) THEN
+IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. PRESENT(PNATURE) .OR. &
+ PRESENT(PBARE) .OR. PRESENT(PLAI_TREE) .OR. PRESENT(PH_TREE) .OR. &
+ PRESENT(PWALL_O_HOR) .OR. PRESENT(PBUILD_HEIGHT) ) THEN
ALLOCATE(ZSEA ( ILU ))
ALLOCATE(ZWATER ( ILU ))
ALLOCATE(ZNATURE( ILU ))
@@ -183,6 +196,9 @@ IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. &
IF (PRESENT(PTOWN)) THEN
CALL REMOVE_HALO(ZTOWN,PTOWN)
END IF
+ IF (PRESENT(PNATURE)) THEN
+ CALL REMOVE_HALO(ZNATURE,PNATURE)
+ END IF
END IF
!
IF (PRESENT(PBARE)) THEN
@@ -242,12 +258,28 @@ IF (PRESENT(PH_TREE) .OR.PRESENT(PLAI_TREE)) THEN
YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
YSURF_CUR%U,YSURF_CUR%USS,&
'MESONH',ILU,1,PNATURE=ZNATURE,PLAI_TREE=ZLAI,PH_TREE=ZVH)
- CALL REMOVE_HALO(ZLAI,PLAI_TREE)
- CALL REMOVE_HALO(ZVH,PH_TREE)
+ IF ( PRESENT( PLAI_TREE ) ) CALL REMOVE_HALO(ZLAI,PLAI_TREE)
+ IF ( PRESENT( PH_TREE ) ) CALL REMOVE_HALO(ZVH,PH_TREE)
DEALLOCATE(ZVH)
DEALLOCATE(ZLAI)
END IF
!
+IF (PRESENT(PWALL_O_HOR) .OR. PRESENT(PBUILD_HEIGHT)) THEN
+ IF ( PRESENT ( PBUILD_HEIGHT ) ) PBUILD_HEIGHT(:,:) = XUNDEF
+ IF ( PRESENT ( PWALL_O_HOR ) ) PWALL_O_HOR(:,:) = XUNDEF
+ ALLOCATE(ZBUILD_HEIGHT ( ILU ))
+ ALLOCATE(ZWALL_O_HOR ( ILU ))
+ CALL GET_SURF_VAR_n(YSURF_CUR%FM,YSURF_CUR%IM,YSURF_CUR%SM,YSURF_CUR%TM, &
+ YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
+ YSURF_CUR%U,YSURF_CUR%USS,&
+ 'MESONH',ILU,1,PTOWN=ZTOWN, &
+ PWALL_O_HOR=ZWALL_O_HOR,PBUILD_HEIGHT=ZBUILD_HEIGHT )
+ IF ( PRESENT ( PBUILD_HEIGHT ) ) CALL REMOVE_HALO(ZBUILD_HEIGHT,PBUILD_HEIGHT)
+ IF ( PRESENT ( PWALL_O_HOR ) ) CALL REMOVE_HALO(ZWALL_O_HOR,PWALL_O_HOR)
+ DEALLOCATE(ZBUILD_HEIGHT)
+ DEALLOCATE(ZWALL_O_HOR)
+END IF
+!
IF (ALLOCATED(ZSEA)) THEN
DEALLOCATE(ZSEA )
DEALLOCATE(ZWATER )
diff --git a/src/MNH/modd_budget.f90 b/src/MNH/modd_budget.f90
index 7148c157e0d7e9913e073378ab420a89b34ec271..e78adebe538c585094b14238b087cc39f9517b92 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -49,6 +49,7 @@
! P. Wautelet 27/01/2020: use the tfield_metadata_base abstract datatype
! P. Wautelet 28/01/2020: add missing budgets for viscosity
! P. Wautelet 28/01/2020: add trhodj in tbudgetdata datatype
+! B. Vie 03/02/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! P. Wautelet 09/03/2020: add tburhodj variable
! P .Wautelet 09/03/2020: add missing budgets for electricity
!-------------------------------------------------------------------------------
@@ -433,6 +434,9 @@ INTEGER, SAVE :: NFRCRR ! forcing
INTEGER, SAVE :: NDIFRR ! numerical diffusion
INTEGER, SAVE :: NRELRR ! relaxation
INTEGER, SAVE :: NNEGARR ! negative correction
+INTEGER, SAVE :: NNETURRR ! negative correction
+INTEGER, SAVE :: NNEADVRR ! negative correction
+INTEGER, SAVE :: NNECONRR ! negative correction
INTEGER, SAVE :: NACCRRR ! accretion
INTEGER, SAVE :: NAUTORR ! autoconversion
INTEGER, SAVE :: NREVARR ! rain evaporation
@@ -469,6 +473,9 @@ INTEGER, SAVE :: NDCONVRI ! Deep CONVection
INTEGER, SAVE :: NHTURBRI ! horizontal turbulence
INTEGER, SAVE :: NVTURBRI ! vertical turbulence
INTEGER, SAVE :: NNEGARI ! negative correction
+INTEGER, SAVE :: NNETURRI ! negative correction
+INTEGER, SAVE :: NNEADVRI ! negative correction
+INTEGER, SAVE :: NNECONRI ! negative correction
INTEGER, SAVE :: NSEDIRI ! SEDImentation ICE3
INTEGER, SAVE :: NHENURI ! HEterogenous NUcleation ICE3
INTEGER, SAVE :: NHONRI ! HOmogeneous Nucleation ICE3
@@ -508,6 +515,9 @@ INTEGER, SAVE :: NFRCRS ! forcing
INTEGER, SAVE :: NDIFRS ! numerical diffusion
INTEGER, SAVE :: NRELRS ! relaxation
INTEGER, SAVE :: NNEGARS ! negative correction
+INTEGER, SAVE :: NNETURRS ! negative correction
+INTEGER, SAVE :: NNEADVRS ! negative correction
+INTEGER, SAVE :: NNECONRS ! negative correction
INTEGER, SAVE :: NSEDIRS ! SEDImentation ICE3
INTEGER, SAVE :: NDEPSRS ! DEPosition on Snow ICE3
INTEGER, SAVE :: NAGGSRS ! AGGregation of snow ICE3
@@ -538,6 +548,9 @@ INTEGER, SAVE :: NFRCRG ! forcing
INTEGER, SAVE :: NDIFRG ! numerical diffusion
INTEGER, SAVE :: NRELRG ! relaxation
INTEGER, SAVE :: NNEGARG ! negative correction
+INTEGER, SAVE :: NNETURRG ! negative correction
+INTEGER, SAVE :: NNEADVRG ! negative correction
+INTEGER, SAVE :: NNECONRG ! negative correction
INTEGER, SAVE :: NSEDIRG ! SEDImentation ICE3
INTEGER, SAVE :: NSFRRG ! Spontaneous FReezing ICE3
INTEGER, SAVE :: NDEPGRG ! DEPosition on Snow ICE3
@@ -571,6 +584,9 @@ INTEGER, SAVE :: NFRCRH ! forcing
INTEGER, SAVE :: NDIFRH ! numerical diffusion
INTEGER, SAVE :: NRELRH ! relaxation
INTEGER, SAVE :: NNEGARH ! negative correction
+INTEGER, SAVE :: NNETURRH ! negative correction
+INTEGER, SAVE :: NNEADVRH ! negative correction
+INTEGER, SAVE :: NNECONRH ! negative correction
INTEGER, SAVE :: NSEDIRH ! sedimentation
INTEGER, SAVE :: NWETGRH ! wet growth of graupel
INTEGER, SAVE :: NWETHRH ! wet growth of hail
diff --git a/src/MNH/modd_dragbldgn.f90 b/src/MNH/modd_dragbldgn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f89fc0d09d34143191714cca3d89bbf9a55ab580
--- /dev/null
+++ b/src/MNH/modd_dragbldgn.f90
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 2019-2020 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_DRAGBLDG_n
+!! #####################
+!!
+!!*** *MODD_DRAGBLDG*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account building drag in Meso-NH instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! R.Schoetter *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2019
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE DRAGBLDG_t
+ !
+ LOGICAL :: LDRAGBLDG ! flag used to take into account building drag in
+ ! ! the atmospheric model instead of SURFEX.
+ !
+END TYPE DRAGBLDG_t
+!
+TYPE(DRAGBLDG_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: DRAGBLDG_MODEL
+!
+LOGICAL, POINTER :: LDRAGBLDG=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE DRAGBLDG_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ LDRAGBLDG=>DRAGBLDG_MODEL(KTO)%LDRAGBLDG
+ !
+END SUBROUTINE DRAGBLDG_GOTO_MODEL
+!
+END MODULE MODD_DRAGBLDG_n
diff --git a/src/MNH/modd_dragtree.f90 b/src/MNH/modd_dragtree.f90
deleted file mode 100644
index 7390bf68283e54df8e4086a89c8d7953616aa8c4..0000000000000000000000000000000000000000
--- a/src/MNH/modd_dragtree.f90
+++ /dev/null
@@ -1,36 +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 MODD_DRAGTREE
-!! #####################
-!!
-!!*** *MODD_DRAGTREE*
-!!
-!! PURPOSE
-!! -------
-! Declaration to take into account tree drag in Meso-NH
-! instead of SURFEX.
-!!
-!!** AUTHOR
-!! ------
-!! C.Lac *CNRM*
-!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/06/11
-!! 06/16 (C.Lac) Add droplet deposition
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-IMPLICIT NONE
-LOGICAL :: LDRAGTREE ! flag used to take into account tree drag in
-! ! the atmospheric model instead of SURFEX.
-LOGICAL :: LDEPOTREE ! flag for droplet deposition on trees
-!
-REAL :: XVDEPOTREE ! Droplet deposition velocity
-!
-END MODULE MODD_DRAGTREE
diff --git a/src/MNH/modd_dragtreen.f90 b/src/MNH/modd_dragtreen.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0ed016777983a5fcc69e029270e2c41838aba595
--- /dev/null
+++ b/src/MNH/modd_dragtreen.f90
@@ -0,0 +1,65 @@
+!MNH_LIC Copyright 2011-2020 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_DRAGTREE_n
+!! #####################
+!!
+!!*** *MODD_DRAGTREE*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account tree drag in Meso-NH
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! C.Lac *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/06/11
+!! 06/16 (C.Lac) Add droplet deposition
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE DRAGTREE_t
+ !
+ LOGICAL :: LDRAGTREE ! flag used to take into account tree drag in
+ ! ! the atmospheric model instead of SURFEX.
+ LOGICAL :: LDEPOTREE ! flag for droplet deposition on trees
+ !
+ REAL :: XVDEPOTREE ! Droplet deposition velocity
+ !
+END TYPE DRAGTREE_t
+!
+TYPE(DRAGTREE_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: DRAGTREE_MODEL
+!
+LOGICAL,POINTER :: LDRAGTREE=>NULL()
+LOGICAL,POINTER :: LDEPOTREE=>NULL()
+REAL ,POINTER :: XVDEPOTREE=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE DRAGTREE_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ LDRAGTREE=>DRAGTREE_MODEL(KTO)%LDRAGTREE
+ LDEPOTREE=>DRAGTREE_MODEL(KTO)%LDEPOTREE
+ XVDEPOTREE=>DRAGTREE_MODEL(KTO)%XVDEPOTREE
+ !
+END SUBROUTINE DRAGTREE_GOTO_MODEL
+!
+END MODULE MODD_DRAGTREE_n
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 0fdd3c63315b69c0bc97eaa7852cea8b93884763..a430ad6034fce90152a49a63052db13cb2f87e2b 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -64,7 +64,6 @@ TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TDTFRC ! date of
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XUFRC, &! geostrophic wind
XVFRC, &! components U and V
XWFRC ! large scale vertical wind
-REAL, SAVE, DIMENSION(:,:,:),ALLOCATABLE:: XWTFRC ! large scale vertical wind
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTHFRC, &! large scale TH profile
XRVFRC ! large scale RV profile
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XGXTHFRC,&! large scale TH gradient
diff --git a/src/MNH/modd_frcn.f90 b/src/MNH/modd_frcn.f90
index 3a01de69f39beb23c12defa4307cfbb4d07b8161..fc9c683629d057037e5a9884658007863b4c6aba 100644
--- a/src/MNH/modd_frcn.f90
+++ b/src/MNH/modd_frcn.f90
@@ -35,11 +35,12 @@
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
-
+!
TYPE FRC_t
!
- REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()! Forcing wind components
- REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL() ! Forcing wind components
+ REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL() ! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL() ! large scale vertical wind
!
END TYPE FRC_t
@@ -47,6 +48,7 @@ TYPE(FRC_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FRC_MODEL
REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL()
CONTAINS
@@ -56,11 +58,13 @@ INTEGER, INTENT(IN) :: KFROM, KTO
! Save current state for allocated arrays
FRC_MODEL(KFROM)%XUFRC_PAST=>XUFRC_PAST
FRC_MODEL(KFROM)%XVFRC_PAST=>XVFRC_PAST
+FRC_MODEL(KFROM)%XWTFRC=>XWTFRC
!
! Current model is set to model KTO
XUFRC_PAST=>FRC_MODEL(KTO)%XUFRC_PAST
XVFRC_PAST=>FRC_MODEL(KTO)%XVFRC_PAST
-
+XWTFRC=>FRC_MODEL(KTO)%XWTFRC
+!
END SUBROUTINE FRC_GOTO_MODEL
END MODULE MODD_FRC_n
diff --git a/src/MNH/mode_prandtl.f90 b/src/MNH/mode_prandtl.f90
index 2215306e4cffe5e1f4f79323983001ebf4fe112f..a04e8aa6a4975ee2141b43df4ca538b98cf9d296 100644
--- a/src/MNH/mode_prandtl.f90
+++ b/src/MNH/mode_prandtl.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODE_PRANDTL
! ####################
@@ -363,10 +358,7 @@ D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_WTH_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -378,7 +370,7 @@ FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(KKA,KKU,KKL,PTKE) &
+M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE) &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
!
M3_WTH_W2TH(:,:,IKB-1)=M3_WTH_W2TH(:,:,IKB)
@@ -386,10 +378,7 @@ M3_WTH_W2TH(:,:,IKE+1)=M3_WTH_W2TH(:,:,IKE)
!
END FUNCTION M3_WTH_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -404,7 +393,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
- - XCSHF*PKEFF*1.5/MZM(KKA,KKU,KKL,PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
+ - XCSHF*PKEFF*1.5/MZM(PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
!
D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
@@ -412,12 +401,7 @@ D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -430,17 +414,14 @@ FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST*PDTDZ/PD
+M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST*PDTDZ/PD
!
M3_WTH_W2R(:,:,IKB-1)=M3_WTH_W2R(:,:,IKB)
M3_WTH_W2R(:,:,IKE+1)=M3_WTH_W2R(:,:,IKE)
!
END FUNCTION M3_WTH_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -454,7 +435,7 @@ FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST/PD &
+D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
@@ -462,12 +443,7 @@ D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_WTH_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -484,17 +460,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(KKA,KKU,KKL,PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
!
M3_WTH_WR2(:,:,IKB-1)=M3_WTH_WR2(:,:,IKB)
M3_WTH_WR2(:,:,IKE+1)=M3_WTH_WR2(:,:,IKE)
!
END FUNCTION M3_WTH_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -512,7 +485,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(KKA,KKU,KKL,PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
@@ -520,10 +493,7 @@ D_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_WTH_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -538,9 +508,9 @@ FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMO
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(KKA,KKU,KKL,PBETA*PTKE*PSQRT_TKE) &
+!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE) &
! *0.5*PLEPS/XCTD*(1+PREDR1)/PD
-M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(KKA,KKU,KKL,PBETA/PTKE*PSQRT_TKE) &
+M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE) &
*0.5*PLEPS/XCTD*(1+PREDR1)/PD
!
M3_WTH_WTHR(:,:,IKB-1)=M3_WTH_WTHR(:,:,IKB)
@@ -568,10 +538,7 @@ D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_WTH_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -585,7 +552,7 @@ FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2TH(:,:,:) = - MZF(KKA,KKU,KKL,(1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
+M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
* 1.5*PLM*PLEPS/PTKE*XCTV
!
M3_TH2_W2TH(:,:,IKB-1)=M3_TH2_W2TH(:,:,IKB)
@@ -593,10 +560,7 @@ M3_TH2_W2TH(:,:,IKE+1)=M3_TH2_W2TH(:,:,IKE)
!
END FUNCTION M3_TH2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -611,15 +575,15 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
IF (OUSERV) THEN
-! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL, &
+! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
! / (1.+PREDTH1)**2 )
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL, &
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
(1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2 )
ELSE
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL,1./(1.+PREDTH1)**2)
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2)
END IF
!
D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
@@ -627,10 +591,7 @@ D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_TH2_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -643,17 +604,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
- * MZF(KKA,KKU,KKL, (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
+ * MZF( (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
!
M3_TH2_WTH2(:,:,IKB-1)=M3_TH2_WTH2(:,:,IKB)
M3_TH2_WTH2(:,:,IKE+1)=M3_TH2_WTH2(:,:,IKE)
!
END FUNCTION M3_TH2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -668,7 +626,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PETHETA* (0.5/PD &
+ * MZF( PBLL_O_E*PETHETA* (0.5/PD &
- (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
) )
!
@@ -677,10 +635,7 @@ D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_TH2_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -694,17 +649,14 @@ FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(KKA,KKU,KKL,PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
+M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
!
M3_TH2_W2R(:,:,IKB-1)=M3_TH2_W2R(:,:,IKB)
M3_TH2_W2R(:,:,IKE+1)=M3_TH2_W2R(:,:,IKE)
!
END FUNCTION M3_TH2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -721,17 +673,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF( PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
!
D_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
D_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_TH2_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -744,17 +693,14 @@ FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF(KKA,KKU,KKL,(PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
+M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
!
M3_TH2_WR2(:,:,IKB-1)=M3_TH2_WR2(:,:,IKB)
M3_TH2_WR2(:,:,IKE+1)=M3_TH2_WR2(:,:,IKE)
!
END FUNCTION M3_TH2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -770,17 +716,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
- * MZF(KKA,KKU,KKL, (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF( (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
!
D_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
D_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_TH2_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -795,17 +738,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
+ * MZF( PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
!
M3_TH2_WTHR(:,:,IKB-1)=M3_TH2_WTHR(:,:,IKB)
M3_TH2_WTHR(:,:,IKE+1)=M3_TH2_WTHR(:,:,IKE)
!
END FUNCTION M3_TH2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -821,17 +761,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF( PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
!
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_TH2_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -844,17 +781,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
- * MZF(KKA,KKU,KKL, (1.+PREDTH1)*(1.+PREDR1)/PD )
+ * MZF( (1.+PREDTH1)*(1.+PREDR1)/PD )
!
M3_THR_WTHR(:,:,IKB-1)=M3_THR_WTHR(:,:,IKB)
M3_THR_WTHR(:,:,IKE+1)=M3_THR_WTHR(:,:,IKE)
!
END FUNCTION M3_THR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -869,17 +803,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
- * MZF(KKA,KKU,KKL, PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF( PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
!
D_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
D_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_THR_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -894,17 +825,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF(KKA,KKU,KKL, (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
+ * MZF( (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
!
M3_THR_WTH2(:,:,IKB-1)=M3_THR_WTH2(:,:,IKB)
M3_THR_WTH2(:,:,IKE+1)=M3_THR_WTH2(:,:,IKE)
!
END FUNCTION M3_THR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -920,17 +848,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
- * MZF(KKA,KKU,KKL, -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
+ * MZF( -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
!
D_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
D_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_THR_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -945,7 +870,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PETHETA/PD &
+ * MZF( PBLL_O_E*PETHETA/PD &
*(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)) &
)
!
@@ -954,10 +879,7 @@ D_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
!
END FUNCTION D_M3_THR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -971,17 +893,14 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF(KKA,KKU,KKL, (1.+PREDR1)*PDRDZ/PD )
+ * MZF( (1.+PREDR1)*PDRDZ/PD )
!
M3_THR_W2TH(:,:,IKB-1)=M3_THR_W2TH(:,:,IKB)
M3_THR_W2TH(:,:,IKE+1)=M3_THR_W2TH(:,:,IKE)
!
END FUNCTION M3_THR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -998,7 +917,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
- * MZF(KKA,KKU,KKL, -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
+ * MZF( -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
!
D_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
@@ -1006,10 +925,7 @@ D_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
!
END FUNCTION D_M3_THR_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1023,7 +939,7 @@ IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF(KKA,KKU,KKL, -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ * MZF( -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+(1.+2.*PREDR1)/PD &
)
@@ -1120,10 +1036,7 @@ D_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_
!
END FUNCTION D_M3_WR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1131,14 +1044,11 @@ FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2R
!
-M3_WR_W2R = M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
+M3_WR_W2R = M3_WTH_W2TH(PREDR1,PREDTH1,PD,PKEFF,PTKE)
!
END FUNCTION M3_WR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1148,16 +1058,11 @@ FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2R_O_DDRDZ
!
-D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
!
END FUNCTION D_M3_WR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1166,14 +1071,11 @@ FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2TH
!
-M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+M3_WR_W2TH = M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION M3_WR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1183,16 +1085,11 @@ FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2TH_O_DDRDZ
!
-D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
!
END FUNCTION D_M3_WR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1204,14 +1101,11 @@ FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTH2
!
-M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+M3_WR_WTH2 = M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
!
END FUNCTION M3_WR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1224,14 +1118,11 @@ FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTH2_O_DDRDZ
!
-D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
!
END FUNCTION D_M3_WR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -1242,14 +1133,11 @@ FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETH
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTHR
!
-M3_WR_WTHR = M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+M3_WR_WTHR = M3_WTH_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
!
END FUNCTION M3_WR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WTHR
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
@@ -1262,10 +1150,7 @@ D_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_
!
END FUNCTION D_M3_WR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1275,14 +1160,11 @@ FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2R
!
-M3_R2_W2R = M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+M3_R2_W2R = M3_TH2_W2TH(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
!
END FUNCTION M3_R2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1292,14 +1174,11 @@ FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV
LOGICAL, INTENT(IN) :: OUSERV
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2R_O_DDRDZ
!
-D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
!
END FUNCTION D_M3_R2_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1307,14 +1186,11 @@ FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WR2
!
-M3_R2_WR2 = M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+M3_R2_WR2 = M3_TH2_WTH2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
!
END FUNCTION M3_R2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1324,14 +1200,11 @@ FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WR2_O_DDRDZ
!
-D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
END FUNCTION D_M3_R2_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1341,14 +1214,11 @@ FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2TH
!
-M3_R2_W2TH = M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+M3_R2_W2TH = M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION M3_R2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1360,14 +1230,11 @@ FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2TH_O_DDRDZ
!
-D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION D_M3_R2_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -1376,14 +1243,11 @@ FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTH2
!
-M3_R2_WTH2 = M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+M3_R2_WTH2 = M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION M3_R2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1394,14 +1258,11 @@ FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTH2_O_DDRDZ
!
-D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION D_M3_R2_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1411,14 +1272,11 @@ FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTHR
!
-M3_R2_WTHR = M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+M3_R2_WTHR = M3_TH2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION M3_R2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1429,14 +1287,11 @@ FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTHR_O_DDRDZ
!
-D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
END FUNCTION D_M3_R2_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1446,14 +1301,11 @@ FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDRDZ
!
-D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
END FUNCTION D_M3_THR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1463,14 +1315,11 @@ FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WR2
!
-M3_THR_WR2 = M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+M3_THR_WR2 = M3_THR_WTH2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
END FUNCTION M3_THR_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1481,14 +1330,11 @@ FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDRDZ
!
-D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
END FUNCTION D_M3_THR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1498,14 +1344,11 @@ FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDTDZ
!
-D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
END FUNCTION D_M3_THR_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -1514,14 +1357,11 @@ FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2R
!
-M3_THR_W2R = M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+M3_THR_W2R = M3_THR_W2TH(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
!
END FUNCTION M3_THR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1533,14 +1373,11 @@ FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDRDZ
!
-D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
!
END FUNCTION D_M3_THR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
- INTEGER, INTENT(IN) :: KKA
- INTEGER, INTENT(IN) :: KKU
- INTEGER, INTENT(IN) :: KKL
+FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1549,7 +1386,7 @@ FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDTDZ
!
-D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
!
END FUNCTION D_M3_THR_W2R_O_DDTDZ
!----------------------------------------------------------------------------
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index c6cd72db3a5629193b839d05bb30405b211fa4ed..51d29f1f855e73a8e480c439b2fcc83d24370ed7 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -892,7 +892,7 @@ CALL BOUNDARIES ( &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
& XUT, XVT, XWT, XTHT, XTKET)
@@ -1001,7 +1001,7 @@ IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
end if
if ( lbu_rw ) then
tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
- + Mask_compress( Mzm( 1, iku, 1, xrhodj(:, :, :) ) )
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
end if
if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
END IF
@@ -1015,7 +1015,7 @@ IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
end if
if ( lbu_rw ) then
tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
- + Cart_compress( Mzm( 1, iku, 1, xrhodj(:, :, :) ) )
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
end if
if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
END IF
@@ -1121,7 +1121,7 @@ END IF
!
IF ( LFORCING ) THEN
CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
- XUFRC_PAST, XVFRC_PAST, &
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
END IF
diff --git a/src/MNH/modn_budget.f90 b/src/MNH/modn_budget.f90
index 56157206ab385d8c06ffae7ca7128c49f6d24c01..9276582fcb7b728e57c2e6305b4117ff68765771 100644
--- a/src/MNH/modn_budget.f90
+++ b/src/MNH/modn_budget.f90
@@ -226,6 +226,7 @@
!! C.Lac 10/2016 Add droplet deposition
!! S. Riette 11/2016 New budgets for ICE3/ICE4
! P. Wautelet 28/01/2020: add missing budgets for viscosity
+! B. Vie 03/02/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! P .Wautelet 09/03/2020: add missing budgets for electricity
!-------------------------------------------------------------------------------
!
@@ -276,28 +277,33 @@ NAMELIST/NAM_BU_RRC/LBU_RRC, NASSERC, NNESTRC, NADVRC, NFRCRC, &
NAMELIST/NAM_BU_RRR/LBU_RRR, NASSERR, NNESTRR, NADVRR, NFRCRR, &
NDIFRR, NRELRR, NNEGARR, NACCRRR, NAUTORR, NREVARR, NSEDIRR, &
NSFRRR, NACCRR, NCFRZRR, NWETGRR, NDRYGRR, NGMLTRR, NWETHRR, &
- NHMLTRR, NDRYHRR, NCORRRR, NCMELRR,NHONRRR, NCORRRR, NR2C1RR, NCVRCRR, NVISCRR
+ NHMLTRR, NDRYHRR, NCORRRR, NCMELRR,NHONRRR, NCORRRR, NR2C1RR, NCVRCRR, &
+ NNETURRR, NNEADVRR, NNECONRR, NVISCRR
!
NAMELIST/NAM_BU_RRI/LBU_RRI, NASSERI, NNESTRI, NADVRI, NFRCRI, &
NDIFRI, NRELRI, NDCONVRI, NHTURBRI, NVTURBRI, NNEGARI, NSEDIRI, &
NHENURI, NHONRI, NAGGSRI, NAUTSRI, NCFRZRI, NWETGRI, NDRYGRI, &
NIMLTRI, NBERFIRI, NCDEPIRI, NWETHRI, NDRYHRI, NADJURI, NCORRRI, &
NHINDRI, NHINCRI, NHONHRI, NHONCRI, NCNVIRI, NCNVSRI, &
- NHMSRI, NHMGRI, NCEDSRI, NCORRRI, NVISCRI
+ NHMSRI, NHMGRI, NCEDSRI, NCORRRI, &
+ NNETURRI, NNEADVRI, NNECONRI, NVISCRI
!
NAMELIST/NAM_BU_RRS/LBU_RRS, NASSERS, NNESTRS, NADVRS, NFRCRS, &
NDIFRS, NRELRS, NNEGARS, NSEDIRS, NDEPSRS, NAGGSRS, NAUTSRS, &
NRIMRS, NACCRS, NCMELRS, NWETGRS, NDRYGRS, NWETHRS, NDRYHRS, &
- NCORRRS, NCNVIRS, NCNVSRS, NHMSRS, NCORRRS, NVISCRS
+ NCORRRS, NCNVIRS, NCNVSRS, NHMSRS, NCORRRS, &
+ NNETURRS, NNEADVRS, NNECONRS, NVISCRS
!
NAMELIST/NAM_BU_RRG/LBU_RRG, NASSERG, NNESTRG, NADVRG, NFRCRG, &
NDIFRG, NRELRG, NNEGARG, NSEDIRG, NSFRRG, NDEPGRG, NRIMRG, NACCRG, &
NCMELRG, NCFRZRG, NWETGRG, NDRYGRG, NGMLTRG, NWETHRG, &
- NDRYHRG, NCORRRG, NHGCVRG, NGHCVRG,NHONRRG, NHMGRG, NCOHGRG, NVISCRG
+ NDRYHRG, NCORRRG, NHGCVRG, NGHCVRG,NHONRRG, NHMGRG, NCOHGRG, &
+ NNETURRG, NNEADVRG, NNECONRG, NVISCRG
!
NAMELIST/NAM_BU_RRH/LBU_RRH, NASSERH, NNESTRH, NADVRH, NFRCRH, &
NDIFRH, NRELRH, NNEGARH, NSEDIRH, NWETGRH, NWETHRH, NDRYHRH, NHMLTRH, &
- NCORRRH, NHGCVRH, NGHCVRH, NCOHGRH, NHMLTRH, NVISCRH
+ NCORRRH, NHGCVRH, NGHCVRH, NCOHGRH, NHMLTRH, &
+ NNETURRH, NNEADVRH, NNECONRH, NVISCRH
!
NAMELIST/NAM_BU_RSV/ LBU_RSV, NASSESV, NNESTSV, NADVSV, NFRCSV, &
NDIFSV, NRELSV, NDCONVSV, NVTURBSV, NHTURBSV, NCHEMSV, NMAFLSV, &
diff --git a/src/MNH/modn_dragbldgn.f90 b/src/MNH/modn_dragbldgn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bf2a7c7458fb91bbd436c5a17c39e9e6b63e8dcc
--- /dev/null
+++ b/src/MNH/modn_dragbldgn.f90
@@ -0,0 +1,52 @@
+!MNH_LIC Copyright 2019-2020 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 MODN_DRAGBLDG_n
+!! #####################
+!!
+!!*** *MODN_DRAGBLDG*
+!!
+!! PURPOSE
+!! -------
+! Namelist to take into account building drag in the atmospheric model
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! R.Schoetter *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2019
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!
+USE MODD_DRAGBLDG_n, ONLY : &
+ LDRAGBLDG_n => LDRAGBLDG
+!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LDRAGBLDG
+!
+NAMELIST /NAM_DRAGBLDGn/LDRAGBLDG
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_DRAGBLDGn
+ LDRAGBLDG = LDRAGBLDG_n
+END SUBROUTINE INIT_NAM_DRAGBLDGn
+!
+SUBROUTINE UPDATE_NAM_DRAGBLDGn
+ LDRAGBLDG_n = LDRAGBLDG
+END SUBROUTINE UPDATE_NAM_DRAGBLDGn
+!
+END MODULE MODN_DRAGBLDG_n
diff --git a/src/MNH/modn_dragtree.f90 b/src/MNH/modn_dragtree.f90
deleted file mode 100644
index 58703b7a9474db24073b6248cd2d714eef0ffe21..0000000000000000000000000000000000000000
--- a/src/MNH/modn_dragtree.f90
+++ /dev/null
@@ -1,40 +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 MODN_DRAGTREE
-!! #####################
-!!
-!!*** *MODN_DRAGTREE*
-!!
-!! PURPOSE
-!! -------
-! Namelist to take into account tree drag in the atmospheric model
-! instead of SURFEX.
-!!
-!!** AUTHOR
-!! ------
-!! C.Lac *CNRM*
-!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/06/11
-!!
-!! 10/2016 : (C.Lac) Add droplet deposition on trees
-!! IMPLICIT ARGUMENTS
-!! ------------------
-USE MODD_DRAGTREE
-!!
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-IMPLICIT NONE
-SAVE
-NAMELIST /NAM_DRAGTREE/ &
- LDRAGTREE,LDEPOTREE,XVDEPOTREE
-
-!
-END MODULE MODN_DRAGTREE
diff --git a/src/MNH/modn_dragtreen.f90 b/src/MNH/modn_dragtreen.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6f9fe1af4098ea854d6eff9adc735d1a9c8eca86
--- /dev/null
+++ b/src/MNH/modn_dragtreen.f90
@@ -0,0 +1,62 @@
+!MNH_LIC Copyright 2011-2020 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 MODN_DRAGTREE_n
+!! #####################
+!!
+!!*** *MODN_DRAGTREE*
+!!
+!! PURPOSE
+!! -------
+! Namelist to take into account tree drag in the atmospheric model
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! C.Lac *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/06/11
+!!
+!! 10/2016 : (C.Lac) Add droplet deposition on trees
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!
+USE MODD_DRAGTREE_n, ONLY : &
+ LDRAGTREE_n => LDRAGTREE, &
+ LDEPOTREE_n => LDEPOTREE, &
+ XVDEPOTREE_n => XVDEPOTREE
+!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LDRAGTREE
+LOGICAL, SAVE :: LDEPOTREE
+REAL, SAVE :: XVDEPOTREE
+!
+NAMELIST /NAM_DRAGTREEn/LDRAGTREE,LDEPOTREE,XVDEPOTREE
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_DRAGTREEn
+ LDRAGTREE = LDRAGTREE_n
+ LDEPOTREE = LDEPOTREE_n
+ XVDEPOTREE = XVDEPOTREE_n
+END SUBROUTINE INIT_NAM_DRAGTREEn
+!
+SUBROUTINE UPDATE_NAM_DRAGTREEn
+ LDRAGTREE_n = LDRAGTREE
+ LDEPOTREE_n = LDEPOTREE
+ XVDEPOTREE_n = XVDEPOTREE
+END SUBROUTINE UPDATE_NAM_DRAGTREEn
+!
+END MODULE MODN_DRAGTREE_n
diff --git a/src/MNH/mpdata.f90 b/src/MNH/mpdata.f90
index 1729c968e1da31665cfd5161b4f88f1822508c7d..04f4fcaf132c2c7541b00363a92cb2d117afac64 100644
--- a/src/MNH/mpdata.f90
+++ b/src/MNH/mpdata.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -148,7 +148,6 @@ INTEGER :: JRR ! Loop index for moist variables
!
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-INTEGER:: IKU
!
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZGUESS ! Guess
! variable (to be removed in the future !)
@@ -180,7 +179,6 @@ NULLIFY(TZFIELDS_ll)
!* 0.3 PROLOGUE
!
CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-IKU=SIZE(PTHM,3)
!
YRX(1) = 'RRV'
YRX(2) = 'RRC'
@@ -220,7 +218,7 @@ irx(7) = NBUDGET_RH
ZRVARS(:,:,:) = PRTHS(:,:,:)
ZFADVU(:,:,:) = -DXF(FXM( PTHM(:,:,:),PRUCT(:,:,:) ) )
ZFADVV(:,:,:) = -DYF(FYM( PTHM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(1,IKU,1,FZM( PTHM(:,:,:),PRWCT(:,:,:) ) )
+ ZFADVW(:,:,:) = -DZF(FZM( PTHM(:,:,:),PRWCT(:,:,:) ) )
!
PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
!
@@ -257,7 +255,7 @@ irx(7) = NBUDGET_RH
ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
!
- ZFADV(:,:,:) = -DZF(1,IKU,1,FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
+ ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
@@ -288,7 +286,7 @@ irx(7) = NBUDGET_RH
ZRVARS(:,:,:) = PRRS(:,:,:,JRR)
ZFADVU(:,:,:) = -DXF(FXM( PRM(:,:,:,JRR),PRUCT(:,:,:) ) )
ZFADVV(:,:,:) = -DYF(FYM( PRM(:,:,:,JRR),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(1,IKU,1,FZM( PRM(:,:,:,JRR),PRWCT(:,:,:) ) )
+ ZFADVW(:,:,:) = -DZF(FZM( PRM(:,:,:,JRR),PRWCT(:,:,:) ) )
!
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
ZFADVW(:,:,:)
@@ -321,7 +319,7 @@ irx(7) = NBUDGET_RH
ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
!
- ZFADV(:,:,:) = -DZF(1,IKU,1,FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
+ ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
@@ -356,7 +354,7 @@ irx(7) = NBUDGET_RH
ZRVARS(:,:,:) = PRTKES(:,:,:)
ZFADVU(:,:,:) = -DXF(FXM( PTKEM(:,:,:),PRUCT(:,:,:) ) )
ZFADVV(:,:,:) = -DYF(FYM( PTKEM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(1,IKU,1,FZM( PTKEM(:,:,:),PRWCT(:,:,:) ) )
+ ZFADVW(:,:,:) = -DZF(FZM( PTKEM(:,:,:),PRWCT(:,:,:) ) )
!
PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
!
@@ -388,7 +386,7 @@ irx(7) = NBUDGET_RH
ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
!
- ZFADV(:,:,:) = -DZF(1,IKU,1,FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
+ ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
diff --git a/src/MNH/mpdata_scalar.f90 b/src/MNH/mpdata_scalar.f90
index d75869bfe09493031248db18ead866b6727ac0ef..7b5014cc9d8b41c2adefb2f231626c773a2f4458 100644
--- a/src/MNH/mpdata_scalar.f90
+++ b/src/MNH/mpdata_scalar.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -144,7 +144,6 @@ INTEGER :: JSV ! Loop index for Scalar Variables
!
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-INTEGER:: IKU
!
REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: ZGUESS ! Guess
! variable (to be removed in the future !)
@@ -170,7 +169,6 @@ NULLIFY(TZFIELDS_ll)
!* 0. PROLOGUE
!
CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-IKU=SIZE(PSVM,3)
!
!
!-------------------------------------------------------------------------------
@@ -183,7 +181,7 @@ IKU=SIZE(PSVM,3)
ZRVARS(:,:,:) = PRSVS(:,:,:,JSV)
ZFADVU(:,:,:) = -DXF(FXM( PSVM(:,:,:,JSV),PRUCT(:,:,:) ) )
ZFADVV(:,:,:) = -DYF(FYM( PSVM(:,:,:,JSV),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(1,IKU,1,FZM( PSVM(:,:,:,JSV),PRWCT(:,:,:) ) )
+ ZFADVW(:,:,:) = -DZF(FZM( PSVM(:,:,:,JSV),PRWCT(:,:,:) ) )
!
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
ZFADVW(:,:,:)
@@ -222,7 +220,7 @@ IKU=SIZE(PSVM,3)
ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
!
- ZFADV(:,:,:) = -DZF(1,IKU,1,FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
+ ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90
index 011ca0d61b018d4b7b65eafc7355741a784fc4e7..65c221c739d179b1116501ac1ce8fe9700be733a 100644
--- a/src/MNH/num_diff.f90
+++ b/src/MNH/num_diff.f90
@@ -284,7 +284,6 @@ INTEGER :: JRR ! Loop index for moist variables
INTEGER :: JSV ! Loop index for Scalar Variables
INTEGER:: IIB,IJB ! Begining useful area in x,y directions
INTEGER:: IIE,IJE ! End useful area in x,y directions
-INTEGER :: IKU
!
LOGICAL :: GTKEALLOC ! true if TKE arrays are not zero-sized
!
@@ -298,7 +297,6 @@ INTEGER :: IGRID ! localisation on the model grid
!* 1. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-IKU=SIZE(PUM,3)
!
GTKEALLOC = SIZE(PTKEM,1) /= 0
@@ -359,10 +357,10 @@ IF (ONUMDIFU) THEN
!!$ IF(NHALO == 1) THEN
TZHALO2LIST => TZHALO2LIST%NEXT
TZHALO2LSLIST => TZHALO2LSLIST%NEXT
- CALL NUM_DIFF_ALGO(PRWS, PWM, IGRID, MZM(1,IKU,1,PRHODJ), PDK2U, PDK4U, &
+ CALL NUM_DIFF_ALGO(PRWS, PWM, IGRID, MZM(PRHODJ), PDK2U, PDK4U, &
PLSWM, TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
!!$ ELSE
-!!$ CALL NUM_DIFF_ALGO(PRWS, PWM, IGRID, MZM(1,IKU,1,PRHODJ), PDK2U, PDK4U, PLSWM )
+!!$ CALL NUM_DIFF_ALGO(PRWS, PWM, IGRID, MZM(PRHODJ), PDK2U, PDK4U, PLSWM )
!!$ ENDIF
ENDIF
!
diff --git a/src/MNH/paspol.f90 b/src/MNH/paspol.f90
index e214de60144c967b3d356aa504ec4de67c0f1ef4..98c8c94d7ed67137cfe26cdc5384df2984f11fe3 100644
--- a/src/MNH/paspol.f90
+++ b/src/MNH/paspol.f90
@@ -217,7 +217,12 @@ IF (GPPFIRSTCALL) THEN
! puis les indices fractionnaires (ZSRCI,ZSRCJ) et entiers
! (IPIGI,IPIGJ) du point de rejet dans le domaine de travail global.
!
- CALL SM_XYHAT(XLATORI,XLONORI,XPPLAT(JSV),XPPLON(JSV),ZSRCX,ZSRCY)
+ IF (LCARTESIAN) THEN !En cartesien ecriture dans la namelist des coordonnees X,Y et non LAT,LON
+ ZSRCX = XPPLAT(JSV)
+ ZSRCY = XPPLON(JSV)
+ ELSE
+ CALL SM_XYHAT(XLATORI,XLONORI,XPPLAT(JSV),XPPLON(JSV),ZSRCX,ZSRCY)
+ END IF
II=MAX(MIN(COUNT(XXHAT(:)<ZSRCX),IIU-1),1)
IJ=MAX(MIN(COUNT(XYHAT(:)<ZSRCY),IJU-1),1)
ZSRCI=(ZSRCX-XXHAT(II))/(XXHAT(II+1)-XXHAT(II))+REAL(II)
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 8aedbaf47db9ef36d58ad2174699671c1b7044f0..5354a0b37b7315f50fbf5750dd3c3320dbcbf75b 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -236,6 +236,7 @@ END MODULE MODI_PHYS_PARAM_n
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 21/11/2019: ZRG_HOUR and ZRAT_HOUR are now parameter arrays
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -260,12 +261,14 @@ USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
-USE MODD_DRAGTREE
+USE MODD_DRAGBLDG_n
+USE MODD_DRAGTREE_n
USE MODD_DUST
USE MODD_DYN
USE MODD_DYN_n
USE MODD_FIELD_n
USE MODD_FRC
+USE MODD_FRC_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
@@ -320,6 +323,7 @@ USE MODE_SALT_PSD
USE MODI_AEROZON ! Ajout PP
USE MODI_CONDSAMP
USE MODI_CONVECTION
+USE MODI_DRAG_BLD
USE MODI_DRAG_VEG
USE MODI_DUST_FILTER
USE MODI_EDDY_FLUX_n ! Ajout PP
@@ -736,6 +740,23 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
WRITE(UNIT=ILUOUT,FMT='(" RADIATIONS called for KTCOUNT=",I6, &
& "with the CLOUD_ONLY option set ",L2)') KTCOUNT,OCLOUD_ONLY
!
+ !
+ WHERE (XDIRFLASWD.LT.0.0)
+ XDIRFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XDIRFLASWD.GT.1500.0)
+ XDIRFLASWD=1500.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.LT.0.0)
+ XSCAFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.GT.1500.0)
+ XSCAFLASWD=1500.0
+ ENDWHERE
+ !
WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
XALBUV(:,:) = ( XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1) &
+ XSCA_ALB(:,:,1) * XSCAFLASWD(:,:,1) ) &
@@ -1236,10 +1257,11 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-IF (LDRAGTREE) CALL DRAG_VEG(XTSTEP,XUT,XVT,XTKET,LDEPOTREE,XVDEPOTREE, &
- CCLOUD, XPABST,XTHT,XRT,XSVT, &
- XRHODJ,XZZ,XRUS, XRVS, &
- XRTKES, XRRS,XRSVS)
+IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
+ CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
+ XRUS, XRVS, XRTKES, XRRS, XRSVS )
+!
+IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1302,6 +1324,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
END IF
+ !
IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
@@ -1315,6 +1338,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
END IF
+ !
IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
@@ -1328,6 +1352,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
END IF
+ !
IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index caec0f6ca9d4c1bf5b57a0aa6bcafd7b3c290bc0..367925a30a35124a1c71b40998c470bf44661c09 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
@@ -1083,7 +1083,6 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
!
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
-INTEGER:: IKU
!
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
@@ -1103,7 +1102,6 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
-IKU = SIZE(PSRC,3)
!
!-------------------------------------------------------------------------------
!
@@ -1196,7 +1194,7 @@ ZFNEG(:,:,IKE+1) = (ZQR(:,:,IKE)-PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
!
! advect the actual field in Z direction by W*dt
!
-PR = DZF(1,IKU,1, PCR*MZM(1,IKU,1,PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
+PR = DZF( PCR*MZM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
!Unnecessary CALL GET_HALO(PR)
!
@@ -1846,7 +1844,6 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
!
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
-INTEGER:: IKU
!
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
@@ -1861,7 +1858,6 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
!
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
-IKU = SIZE(PSRC,3)
!
!-------------------------------------------------------------------------------
!
@@ -1917,7 +1913,7 @@ ZFNEG(:,:,IKE+1) = (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
! calculate the advection
!
PR = PSRC * PRHO - &
- DZF(1,IKU,1, PCR*MZM(1,IKU,1,PRHO)*( ZFPOS(:,:,:)*(0.5+SIGN(0.5,PCR)) + &
+ DZF( PCR*MZM(PRHO)*( ZFPOS(:,:,:)*(0.5+SIGN(0.5,PCR)) + &
ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
!
! in OPEN case fix boundary conditions
@@ -2481,7 +2477,6 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
!
INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
-INTEGER:: IKU
!
! variable at cell edges
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT, ZRVT
@@ -2507,11 +2502,10 @@ INTEGER :: II, IJ, IK
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
-IKU = SIZE(PSRC,3)
!
!-------------------------------------------------------------------------------
!
-ZRVT = PCR/PTSTEP * MZM(1,IKU,1,PRHO)
+ZRVT = PCR/PTSTEP * MZM(PRHO)
!
! calculate 4th order fluxes at cell edges in the inner domain !
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
@@ -2618,7 +2612,7 @@ END WHERE
!
! 1. calculate upwind tendency of the source
!
-PR = PSRC*PRHO - PTSTEP*DZF(1,IKU,1,ZFUP)
+PR = PSRC*PRHO - PTSTEP*DZF(ZFUP)
!
!-------------------------------------------------------------------------------
! compute and apply the limiters
@@ -2746,7 +2740,7 @@ ZFCOR(:,:,IKB-1) = MIN( &
!-------------------------------------------------------------------------------
! 6. apply the limited flux correction to scalar field
!
-PR = PR - PTSTEP*DZF(1,IKU,1,ZFCOR)
+PR = PR - PTSTEP*DZF(ZFCOR)
!
!
END FUNCTION PPM_S1_Z
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 10f5dcf7e3a5f8129616c61d35ea0665f508a124..fea5db344bfedb51513f1270ce89dd2c9146971a 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -282,8 +282,8 @@ IKB = KKA+JPVEXT_TURB*KKL
IKE = KKU-JPVEXT_TURB*KKL
ISV =SIZE(PSVM,4)
!
-PETHETA(:,:,:) = MZM(KKA,KKU,KKL, ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
-PEMOIST(:,:,:) = MZM(KKA,KKU,KKL, EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
+PETHETA(:,:,:) = MZM( ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
+PEMOIST(:,:,:) = MZM( EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
!
@@ -291,7 +291,7 @@ PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
!
! 1.3 1D Redelsperger numbers
!
-PBLL_O_E(:,:,:) = MZM(KKA,KKU,KKL, XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
+PBLL_O_E(:,:,:) = MZM( XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
IF (KRR /= 0) THEN ! moist case
PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
& GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
@@ -375,22 +375,22 @@ ELSE IF (L2D) THEN ! 3D case in a 2D model
!
IF (KRR /= 0) THEN ! moist 3D case
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 )
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
!
PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
!
PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX))
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX))
PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
!
ELSE ! dry 3D case in a 2D model
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 )
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
!
PRED2R3(:,:,:) = 0.
@@ -403,27 +403,27 @@ ELSE ! 3D case in a 3D model
!
IF (KRR /= 0) THEN ! moist 3D case
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)**2 )
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
!
PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
- GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
!
PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)+ &
- GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
- GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY) )
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX)+ &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) )
PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
!
ELSE ! dry 3D case in a 3D model
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)**2 )
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
!
PRED2R3(:,:,:) = 0.
@@ -454,21 +454,21 @@ ELSE IF (L2D) THEN ! 3D case in a 2D model
!
DO JSV=1,ISV
IF (KRR /= 0) THEN
- ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
- ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
END IF
PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1* &
- MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX) &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
)
!
IF (KRR /= 0) THEN
PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1 * PEMOIST * &
- MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
)
ELSE
PRED2RS3(:,:,:,JSV) = 0.
@@ -479,25 +479,25 @@ ELSE ! 3D case in a 3D model
!
DO JSV=1,ISV
IF (KRR /= 0) THEN
- ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
- ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
END IF
PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1* &
- MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX) &
- +GY_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY) &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
)
!
IF (KRR /= 0) THEN
PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1 * PEMOIST * &
- MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- +GY_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
)
ELSE
PRED2RS3(:,:,:,JSV) = 0.
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index 450c4928b2467b5785470c12f122526e12278e3c..e0fff03f797676f343c3a395d29916e95f7e1241 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -985,7 +985,7 @@ CALL BOUNDARIES ( &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
!
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/pressure.f90 b/src/MNH/pressure.f90
index b64d1d913590da9ae17381cad6a7dc986ec01aae..2dd585ee40ddeef33cea5c54e5c0646bf3c5e2ab 100644
--- a/src/MNH/pressure.f90
+++ b/src/MNH/pressure.f90
@@ -514,10 +514,10 @@ END IF
!
IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
PRUS = PRUS - MXM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- PRWS = PRWS - MZM(1,IKU,1,PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
+ PRWS = PRWS - MZM(PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
ELSEIF(CEQNSYS=='LHE') THEN
PRUS = PRUS - MXM(PRHODJ) * ZDV_SOURCE
- PRWS = PRWS - MZM(1,IKU,1,PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
+ PRWS = PRWS - MZM(PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
END IF
!
IF(.NOT. L2D) THEN
diff --git a/src/MNH/pressure_in_prep.f90 b/src/MNH/pressure_in_prep.f90
index e012d515b828652f664356a845921c11fd663e38..6219e352f27f06e8a418d8073fdd8aed4031802d 100644
--- a/src/MNH/pressure_in_prep.f90
+++ b/src/MNH/pressure_in_prep.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 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.
@@ -117,9 +117,6 @@ REAL,DIMENSION(SIZE(PDXX,1),SIZE(PDXX,2),SIZE(PDXX,3)):: ZDIV ! residual diverge
!* file management variables and counters
!
INTEGER :: ILUOUT0 ! logical unit for listing file
-INTEGER :: IRESP ! error code
-INTEGER :: IKB, IKE ! inner limits in Z direction
-INTEGER :: IKU
INTEGER :: IINFO_ll
REAL :: ZMAXRES
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
@@ -133,10 +130,6 @@ INTEGER :: I,J,K
!
ILUOUT0 = TLUOUT0%NLU
!
-IKB=1+JPVEXT
-IKE=NKMAX+JPVEXT
-IKU=IKE+JPVEXT
-!
ZU(:,:,:) = XUT(:,:,:)
ZV(:,:,:) = XVT(:,:,:)
ZW(:,:,:) = XWT(:,:,:)
@@ -192,7 +185,7 @@ CALL MPPDB_CHECK3D(XVT,"PressInP4-beforeupdhalo::XVT",PRECISION)
!
ZRU(:,:,:) = XUT(:,:,:) * MXM(XRHODJ)
ZRV(:,:,:) = XVT(:,:,:) * MYM(XRHODJ)
- ZRW(:,:,:) = XWT(:,:,:) * MZM(1,IKU,1,XRHODJ)
+ ZRW(:,:,:) = XWT(:,:,:) * MZM(XRHODJ)
!
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRU, 'PRESSURE_IN_PREP::ZRU' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRV, 'PRESSURE_IN_PREP::ZRV' )
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 87fc7063ade94b65b7633a5642cb199494aedd39..c015ab250313a97dca40978a587656cc6af99196 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -574,10 +574,10 @@ END IF
CALL MPPDB_CHECK3DM("before MXM PRESSUREZ :PRU/V/WS",PRECISION,PRUS,PRVS,PRWS)
IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
PRUS = PRUS - MXM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- PRWS = PRWS - MZM(1,IKU,1,PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
+ PRWS = PRWS - MZM(PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
ELSEIF(CEQNSYS=='LHE') THEN
PRUS = PRUS - MXM(PRHODJ) * ZDV_SOURCE
- PRWS = PRWS - MZM(1,IKU,1,PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
+ PRWS = PRWS - MZM(PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
END IF
!
IF(.NOT. L2D) THEN
diff --git a/src/MNH/qlap.f90 b/src/MNH/qlap.f90
index 75f8c728fd2b2ac86cdd9ae57f907c2bf1752207..d4da491d97bc6c716267088375a88a11fbeac7cc 100644
--- a/src/MNH/qlap.f90
+++ b/src/MNH/qlap.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -236,13 +236,13 @@ IF ( CEQNSYS == 'DUR' .OR. CEQNSYS == 'MAE' ) THEN
IF(.NOT. L2D) THEN
ZV = MYM(PRHODJ * XCPD * PTHETAV) * ZV
END IF
- ZW = MZM(1,IKU,1,PRHODJ * XCPD * PTHETAV) * GZ_M_W(1,IKU,1,PY,PDZZ)
+ ZW = MZM(PRHODJ * XCPD * PTHETAV) * GZ_M_W(1,IKU,1,PY,PDZZ)
ELSEIF ( CEQNSYS == 'LHE' ) THEN
ZU = MXM(PRHODJ) * ZU
IF(.NOT. L2D) THEN
ZV = MYM(PRHODJ) * ZV
ENDIF
- ZW = MZM(1,IKU,1,PRHODJ) * GZ_M_W(1,IKU,1,PY,PDZZ)
+ ZW = MZM(PRHODJ) * GZ_M_W(1,IKU,1,PY,PDZZ)
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index 45a43609c93f47256fe45a4a0076a6772f7ad995..22cd95ed46790ff6e3a8d54200c817e274ea9490 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -680,7 +680,9 @@ IF (IMICRO > 0) THEN
!
IF (LBU_ENABLE .OR. LLES_CALL) THEN
ALLOCATE(ZRHODJ(IMICRO))
- ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
END IF
!
ALLOCATE( ZECT(IMICRO) )
@@ -915,47 +917,38 @@ IF (IMICRO > 0) THEN
!
!* 8.1 Update the mixing ratio
!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRSS(:,:,:)
- PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRGS(:,:,:)
- PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ END DO
IF ( KRR == 7 ) THEN
- ZW(:,:,:) = PRHS(:,:,:)
- PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
END IF
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIT(:,:,:)
- PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
!
!
!* 8.2 Compute the volumetric charge concentration
!
- ZW(:,:,:) = PQPIS(:,:,:)
- PQPIS(:,:,:) = UNPACK( ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQNIS(:,:,:)
- PQNIS(:,:,:) = UNPACK( ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQCS(:,:,:)
- PQCS(:,:,:) = UNPACK( ZQCS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQRS(:,:,:)
- PQRS(:,:,:) = UNPACK( ZQRS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQIS(:,:,:)
- PQIS(:,:,:) = UNPACK( ZQIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQSS(:,:,:)
- PQSS(:,:,:) = UNPACK( ZQSS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQGS(:,:,:)
- PQGS(:,:,:) = UNPACK( ZQGS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PQPIS(I1(JL),I2(JL),I3(JL)) = ZQPIS(JL)
+ PQNIS(I1(JL),I2(JL),I3(JL)) = ZQNIS(JL)
+ PQCS (I1(JL),I2(JL),I3(JL)) = ZQCS(JL)
+ PQRS (I1(JL),I2(JL),I3(JL)) = ZQRS(JL)
+ PQIS (I1(JL),I2(JL),I3(JL)) = ZQIS(JL)
+ PQSS (I1(JL),I2(JL),I3(JL)) = ZQSS(JL)
+ PQGS (I1(JL),I2(JL),I3(JL)) = ZQGS(JL)
+ END DO
IF ( KRR == 7 ) THEN
- ZW(:,:,:) = PQHS(:,:,:)
- PQHS(:,:,:) = UNPACK( ZQHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PQHS(I1(JL),I2(JL),I3(JL)) = ZQHS(JL)
+ END DO
END IF
!
!
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 2b60d5375302a820e69ecd3cd74bb13534f434d5..246d4f51c49654e695b4910176926b630e3e19a0 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -243,6 +243,7 @@ END MODULE MODI_RAIN_ICE_RED
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 17/01/2020: move Quicksort to tools.f90
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index a8178a0be6fb189500b2977c055ecec45d8db4fe..968991a463cf75f0d7e4f591c4c04bd419133cb5 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 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.
@@ -131,7 +131,8 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! Q. Rodier 16/09/2019: switch of GRIB number ID for Orograpgy in ARPEGE/AROME in EPyGrAM
+! Q. Rodier 16/09/2019: switch of GRIB number ID for orography in ARPEGE/AROME in EPyGrAM
+! Q. Rodier 27/01/2020: switch of GRIB number ID for orography and hydrometeors in ARPEGE/AROME in EPyGrAM v1.3.7
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -519,7 +520,11 @@ SELECT CASE (IMODEL)
CASE(6,7) ! arpege and arome GRIB2
CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=4)
IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ ! Old version of EPyGraM (bug corrected since 01/2020)
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=5)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ END IF
ENDIF
CASE(10) ! NCEP
DO IVAR=0,222
@@ -921,6 +926,10 @@ IF (IMODEL==6) THEN ! GRIB2 AROME
ISTARTLEVEL = 0
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
END IF
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 1
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=83,KLEV1=ISTARTLEVEL)
+ END IF
IF (INUM > 0) THEN
WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
LCPL_AROME=.TRUE.
@@ -1116,7 +1125,7 @@ IF (NRR >1) THEN
WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
DO JLOOP1=1, INLEVEL
ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=83,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
@@ -1155,7 +1164,7 @@ IF (NRR >1) THEN
DO JLOOP1=1, INLEVEL
ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=82,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=84,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 075e87d75cd8d9fa54a8e620bd48956803a021dd..befd38e8c84c8d365e43ce2d4152ca357de387b7 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -293,6 +293,8 @@ END MODULE MODI_READ_EXSEG_n
!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
!!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -344,7 +346,8 @@ USE MODN_SERIES_n
USE MODN_TURB_CLOUD
USE MODN_TURB
USE MODN_MEAN
-USE MODN_DRAGTREE
+USE MODN_DRAGTREE_n
+USE MODN_DRAGBLDG_n
USE MODN_LATZ_EDFLX
!
USE MODD_NSV,NSV_USER_n=>NSV_USER
@@ -461,6 +464,8 @@ CCPLFILE(:)=" "
CALL INIT_NAM_CONFN
CALL INIT_NAM_DYNN
CALL INIT_NAM_ADVN
+CALL INIT_NAM_DRAGTREEN
+CALL INIT_NAM_DRAGBLDGN
CALL INIT_NAM_PARAMN
CALL INIT_NAM_PARAM_RADN
#ifdef MNH_ECRAD
@@ -514,6 +519,10 @@ CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
+CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
@@ -650,8 +659,6 @@ IF (KMI == 1) THEN
#endif
CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUSEG,'NAM_DRAGTREE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREE)
CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
@@ -2583,7 +2590,31 @@ IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
-!
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
+ .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
+ WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
IF (KMI==1) THEN
GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
ELSE
@@ -2815,6 +2846,8 @@ END IF
!
CALL UPDATE_NAM_LUNITN
CALL UPDATE_NAM_CONFN
+CALL UPDATE_NAM_DRAGTREEN
+CALL UPDATE_NAM_DRAGBLDGN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_ADVN
CALL UPDATE_NAM_PARAMN
diff --git a/src/MNH/read_grid_time_mesonh_case.f90 b/src/MNH/read_grid_time_mesonh_case.f90
index 58599b38386dd2225254c6590127c93be7efdf97..fba1ea9e956b21a5e3ff451c4a86b8d9b2bce6aa 100644
--- a/src/MNH/read_grid_time_mesonh_case.f90
+++ b/src/MNH/read_grid_time_mesonh_case.f90
@@ -174,23 +174,27 @@ CALL IO_Field_read(TZFMFILE,'RPK', ZRPK_LS)
CALL IO_Field_read(TZFMFILE,'LAT0',ZLAT0_LS)
CALL IO_Field_read(TZFMFILE,'BETA',ZBETA_LS)
!
-IF ( (ABS(ZLAT0_LS-XLAT0)>ZEPS*MAX(1.,ABS(XLAT0))) &
- .OR. (ABS(ZLON0_LS-XLON0)>ZEPS*MAX(1.,ABS(XLON0))) &
- .OR. (ABS(ABS(ZRPK_LS)-ABS(XRPK))>ZEPS*MAX(1.,ABS(XRPK))) &
- .OR. (ABS(ZBETA_LS-XBETA)>ZEPS*MAX(1.,ABS(XBETA))) ) THEN
-!
- WRITE(ILUOUT0,FMT=*) ' '
- WRITE(ILUOUT0,FMT=*) '***************************************************************'
- WRITE(ILUOUT0,FMT=*) 'Projection are different between MESONH input file and PGD file'
- WRITE(ILUOUT0,FMT=*) 'You must recompute a PGD file with PREP_PGD,'
- WRITE(ILUOUT0,FMT=*) 'using the input MESONH file to define its domain.'
- WRITE(ILUOUT0,FMT=*) '***************************************************************'
- WRITE(ILUOUT0,FMT=*) ' '
- WRITE(ILUOUT0,FMT=*) ' input file physiographic data'
- WRITE(ILUOUT0,1) 'LAT0 ',ZLAT0_LS, ' ',XLAT0
- WRITE(ILUOUT0,1) 'LON0 ',ZLON0_LS, ' ',XLON0
- WRITE(ILUOUT0,1) 'RPK ',ZRPK_LS, ' ',XRPK
- WRITE(ILUOUT0,1) 'BETA ',ZBETA_LS, ' ',XBETA
+IF(.NOT.LCARTESIAN) THEN
+ !
+ IF ( (ABS(ZLAT0_LS-XLAT0)>ZEPS*MAX(1.,ABS(XLAT0))) &
+ .OR. (ABS(ZLON0_LS-XLON0)>ZEPS*MAX(1.,ABS(XLON0))) &
+ .OR. (ABS(ABS(ZRPK_LS)-ABS(XRPK))>ZEPS*MAX(1.,ABS(XRPK))) &
+ .OR. (ABS(ZBETA_LS-XBETA)>ZEPS*MAX(1.,ABS(XBETA))) ) THEN
+ !
+ WRITE(ILUOUT0,FMT=*) ' '
+ WRITE(ILUOUT0,FMT=*) '***************************************************************'
+ WRITE(ILUOUT0,FMT=*) 'Projection are different between MESONH input file and PGD file'
+ WRITE(ILUOUT0,FMT=*) 'You must recompute a PGD file with PREP_PGD,'
+ WRITE(ILUOUT0,FMT=*) 'using the input MESONH file to define its domain.'
+ WRITE(ILUOUT0,FMT=*) '***************************************************************'
+ WRITE(ILUOUT0,FMT=*) ' '
+ WRITE(ILUOUT0,FMT=*) ' input file physiographic data'
+ WRITE(ILUOUT0,1) 'LAT0 ',ZLAT0_LS, ' ',XLAT0
+ WRITE(ILUOUT0,1) 'LON0 ',ZLON0_LS, ' ',XLON0
+ WRITE(ILUOUT0,1) 'RPK ',ZRPK_LS, ' ',XRPK
+ WRITE(ILUOUT0,1) 'BETA ',ZBETA_LS, ' ',XBETA
+ END IF
+ !
END IF
!
!* 2.2 Horizontal grid:
diff --git a/src/MNH/rel_forcingn.f90 b/src/MNH/rel_forcingn.f90
index 47c25af9c5f31c2f4108e0c0c23d228fe6426995..f53bda4deefcb13f725698f7614d542202faa6ba 100644
--- a/src/MNH/rel_forcingn.f90
+++ b/src/MNH/rel_forcingn.f90
@@ -143,7 +143,6 @@ REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZXADVTHFRC,ZXADVRV
REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZTHREL,ZRVREL
LOGICAL,DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: GRELAX_MASK_FRC ! MAsk for relaxation
REAL :: ZRELAX_HEIGHT_TOP,ZRELAX_HEIGHT_BOT, ZRELAX_TIME
-INTEGER :: IKU
!----------------------------------------------------------------------------
!
@@ -153,8 +152,6 @@ INTEGER :: IKU
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DREL', prths(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DREL', prrs (:, :, :, 1) )
-IKU = SIZE(PTHM,3)
-
IF (GSFIRSTCALL) THEN
!
GSFIRSTCALL = .FALSE.
@@ -237,7 +234,7 @@ END IF
! Corresponds to CASE=FIXE of forcing.f90
!
GRELAX_MASK_FRC(:,:,:) = .TRUE.
- WHERE ((MZF(1,IKU,1,PZZ).LT.ZRELAX_HEIGHT_BOT).OR.(MZF(1,IKU,1,PZZ).GT.ZRELAX_HEIGHT_TOP))
+ WHERE ((MZF(PZZ).LT.ZRELAX_HEIGHT_BOT).OR.(MZF(PZZ).GT.ZRELAX_HEIGHT_TOP))
GRELAX_MASK_FRC = .FALSE.
END WHERE
!
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index b75529537a2040f901f9c6f75bb0cdae7a1b3d91..8c3a844ceaa2a10a34897ace6db0a837bf08aa93 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.f90
@@ -467,7 +467,7 @@ end if
ZRHODJU(:,:,:) = MXM(PRHODJ)
ZRHODJV(:,:,:) = MYM(PRHODJ)
-ZRHODJW(:,:,:) = MZM(1,IKU,1,PRHODJ)
+ZRHODJW(:,:,:) = MZM(PRHODJ)
!
GHORELAXR(1) = OHORELAX_RV
GHORELAXR(2) = OHORELAX_RC
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index 5c6a80d42b249e954c295db03ba6176789c28f6a..0d06d2be3cbadabfab8ce39faa44c18c8f496bcc 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 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.
@@ -56,6 +56,7 @@ END MODULE MODI_RESET_EXSEG
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! J. Escobar 11/02/2020: for retrotrajectories in //, reset NHALO >> 1 if needed from NAM_CONF_DIAG
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -74,6 +75,10 @@ USE MODN_PARAM_KAFR_n
USE MODN_PARAM_RAD_n
USE MODN_PARAM_ECRAD_n
!
+USE MODD_CONF, ONLY: NHALO
+!
+USE MODD_VAR_ll, ONLY : IP
+!
IMPLICIT NONE
!
!
@@ -88,6 +93,8 @@ INTEGER :: IGRID ! IGRID : grid indicator
INTEGER :: ILENCH ! ILENCH : length of comment string
TYPE(TFILEDATA),POINTER :: TZNMLFILE! Namelist file
!
+NAMELIST/NAM_CONF_DIAG/NHALO
+!
!-------------------------------------------------------------------------------
!
!* 1. OPENING NAMELIST FILE
@@ -112,7 +119,7 @@ IF (NCONV_KF>=0) THEN
IF (GFOUND) THEN
CALL INIT_NAM_PARAM_KAFRn
READ(UNIT=ILUNAM,NML=NAM_PARAM_KAFRN)
- PRINT*, ' namelist NAM_PARAM_KAFRN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_KAFRN read'
END IF
IF (LUSERV) THEN
LDIAGCONV=.TRUE.
@@ -126,7 +133,7 @@ IF (NCONV_KF>=0) THEN
END IF
END IF
!
-PRINT*,'RESET_EXSEG OUTPUT: NCONV_KF=',NCONV_KF,' CDCONV=',CDCONV,' CGETCONV=',CGETCONV
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NCONV_KF=',NCONV_KF,' CDCONV=',CDCONV,' CGETCONV=',CGETCONV
!
!-------------------------------------------------------------------------------
!
@@ -147,7 +154,7 @@ IF(NRAD_3D>=1) THEN
CALL INIT_NAM_PARAM_RADn
READ(UNIT=ILUNAM,NML=NAM_PARAM_RADN)
CALL UPDATE_NAM_PARAM_RADn
- PRINT*, ' namelist NAM_PARAM_RADN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_RADN read'
END IF
#ifdef MNH_ECRAD
CALL POSNAM(ILUNAM,'NAM_PARAM_ECRADN',GFOUND)
@@ -155,7 +162,7 @@ IF(NRAD_3D>=1) THEN
CALL INIT_NAM_PARAM_EcRADn
READ(UNIT=ILUNAM,NML=NAM_PARAM_ECRADN)
CALL UPDATE_NAM_PARAM_ECRADn
- PRINT*, ' namelist NAM_PARAM_ECRADN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_ECRADN read'
END IF
#endif
ENDIF
@@ -170,7 +177,7 @@ IF(LEN_TRIM(CRAD_SAT) /= 0) THEN
CRAD='ECMW'
END IF
!
-PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
!
!-------------------------------------------------------------------------------
!
@@ -179,8 +186,17 @@ PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETR
!
IF (LUSECHEM .AND. .NOT.LCHEMDIAG) LUSECHEM =.FALSE.
!
-PRINT*,'RESET_EXSEG OUTPUT: LUSECHEM =',LUSECHEM,' LCHEMDIAG =',LCHEMDIAG
-PRINT*,' '
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: LUSECHEM =',LUSECHEM,' LCHEMDIAG =',LCHEMDIAG
+IF ( IP == 1 ) PRINT*,' '
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. For retrotrajectories in // , reset NHALO >> 1 if needed from NAM_CONF_DIAG
+! ---------------------------------------------------
+CALL POSNAM(ILUNAM,'NAM_CONF_DIAG',GFOUND)
+IF (GFOUND) THEN
+ READ(UNIT=ILUNAM,NML=NAM_CONF_DIAG)
+END IF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 7f920b09eb3faf6e3266ebf57719c44a01e4667e..74d9c92f79043d5b3014d8a8fe8166fed8844a6e 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -267,7 +267,10 @@ END MODULE MODI_RESOLVED_CLOUD
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 24/02/2020: bugfix: corrected budget name (DEPI->CDEPI) for ice_adjust
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -288,7 +291,7 @@ USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END,
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED
-USE MODD_PARAM_LIMA, ONLY: LCOLD, XCONC_CCN_TOT, NMOD_CCN, NMOD_IFN, NMOD_IMM, LPTSPLIT, &
+USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, XCONC_CCN_TOT, NMOD_CCN, NMOD_IFN, NMOD_IMM, LPTSPLIT, &
YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_SALT, ONLY: LSALT
@@ -760,7 +763,7 @@ SELECT CASE ( HCLOUD )
CASE('LIMA')
! Correction where rc<0 or Nc<0
IF (OWARM) THEN
- WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,NSV_LIMA_NC) < 0.)
+ WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC) < YCTMIN(2)/PTSTEP)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
ZCPH(:,:,:) / ZEXN(:,:,:)
@@ -934,7 +937,7 @@ SELECT CASE ( HCLOUD )
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
- ZZZ = MZF(1,IKU,1, PZZ )
+ ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
@@ -1013,7 +1016,7 @@ SELECT CASE ( HCLOUD )
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
- ZZZ = MZF(1,IKU,1, PZZ )
+ ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
@@ -1099,14 +1102,14 @@ SELECT CASE ( HCLOUD )
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
- ZZZ = MZF(1,IKU,1, PZZ )
+ ZZZ = MZF( PZZ )
IF (LPTSPLIT) THEN
CALL LIMA (1, IKU, 1, &
PTSTEP, TPFILE, OCLOSE_OUT, &
PRHODREF, PEXNREF, ZDZZ, &
PRHODJ, PPABSM, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
- PTHM, PTHT, PRT, ZSVT, PW_ACT, &
+ PDTHRAD, PTHT, PRT, ZSVT, PW_ACT, &
PTHS, PRS, ZSVS, &
PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
PEVAP3D )
@@ -1115,7 +1118,7 @@ SELECT CASE ( HCLOUD )
IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
TPFILE, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, &
- PTHM, PRCM, &
+ PDTHRAD, PRCM, &
PTHT, PRT, ZSVT, &
PTHS, PRS, ZSVS, &
PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
@@ -1170,14 +1173,96 @@ IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
ENDWHERE
ENDIF
ENDIF
+
+if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) * prhodj(:, :, :) )
+if (lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) * prhodj(:, :, :) )
+if (lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) * prhodj(:, :, :) )
+if (lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), 'NECON', prs (:, :, :, 3) * prhodj(:, :, :) )
+if (lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), 'NECON', prs (:, :, :, 4) * prhodj(:, :, :) )
+if (lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), 'NECON', prs (:, :, :, 5) * prhodj(:, :, :) )
+if (lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), 'NECON', prs (:, :, :, 6) * prhodj(:, :, :) )
+if (lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), 'NECON', prs (:, :, :, 7) * prhodj(:, :, :) )
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NECON', &
+ psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NECON',&
+ psvs(:, :, :, nsv_lima_nr) * prhodj(:, :, :) )
+ if ( lcold ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NECON', &
+ psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NECON', psvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NECON', psvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+end if
+
+SELECT CASE ( HCLOUD )
+ CASE('KESS')
+ WHERE (PRS(:,:,:,2) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.0
+ END WHERE
+!
!
-IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) )
-! CALL GET_HALO(PRS(:,:,:,2))
-! CALL GET_HALO(ZSVS(:,:,:,2))
-! CALL GET_HALO(ZSVS(:,:,:,3))
+! CASE('C2R2','KHKO')
+! CALL GET_HALO(PRS(:,:,:,2))
+! CALL GET_HALO(ZSVS(:,:,:,2))
+! WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
+! ZSVS(:,:,:,1) = 0.0
+! END WHERE
+! DO JSV = 2, 3
+! WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
+! PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
+! PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) / &
+! ZCPH(:,:,:) / ZEXN(:,:,:)
+! PRS(:,:,:,JSV) = 0.0
+! ZSVS(:,:,:,JSV) = 0.0
+! END WHERE
+! ENDDO
+! Commented 03/2013 O.Thouron
+! (at least necessary to be commented for supersaturation variable)
+! ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
+!
+!
+ CASE('ICE3','ICE4')
+ WHERE (PRS(:,:,:,4) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,4) = 0.
+ END WHERE
+!
+! cloud
+ WHERE (PRS(:,:,:,2) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.
+ END WHERE
+!
+! if rc or ri are positive, we can correct negative rv
+! cloud
+ WHERE ((PRS(:,:,:,1) <0.) .AND. (PRS(:,:,:,2)> 0.) )
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.
+ END WHERE
+! ice
+ IF(KRR > 3) THEN
+ WHERE ((PRS(:,:,:,1) < 0.).AND.(PRS(:,:,:,4) > 0.))
+ ZCOR(:,:,:)=MIN(-PRS(:,:,:,1),PRS(:,:,:,4))
+ PRS(:,:,:,1) = PRS(:,:,:,1) + ZCOR(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,4) = PRS(:,:,:,4) -ZCOR(:,:,:)
+ END WHERE
+ END IF
+!
+ CASE('C2R2','KHKO')
WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
ZSVS(:,:,:,1) = 0.0
END WHERE
@@ -1190,7 +1275,75 @@ IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
ZSVS(:,:,:,JSV) = 0.0
END WHERE
ENDDO
-END IF
+!
+ CASE('C3R5')
+ WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
+ ZSVS(:,:,:,1) = 0.0
+ END WHERE
+ DO JSV = 2, 3
+ WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,JSV) = 0.0
+ ZSVS(:,:,:,JSV) = 0.0
+ END WHERE
+ ENDDO
+ ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
+! ice
+ WHERE (PRS(:,:,:,4) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,4) = 0.0
+ PSVS(:,:,:,4) = 0.0
+ END WHERE
+! cloud
+ WHERE (PRS(:,:,:,2) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.0
+ PSVS(:,:,:,2) = 0.0
+ END WHERE
+ PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
+!
+ CASE('LIMA')
+! Correction where rc<0 or Nc<0
+ IF (OWARM) THEN
+ WHERE (PRS(:,:,:,2) < YRTMIN(2)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NC) < YCTMIN(2)/PTSTEP)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRS(:,:,:,2) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ END WHERE
+ END IF
+! Correction where rr<0 or Nr<0
+ IF (OWARM .AND. ORAIN) THEN
+ WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR) < YCTMIN(3)/PTSTEP)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRS(:,:,:,3) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+ END IF
+! Correction where ri<0 or Ni<0
+ IF (LCOLD) THEN
+ WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI) < YCTMIN(4)/PTSTEP)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXN(:,:,:)
+ PRS(:,:,:,4) = 0.0
+ ZSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ END WHERE
+ END IF
+!
+ ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
+ PRS(:,:,:,:) = MAX( 0.0,PRS(:,:,:,:) )
+!
+END SELECT
!-------------------------------------------------------------------------------
!
!
@@ -1214,12 +1367,26 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
DEALLOCATE(ZSVT)
ENDIF
-IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) )
-END IF
-!
+if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'NECON', pths(:, :, :) )
+if (lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), 'NECON', prs (:, :, :, 1) )
+if (lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), 'NECON', prs (:, :, :, 2) )
+if (lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), 'NECON', prs (:, :, :, 3) )
+if (lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), 'NECON', prs (:, :, :, 4) )
+if (lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), 'NECON', prs (:, :, :, 5) )
+if (lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), 'NECON', prs (:, :, :, 6) )
+if (lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), 'NECON', prs (:, :, :, 7) )
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NECON', psvs(:, :, :, nsv_lima_nc) )
+ if ( lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NECON', psvs(:, :, :, nsv_lima_nr) )
+ if ( lcold ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NECON', psvs(:, :, :, nsv_lima_ni) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NECON', psvs(:, :, :, ji) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NECON', psvs(:, :, :, ji) )
+ end do
+end if
+
!-------------------------------------------------------------------------------
!
END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index a19e05f5c7fd3cb17481c7d72f9e0c5e126c0d40..1d5ed7d83b2cdc42b71989d8fb197d9cf586fed9 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2020 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.
@@ -303,7 +303,6 @@ INTEGER :: IJB !
INTEGER :: IJE !
INTEGER :: IKB !
INTEGER :: IKE !
-INTEGER :: IKU
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: IPROC ! my proc number
INTEGER :: IERR ! error status
@@ -375,7 +374,6 @@ END IF
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PZZ,3) - JPVEXT
-IKU = SIZE(PZZ,3)
!
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) )
@@ -718,7 +716,7 @@ SELECT CASE (HCLOUD)
!
!* 5.2 Perform the saturation adjustment over cloud ice and cloud water
!
- ZZZ = MZF(1,IKU,1, PZZ )
+ ZZZ = MZF( PZZ )
CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, &
HSCONV, HMF_CLOUD, &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
@@ -782,7 +780,7 @@ SELECT CASE (HCLOUD)
!
!* 6.2 Perform the saturation adjustment over cloud ice and cloud water
!
- ZZZ = MZF(1,IKU,1, PZZ )
+ ZZZ = MZF( PZZ )
CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
diff --git a/src/MNH/rmc01.f90 b/src/MNH/rmc01.f90
index 1b7ea4ed868dc53ce650d20c295b96d626092fba..cf77c5033063e8dc4aae3ea2752f02b0b29850de 100644
--- a/src/MNH/rmc01.f90
+++ b/src/MNH/rmc01.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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 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 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ################
MODULE MODI_RMC01
! ################
@@ -144,7 +139,7 @@ IKT=SIZE(PZZ,3)
IKTE=IKT-JPVEXT_TURB
!
! altitude of mass points
-ZZZ=MZF(KKA,KKU,KKL,PZZ)
+ZZZ=MZF(PZZ)
! replace by height of mass points
DO JK=1,IKT
ZZZ(:,:,JK) = ZZZ(:,:,JK) - PZZ(:,:,IKB)
diff --git a/src/MNH/sbl_depth.f90 b/src/MNH/sbl_depth.f90
index b9add72367f32f69eb048d2f64dff7ad166df5c2..e83d8f784d4b1f4b84e755fe227fff2c588f24fc 100644
--- a/src/MNH/sbl_depth.f90
+++ b/src/MNH/sbl_depth.f90
@@ -59,7 +59,7 @@ END MODULE MODI_SBL_DEPTH
!! MODIFICATIONS
!! -------------
!! Original nov. 2005
-!!
+!! 26/02/2020 T.Nagel Correction of SBL depth computation in neutral stratification
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -130,7 +130,7 @@ ZSBL_THER= XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZQ0,PZZ(:,:,KKB),PWTHV,PZZ,XFTOP_O_
PSBL_DEPTH = 0.
WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = MIN(ZSBL_THER(:,:),ZSBL_DYN(:,:))
WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN==0.) PSBL_DEPTH = ZSBL_THER(:,:)
-WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_THER(:,:)
+WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_DYN(:,:)
!
DO JLOOP=1,5
WHERE (PLMO(:,:)/=XUNDEF .AND. ABS(PLMO(:,:))>=0.01 )
@@ -138,8 +138,8 @@ DO JLOOP=1,5
PSBL_DEPTH = 0.2 * PSBL_DEPTH + 0.8 * ((1.-ZA) * ZSBL_DYN + ZA * ZSBL_THER )
END WHERE
END DO
-WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_DYN
-WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_THER
+WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_THER
+WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_DYN
!
!----------------------------------------------------------------------------
END SUBROUTINE SBL_DEPTH
diff --git a/src/MNH/set_bogus_vortex.f90 b/src/MNH/set_bogus_vortex.f90
index 5f22d60d909fb9459dacea44fab9f59f7a3cce78..b0a881e2813a891df91d13fe47a67a55ccd977c3 100644
--- a/src/MNH/set_bogus_vortex.f90
+++ b/src/MNH/set_bogus_vortex.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2001-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-2020 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.
@@ -236,7 +236,7 @@ ZRADBOGMAX=ZRADBOGMAX*1000. ! conversion from km to m
!
ALLOCATE(ZZHAT3D(1,1,IKU),ZZHATM(1,1,IKU)) ! to compute altitude of mass points
ZZHAT3D(1,1,:) = XZHAT(:)
-ZZHATM = MZF(1,IKU,1,ZZHAT3D)
+ZZHATM = MZF(ZZHAT3D)
DEALLOCATE(ZZHAT3D)
!
! Definition de l angle de convergence
diff --git a/src/MNH/set_conc_lima.f90 b/src/MNH/set_conc_lima.f90
index 6f9e6c6ad06019e5104d70c6a2c4e92c01462bd4..688d20a6bbef50f36ac33543b1ff3d076dde6543 100644
--- a/src/MNH/set_conc_lima.f90
+++ b/src/MNH/set_conc_lima.f90
@@ -79,7 +79,7 @@ END MODULE MODI_SET_CONC_LIMA
!! Original 15/11/00
!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM *
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+!! B.Vié : 03/03/2020 secure physical tests
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -90,6 +90,7 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
USE MODD_CONF, ONLY : NVERB
+USE MODD_CONF_n, ONLY : NRR
USE MODD_LUNIT_n, ONLY : TLUOUT
!
IMPLICIT NONE
@@ -119,7 +120,7 @@ ILUOUT = TLUOUT%NLU
!* 2. INITIALIZATION
! --------------
!
-IF (LWARM) THEN
+IF (LWARM .AND. NRR.GE.2) THEN
!
! droplets
!
@@ -147,7 +148,7 @@ IF (LWARM) THEN
END IF
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (LWARM .AND. LRAIN .AND. NRR.GE.3) THEN
!
! drops
!
@@ -157,7 +158,7 @@ IF (LWARM .AND. LRAIN) THEN
ELSE ! init from KESS, ICE3...
WHERE ( PRT(:,:,:,3) > 1.E-11 )
PSVT(:,:,:,NSV_LIMA_NR) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
- *ZCONCR)),XCTMIN(3) )
+ *ZCONCR)),1. )
END WHERE
WHERE ( PRT(:,:,:,3) <= 1.E-11 )
PRT(:,:,:,3) = 0.0
@@ -170,7 +171,7 @@ IF (LWARM .AND. LRAIN) THEN
END IF
END IF
!
-IF (LCOLD) THEN
+IF (LCOLD .AND. NRR.GE.4) THEN
!
! ice crystals
!
@@ -181,7 +182,7 @@ IF (LCOLD) THEN
! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
! ZCONCI )
! Correction
- PSVT(:,:,:,NSV_LIMA_NI) = MIN(PRT(:,:,:,4)/(XAI*(10.E-06)**XBI),ZCONCI )
+ PSVT(:,:,:,NSV_LIMA_NI) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONCI )
END WHERE
WHERE ( PRT(:,:,:,4) <= 1.E-11 )
PRT(:,:,:,4) = 0.0
diff --git a/src/MNH/set_cstn.f90 b/src/MNH/set_cstn.f90
index 3ec1a28b54b6a2220d145c4a2a10c67672baa5b1..986526c82b5fd2812e3c20c9d54300592149a19e 100644
--- a/src/MNH/set_cstn.f90
+++ b/src/MNH/set_cstn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -312,7 +312,7 @@ ELSE
ZZS_LS(:,:)=ZHEIGHT(1)
ENDIF
CALL VERT_COORD(LSLEVE,ZZS_LS,ZZS_LS,XLEN1,XLEN2,XZHAT,ZZFLUX_MX)
-ZZMASS_MX(:,:,:)=MZF(1,IKU,1,ZZFLUX_MX)
+ZZMASS_MX(:,:,:)=MZF(ZZFLUX_MX)
ZZMASS_MX(:,:,IKU)=1.5*ZZFLUX_MX(:,:,IKU)-0.5*ZZFLUX_MX(:,:,IKU-1)
!
CALL MPPDB_CHECK3D(ZZMASS_MX,"SET_CSTN::ZZMASS_MX",PRECISION)
diff --git a/src/MNH/set_geosbal.f90 b/src/MNH/set_geosbal.f90
index ac57ba40c6f88f310f314a0812194805aa23f73e..28e528d8b1fbc1d269681cc40769c4f31e2ed273 100644
--- a/src/MNH/set_geosbal.f90
+++ b/src/MNH/set_geosbal.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -385,11 +385,11 @@ ELSE ! conformal projection
!
PCORIOZ(:,:,:) = SPREAD( 2. * XOMEGA * SIN(XLAT(:,:)*ZRADSDG),3,IKU)
ZDXX(:,:,:) = MXM( &
- MZF(1,IKU,1,SPREAD(SPREAD( 1.+ ZD1*XZHAT(:)/XRADIUS ,1,IIU),2,IJU )) &
+ MZF(SPREAD(SPREAD( 1.+ ZD1*XZHAT(:)/XRADIUS ,1,IIU),2,IJU )) &
* SPREAD( SPREAD(XDXHAT(1:IIU),2,IJU) /XMAP(:,:),3,IKU) )
! dxx (without orography)
ZDYY(:,:,:) = MYM( &
- MZF(1,IKU,1,SPREAD(SPREAD( 1.+ ZD1*XZHAT(:)/XRADIUS,1,IIU),2,IJU )) &
+ MZF(SPREAD(SPREAD( 1.+ ZD1*XZHAT(:)/XRADIUS,1,IIU),2,IJU )) &
* SPREAD( SPREAD(XDYHAT(1:IJU),1,IIU) /XMAP(:,:),3,IKU) )
! dyy (without orography)
END IF
@@ -648,7 +648,7 @@ ZTHV3D(:,:,:) = SPREAD(SPREAD(PTHVM(:),1,IIU),2,IJU) ! initialize with
!* 4. INTERPOLATE THETAV, MR ON MODEL GRID (WITH OROGRAPHY)
! ------------------------------------------------------------
!
-ZZM(:,:,:) = MZF(1,IKU,1,XZZ) ! compute height at mass level
+ZZM(:,:,:) = MZF(XZZ) ! compute height at mass level
! of grid with orography
!
ZZM(:,:,IKU) = 2. * XZZ(:,:,IKU) - ZZM(:,:,IKU-1) ! extrapolate on IKU mass level
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index acb2014ea5e5a4223d218ed518acf2f24c58017f..a7b266aaa997e476fbc3fa3d32a820b47f56efbe 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 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.
@@ -331,8 +331,8 @@ ELSE ! conformal projection
ZDXX(JI,JJ,JK) = ( 1.+ ZD1*XZHAT(JK)/XRADIUS ) * ( XDXHAT(JI) /XMAP(JI,JJ) ) ! XDXHAT(JI)
ZDYY(JI,JJ,JK) = ( 1.+ ZD1*XZHAT(JK)/XRADIUS ) * ( XDYHAT(JJ) /XMAP(JI,JJ) ) ! XDYHAT(JJ)
ENDDO ; ENDDO ; ENDDO ;
- ZDXX = MXM(MZF(1,IKU,1,ZDXX))
- ZDYY = MYM(MZF(1,IKU,1,ZDYY))
+ ZDXX = MXM(MZF(ZDXX))
+ ZDYY = MYM(MZF(ZDYY))
END IF
!
SELECT CASE(HFUNU)
@@ -482,8 +482,8 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
!
! Interpolation of the wind
!
- ZRHODU_MX=MZF(1,IKU,1,ZUW3D_FL)*ZRHOD_MX
- ZRHODV_MX=MZF(1,IKU,1,ZVW3D_FL)*ZRHOD_MX
+ ZRHODU_MX=MZF(ZUW3D_FL)*ZRHOD_MX
+ ZRHODV_MX=MZF(ZVW3D_FL)*ZRHOD_MX
CALL MPPDB_CHECK3DM("SET_MASS:ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX",PRECISION,&
& ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX )
CALL VER_INT_DYN(OSHIFT,ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX,PZS_MX,ZRHODUA,ZRHODVA)
diff --git a/src/MNH/set_refz.f90 b/src/MNH/set_refz.f90
index b8b10b3b75dc9c4f4f69bc0c632c59ebcd3aba6d..f6e82cd85f4e20a2e30627462ed593af03d6d0b8 100644
--- a/src/MNH/set_refz.f90
+++ b/src/MNH/set_refz.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -174,7 +174,7 @@ IKE=IKU-JPVEXT
!* 2. ALTITUDE OF THE MASS POINTS
! ---------------------------
!
-ZZMASS(:,:,:)=MZF(1,IKU,1,XZZ(:,:,:))
+ZZMASS(:,:,:)=MZF(XZZ(:,:,:))
ZZMASS(:,:,IKU)=1.5*XZZ(:,:,IKU)-0.5*XZZ(:,:,IKU-1)
!
!20131024 check zzmass and pthv
diff --git a/src/MNH/set_rsou.f90 b/src/MNH/set_rsou.f90
index 5a787a31bd6be1946fb9b1c7bdf5770622c16812..353c6298bd02baa8db936c4df60565fc4235c013 100644
--- a/src/MNH/set_rsou.f90
+++ b/src/MNH/set_rsou.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -1117,7 +1117,7 @@ ELSE
ENDIF
ENDIF
CALL VERT_COORD(LSLEVE,ZZS_LS,ZZS_LS,XLEN1,XLEN2,XZHAT,ZZFLUX_MX)
-ZZMASS_MX(:,:,:)=MZF(1,IKU,1,ZZFLUX_MX)
+ZZMASS_MX(:,:,:)=MZF(ZZFLUX_MX)
ZZMASS_MX(:,:,IKU)=1.5*ZZFLUX_MX(:,:,IKU)-0.5*ZZFLUX_MX(:,:,IKU-1)
!
!* 3.2 Interpolate and extrapolate U and V on w- mixed grid levels
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index e3fb2799f22eea29e879a4fabc79686a8441fbb6..78937e508ba19776d3ce05b9a47691d3755d6056 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -295,7 +295,7 @@ ZSVM(:,:,:) = 0.
! wind on mass points
ZUMM=MXF(PUM)
ZVMM=MYF(PVM)
-ZWMM=MZF(1,IKU,1,PWM)
+ZWMM=MZF(PWM)
!
!!! 2. Pack input variables
!
diff --git a/src/MNH/shuman.f90 b/src/MNH/shuman.f90
index 526fa0491afa685dc859a3b53a8c3ebddf493b11..a0f0e3a59792a6463c05963b11ccf73615cafffe 100644
--- a/src/MNH/shuman.f90
+++ b/src/MNH/shuman.f90
@@ -41,18 +41,14 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
! side
END FUNCTION DYM
!
-FUNCTION DZF(KKA,KKU,KL,PA) RESULT(PDZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION DZF(PA) RESULT(PDZF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
! localization
END FUNCTION DZF
!
-FUNCTION DZM(KKA,KKU,KL,PA) RESULT(PDZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION DZM(PA) RESULT(PDZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
@@ -83,18 +79,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass l
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux localization
END FUNCTION MYM
!
-FUNCTION MZF(KKA,KKU,KL,PA) RESULT(PMZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION MZF(PA) RESULT(PMZF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
! localization
END FUNCTION MZF
!
-FUNCTION MZM(KKA,KKU,KL,PA) RESULT(PMZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+FUNCTION MZM(PA) RESULT(PMZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
END FUNCTION MZM
@@ -505,7 +497,7 @@ END DO
!
END FUNCTION MYM
! ###############################
- FUNCTION MZF(KKA,KKU,KL,PA) RESULT(PMZF)
+ FUNCTION MZF(PA) RESULT(PMZF)
! ###############################
!
!!**** *MZF* - Shuman operator : mean operator in z direction for a
@@ -555,8 +547,6 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
@@ -601,7 +591,7 @@ END DO
!
END FUNCTION MZF
! ###############################
- FUNCTION MZM(KKA,KKU,KL,PA) RESULT(PMZM)
+ FUNCTION MZM(PA) RESULT(PMZM)
! ###############################
!
!!**** *MZM* - Shuman operator : mean operator in z direction for a
@@ -651,8 +641,6 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
!
@@ -1098,7 +1086,7 @@ END DO
!
END FUNCTION DYM
! ###############################
- FUNCTION DZF(KKA,KKU,KL,PA) RESULT(PDZF)
+ FUNCTION DZF(PA) RESULT(PDZF)
! ###############################
!
!!**** *DZF* - Shuman operator : finite difference operator in z direction
@@ -1148,8 +1136,6 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
@@ -1194,7 +1180,7 @@ END DO
!
END FUNCTION DZF
! ###############################
- FUNCTION DZM(KKA,KKU,KL,PA) RESULT(PDZM)
+ FUNCTION DZM(PA) RESULT(PDZM)
! ###############################
!
!!**** *DZM* - Shuman operator : finite difference operator in z direction
@@ -1244,8 +1230,6 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
diff --git a/src/MNH/spawn_lsn.f90 b/src/MNH/spawn_lsn.f90
index 36a0341493c70d13ef181fe81596a5b7fb16b84a..4bf20369035d6bdc56badc2ee0b2339529ab943b 100644
--- a/src/MNH/spawn_lsn.f90
+++ b/src/MNH/spawn_lsn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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.
@@ -378,9 +378,9 @@ END IF
IF ( GVERT_INTERP ) THEN
IKU = SIZE(PZZ,3)
!
- ZZLS2=MZF(1,IKU,1,ZZLS1)
+ ZZLS2=MZF(ZZLS1)
ZZLS2(:,:,IKU)=2.*ZZLS2(:,:,IKU-1)-ZZLS2(:,:,IKU-2)
- ZZSS=MZF(1,IKU,1,PZZ)
+ ZZSS=MZF(PZZ)
ZZSS(:,:,IKU)=2.*ZZSS(:,:,IKU-1)-ZZSS(:,:,IKU-2)
!
CALL COEF_VER_INTERP_LIN(ZZLS2,ZZSS,IKLIN,ZCOEFLIN)
@@ -455,7 +455,7 @@ IF ( GVERT_INTERP ) THEN
!
ZZLS1=MYM(ZZLS2)
ZZLS1(:,1,:)=2.*ZZLS1(:,2,:)-ZZLS1(:,3,:)
- ZZSS=MZF(1,IKU,1,PZZ)
+ ZZSS=MZF(PZZ)
ZZSS(:,:,IKU)=2.*ZZSS(:,:,IKU-1)-ZZSS(:,:,IKU-2)
ZZSS=MYM(ZZSS)
ZZSS(:,1,:)=2.*ZZSS(:,2,:)-ZZSS(:,3,:)
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index ff2edc1eaabb3935cb93357fdb1430abe4e042a5..e5de7a4c72e5736acdeb99546bea0ae380ee492e 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -1413,7 +1413,7 @@ IF (.NOT. L1D) THEN
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
END IF
!
diff --git a/src/MNH/spawn_pressure2.f90 b/src/MNH/spawn_pressure2.f90
index 0a55faaef3b11cd76e9f289ad02fd6a32e772000..0b763ec655d07bf049999250ef06abbc38b1faf4 100644
--- a/src/MNH/spawn_pressure2.f90
+++ b/src/MNH/spawn_pressure2.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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.
@@ -339,9 +339,9 @@ IKE=IKU-JPVEXT
!
ALLOCATE(ZGRIDA(IIU,IJU,IKU))
ALLOCATE(ZGRIDB(IIU,IJU,IKU))
- ZGRIDA(:,:,:)=MZF(1,IKU,1,PZZ_LS(:,:,:))
+ ZGRIDA(:,:,:)=MZF(PZZ_LS(:,:,:))
ZGRIDA(:,:,IKU)=2.*ZGRIDA(:,:,IKU-1)-ZGRIDA(:,:,IKU-2)
- ZGRIDB(:,:,:)=MZF(1,IKU,1,PZZ(:,:,:))
+ ZGRIDB(:,:,:)=MZF(PZZ(:,:,:))
ZGRIDB(:,:,IKU)=2.*ZGRIDB(:,:,IKU-1)-ZGRIDB(:,:,IKU-2)
CALL COEF_VER_INTERP_LIN(ZGRIDA(:,:,:),ZGRIDB(:,:,:))
!
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 2480473be3a44be2ae754e179093f444bf3c264b..3392212b137d81ff30a2cb66d643f683f69d52e1 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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.
@@ -76,7 +76,8 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_File_add2list)
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 11/02/2020: bugfix: close TINIFILEPGD only if previously opened
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -208,7 +209,7 @@ CALL INIT_MNH
!
CALL IO_File_find_byname(TRIM(CINIFILE),TZINIFILE,IRESP)
CALL IO_File_close(TZINIFILE)
-CALL IO_File_close(TINIFILEPGD)
+IF ( TINIFILEPGD%LOPENED ) CALL IO_File_close(TINIFILEPGD)
!-------------------------------------------------------------------------------
!
!* 4. INITIALIZATION OF OUTER POINTS OF MODEL 1
@@ -220,7 +221,7 @@ CALL BOUNDARIES &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
CALL MPPDB_CHECK3D(XUT,"SPAWNING-after boundaries::XUT",PRECISION)
!
diff --git a/src/MNH/stationn.f90 b/src/MNH/stationn.f90
index 1c71367b1befd1043898e32e5c4c2450e1fd8363..ad4ca3b71d3cacca6f47df59fde4603e29cdc2e7 100644
--- a/src/MNH/stationn.f90
+++ b/src/MNH/stationn.f90
@@ -76,9 +76,10 @@ END MODULE MODI_STATION_n
!! P.Aumond 01/07/2011 : Add model levels
!! C.Lac 04/2013 : Correction on the vertical levels
!! C.Lac 04/2013 : Add I/J positioning
-!! P.Wautelet 28/03/2018 : Replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! R. Schoetter 11/2019: use LCARTESIAN instead of LSTATLAT for multiproc in cartesian
!
! --------------------------------------------------------------------------
!
@@ -268,7 +269,6 @@ IF (GSTATFIRSTCALL) THEN
!
!* 4.4 Computations only on correct processor
! --------------------------------------
- IF ( LSTATLAT ) THEN
ZXCOEF(I) = 0.
ZYCOEF(I) = 0.
ZUCOEF(I) = 0.
@@ -307,7 +307,6 @@ IF (GSTATFIRSTCALL) THEN
!
END IF
- END IF
ENDDO
END IF
!----------------------------------------------------------------------------
@@ -333,18 +332,16 @@ IF (GSTORE) THEN
ENDIF
END IF
!
- ZGAM = (XRPK * (TSTATION%LON(I) - XLON0) - XBETA)*(XPI/180.)
- IF ( LSTATLAT ) THEN
- ZU_STAT = STATION_INTERP_2D_U(PU(:,:,J))
- ZV_STAT = STATION_INTERP_2D_V(PV(:,:,J))
+ IF (LCARTESIAN) THEN
+ TSTATION%ZON (IN,I) = STATION_INTERP_2D_U(PU(:,:,J))
+ TSTATION%MER (IN,I) = STATION_INTERP_2D_V(PV(:,:,J))
ELSE
- ZU_STAT = PU(TSTATION%I(I),TSTATION%J(I),J)
- ZV_STAT = PV(TSTATION%I(I),TSTATION%J(I),J)
- END IF
- !
- TSTATION%ZON (IN,I) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
- TSTATION%MER (IN,I) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
- IF ( LSTATLAT ) THEN
+ ZU_STAT = STATION_INTERP_2D_U(PU(:,:,J))
+ ZV_STAT = STATION_INTERP_2D_V(PV(:,:,J))
+ ZGAM = (XRPK * (TSTATION%LON(I) - XLON0) - XBETA)*(XPI/180.)
+ TSTATION%ZON (IN,I) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
+ TSTATION%MER (IN,I) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
+ ENDIF
TSTATION%W (IN,I) = STATION_INTERP_2D(PW(:,:,J))
TSTATION%TH (IN,I) = STATION_INTERP_2D(PTH(:,:,J))
TSTATION%P (IN,I) = STATION_INTERP_2D(PP(:,:,J))
@@ -383,46 +380,7 @@ IF (GSTORE) THEN
ENDIF
TSTATION%SFCO2 (IN,I) = STATION_INTERP_2D(XCURRENT_SFCO2 )
ENDIF
- ELSE
- TSTATION%W (IN,I) = PW(TSTATION%I(I),TSTATION%J(I),J)
- TSTATION%TH (IN,I) = PTH(TSTATION%I(I),TSTATION%J(I),J)
- TSTATION%P (IN,I) = PP(TSTATION%I(I),TSTATION%J(I),J)
- !
- DO JSV=1,SIZE(PR,4)
- TSTATION%R (IN,I,JSV) = PR(TSTATION%I(I),TSTATION%J(I),J,JSV)
- END DO
- !
- DO JSV=1,SIZE(PSV,4)
- TSTATION%SV (IN,I,JSV) = PSV(TSTATION%I(I),TSTATION%J(I),J,JSV)
- END DO
- !
- IF (SIZE(PTKE)>0) TSTATION%TKE (IN,I) = PTKE(TSTATION%I(I),TSTATION%J(I),J)
- IF (SIZE(PTS) >0) TSTATION%TSRAD(IN,I) = PTS(TSTATION%I(I),TSTATION%J(I))
- TSTATION%ZS(I) = PZ(TSTATION%I(I),TSTATION%J(I),1+JPVEXT)
- !
- IF (LDIAG_IN_RUN) THEN
- TSTATION%ZON10M(IN,I) = XCURRENT_ZON10M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%MER10M(IN,I) = XCURRENT_MER10M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%T2M (IN,I) = XCURRENT_T2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%Q2M (IN,I) = XCURRENT_Q2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%HU2M (IN,I) = XCURRENT_HU2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%RN (IN,I) = XCURRENT_RN(TSTATION%I(I),TSTATION%J(I))
- TSTATION%H (IN,I) = XCURRENT_H(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LE (IN,I) = XCURRENT_LE(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LEI (IN,I) = XCURRENT_LEI(TSTATION%I(I),TSTATION%J(I))
- TSTATION%GFLUX (IN,I) = XCURRENT_GFLUX(TSTATION%I(I),TSTATION%J(I))
- IF (CRAD /= 'NONE') THEN
- TSTATION%SWD (IN,I) = XCURRENT_SWD(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWU (IN,I) = XCURRENT_SWU(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LWD (IN,I) = XCURRENT_LWD(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LWU (IN,I) = XCURRENT_LWU(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWDIR (IN,I) = XCURRENT_SWDIR(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWDIFF(IN,I) = XCURRENT_SWDIFF(TSTATION%I(I),TSTATION%J(I))
- TSTATION%DSTAOD(IN,I) = XCURRENT_DSTAOD(TSTATION%I(I),TSTATION%J(I))
- ENDIF
- TSTATION%SFCO2 (IN,I) = XCURRENT_SFCO2(TSTATION%I(I),TSTATION%J(I))
- ENDIF
- ENDIF
+
!
END IF
!
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index e773799be9ff0d2c4b77b8e0a891fd43681dd385..3ea39b78f0484024904edf523e253210111c4b0f 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_sources.f90
@@ -318,7 +318,7 @@ ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) + PRTKESM(:,:,:) / PRHODJ(:,:,:
! matrix inverted in TRIDIAG
!
ZA(:,:,:) = - PTSTEP * XCET * &
- MZM(KKA,KKU,KKL,ZKEFF) * MZM(KKA,KKU,KKL,PRHODJ) / PDZZ**2
+ MZM(ZKEFF) * MZM(PRHODJ) / PDZZ**2
!
! Compute TKE at time t+deltat: ( stored in ZRES )
!
@@ -350,20 +350,20 @@ IF ( LLES_CALL .OR. &
! Compute the cartesian vertical flux of TKE in ZFLX
!
- ZFLX(:,:,:) = - XCET * MZM(KKA,KKU,KKL,ZKEFF) * &
- DZM(KKA,KKU,KKL,PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
+ ZFLX(:,:,:) = - XCET * MZM(ZKEFF) * &
+ DZM(PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
!
ZFLX(:,:,IKB) = 0.
ZFLX(:,:,KKA) = 0.
!
! Compute the whole turbulent TRansport of TKE:
!
- PTR(:,:,:)= PTR - DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PRHODJ) * ZFLX / PDZZ ) /PRHODJ
+ PTR(:,:,:)= PTR - DZF( MZM(PRHODJ) * ZFLX / PDZZ ) /PRHODJ
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLX), X_LES_SUBGRID_WTke )
+ CALL LES_MEAN_SUBGRID( MZF(ZFLX), X_LES_SUBGRID_WTke )
CALL LES_MEAN_SUBGRID( -PTR, X_LES_SUBGRID_ddz_WTke )
END IF
!
diff --git a/src/MNH/tridiag_thermo.f90 b/src/MNH/tridiag_thermo.f90
index 0da3f156b1cd1229272086f5409651a8d5f2388d..2a02b634692cfebf10465a38fea4875eb8cc12db 100644
--- a/src/MNH/tridiag_thermo.f90
+++ b/src/MNH/tridiag_thermo.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 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 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 newsrc 2006/06/02 17:32:30
-!-----------------------------------------------------------------
! ###################
MODULE MODI_TRIDIAG_THERMO
! ###################
@@ -199,7 +194,7 @@ IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
!
-ZMZM_RHODJ = MZM(KKA,KKU,KKL,PRHODJ)
+ZMZM_RHODJ = MZM(PRHODJ)
ZRHODJ_DFDDTDZ_O_DZ2 = ZMZM_RHODJ*PDFDDTDZ/PDZZ**2
!
ZA=0.
diff --git a/src/MNH/tridiag_w.f90 b/src/MNH/tridiag_w.f90
index 477384a7197c54f06a3199f5e34b5d67873672c5..c995d91f1e226456490b6f5cd817694b380cb9f0 100644
--- a/src/MNH/tridiag_w.f90
+++ b/src/MNH/tridiag_w.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###################
MODULE MODI_TRIDIAG_W
! ###################
@@ -175,7 +176,7 @@ REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
! 2D work array
INTEGER :: JK ! loop counter
-INTEGER :: IKB,IKE,IKU ! inner vertical limits
+INTEGER :: IKB,IKE ! inner vertical limits
!
! ---------------------------------------------------------------------------
!
@@ -184,9 +185,8 @@ INTEGER :: IKB,IKE,IKU ! inner vertical limits
!
IKB=1+JPVEXT
IKE=SIZE(PVARM,3)-JPVEXT
-IKU=SIZE(PVARM,3)
!
-ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+ZMZM_RHODJ = MZM(PRHODJ)
ZRHODJ_DFDDWDZ_O_DZ2 = PRHODJ*PDFDDWDZ/PMZF_DZZ**2
!
ZA=0.
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index e03e039d79aeb233385b3e9557e8e590bc62ea80..81dcee7fcce563951298de345c8c81adfc01aeeb 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -341,13 +341,16 @@ END MODULE MODI_TURB
! Q. Rodier 01/2018: introduction of RM17
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
- NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
tbudgets
USE MODD_CONF
USE MODD_CST
@@ -357,6 +360,7 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_PARAM_LIMA
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -540,7 +544,7 @@ REAL :: ZALPHA ! proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
!
REAL :: ZTIME1, ZTIME2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZSHEAR, ZDUDZ, ZDVDZ
TYPE(TFIELDDATA) :: TZFIELD
!
@@ -749,8 +753,8 @@ SELECT CASE (HTURBLEN)
! ------------------
CASE ('RM17')
- ZDUDZ = MXF(MZF(1,KKU,1,GZ_U_UW(1,KKU,1,PUT,PDZZ)))
- ZDVDZ = MYF(MZF(1,KKU,1,GZ_V_VW(1,KKU,1,PVT,PDZZ)))
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
!
@@ -877,9 +881,9 @@ IF (HTOM=='TM06') THEN
!
ZFWTH = -GZ_M_W(KKA,KKU,KKL,ZMWTH,PDZZ) ! -d(w'2th' )/dz
!ZFWR = -GZ_M_W(KKA,KKU,KKL,ZMWR, PDZZ) ! -d(w'2r' )/dz
- ZFTH2 = -GZ_W_M(KKA,KKU,KKL,ZMTH2,PDZZ) ! -d(w'th'2 )/dz
- !ZFR2 = -GZ_W_M(KKA,KKU,KKL,ZMR2, PDZZ) ! -d(w'r'2 )/dz
- !ZFTHR = -GZ_W_M(KKA,KKU,KKL,ZMTHR,PDZZ) ! -d(w'th'r')/dz
+ ZFTH2 = -GZ_W_M(ZMTH2,PDZZ) ! -d(w'th'2 )/dz
+ !ZFR2 = -GZ_W_M(ZMR2, PDZZ) ! -d(w'r'2 )/dz
+ !ZFTHR = -GZ_W_M(ZMTHR,PDZZ) ! -d(w'th'r')/dz
!
ZFWTH(:,:,IKTE:) = 0.
ZFWTH(:,:,:IKTB) = 0.
@@ -1064,7 +1068,7 @@ end if
! 6.1 Contribution of mass-flux in the TKE buoyancy production if
! cloud computation is not statistical
- PTHP = PTHP + XG / PTHVREF * MZF(KKA,KKU,KKL, PFLXZTHVMF )
+ PTHP = PTHP + XG / PTHVREF * MZF( PFLXZTHVMF )
! 6.2 TKE evolution equation
@@ -1151,47 +1155,156 @@ IF ( KRRL >= 1 ) THEN
PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
END IF
END IF
-!
-IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
- if (lbudget_th) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) )
- end if
- end if
+
+if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
+ if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) )
if (lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), 'NETUR', prrs (:, :, :, 1) )
if (lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), 'NETUR', prrs (:, :, :, 2) )
+ if (lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), 'NETUR', prrs (:, :, :, 3) )
+ if (lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), 'NETUR', prrs (:, :, :, 4) )
+ if (lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), 'NETUR', prrs (:, :, :, 5) )
+ if (lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), 'NETUR', prrs (:, :, :, 6) )
+ if (lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), 'NETUR', prrs (:, :, :, 7) )
+end if
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NETUR', prsvs(:, :, :, nsv_lima_nc) )
+ if ( lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NETUR', prsvs(:, :, :, nsv_lima_nr) )
+ if ( lcold ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NETUR', prsvs(:, :, :, nsv_lima_ni) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NETUR', prsvs(:, :, :, ji) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), 'NETUR', prsvs(:, :, :, ji) )
+ end do
+end if
- ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
- ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
- ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
- ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
-! CALL GET_HALO(PRRS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,3))
- WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
- PRSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
+SELECT CASE ( HCLOUD )
+ CASE('ICE3','ICE4')
+ ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ WHERE (PRRS(:,:,:,4) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,4)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,4) = 0.
+ END WHERE
+!
+! cloud
+ WHERE (PRRS(:,:,:,2) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,2) = 0.
+ END WHERE
+!
+! if rc or ri are positive, we can correct negative rv
+! cloud
+ WHERE ((PRRS(:,:,:,1) <0.) .AND. (PRRS(:,:,:,2)> 0.) )
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,2) = 0.
+ END WHERE
+! ice
+ IF(KRR > 3) THEN
+ WHERE ((PRRS(:,:,:,1) < 0.).AND.(PRRS(:,:,:,4) > 0.))
+ ZCOR(:,:,:)=MIN(-PRRS(:,:,:,1),PRRS(:,:,:,4))
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZCOR(:,:,:)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) / &
ZCPH(:,:,:) / ZEXNE(:,:,:)
- PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
- END WHERE
- END DO
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) -ZCOR(:,:,:)
+ END WHERE
+ END IF
+!
+ CASE('C2R2','KHKO')
+ ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+! CALL GET_HALO(PRRS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,2))
+! CALL GET_HALO(PRSVS(:,:,:,3))
+ WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
+ PRSVS(:,:,:,1) = 0.0
+ END WHERE
+ DO JSV = 2, 3
+ WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,JSV) = 0.0
+ PRSVS(:,:,:,JSV) = 0.0
+ END WHERE
+ END DO
+ !
+ CASE('LIMA')
+ ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
+ ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+! Correction where rc<0 or Nc<0
+ IF (LWARM) THEN
+ WHERE (PRRS(:,:,:,2) < XRTMIN(2)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NC) < XCTMIN(2)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,2) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ END WHERE
+ END IF
+! Correction where rr<0 or Nr<0
+ IF (LWARM .AND. LRAIN) THEN
+ WHERE (PRRS(:,:,:,3) < XRTMIN(3)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NR) < XCTMIN(3)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,3)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,3) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,3) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+ END IF
+! Correction where ri<0 or Ni<0
+ IF (LCOLD) THEN
+ WHERE (PRRS(:,:,:,4) < XRTMIN(4)/PTSTEP .OR. PRSVS(:,:,:,NSV_LIMA_NI) < XCTMIN(4)/PTSTEP)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,4)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / ZEXNE(:,:,:)
+ PRRS(:,:,:,4) = 0.0
+ PRSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ END WHERE
+ END IF
+!
+ PRSVS(:,:,:,:) = MAX( 0.0,PRSVS(:,:,:,:) )
+ PRRS(:,:,:,:) = MAX( 0.0,PRRS(:,:,:,:) )
+!
+END SELECT
+if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'NETUR', prthls(:, :, :) )
if (lbudget_rv) call Budget_store_end( tbudgets(NBUDGET_RV), 'NETUR', prrs (:, :, :, 1) )
if (lbudget_rc) call Budget_store_end( tbudgets(NBUDGET_RC), 'NETUR', prrs (:, :, :, 2) )
-END IF
-!
+ if (lbudget_rr) call Budget_store_end( tbudgets(NBUDGET_RR), 'NETUR', prrs (:, :, :, 3) )
+ if (lbudget_ri) call Budget_store_end( tbudgets(NBUDGET_RI), 'NETUR', prrs (:, :, :, 4) )
+ if (lbudget_rs) call Budget_store_end( tbudgets(NBUDGET_RS), 'NETUR', prrs (:, :, :, 5) )
+ if (lbudget_rg) call Budget_store_end( tbudgets(NBUDGET_RG), 'NETUR', prrs (:, :, :, 6) )
+ if (lbudget_rh) call Budget_store_end( tbudgets(NBUDGET_RH), 'NETUR', prrs (:, :, :, 7) )
+end if
+if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ if ( lwarm ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'NETUR', prsvs(:, :, :, nsv_lima_nc) )
+ if ( lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'NETUR', prsvs(:, :, :, nsv_lima_nr) )
+ if ( lcold ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'NETUR', prsvs(:, :, :, nsv_lima_ni) )
+ do ji = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), 'NETUR', prsvs(:, :, :, ji) )
+ end do
+ do ji = nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), 'NETUR', prsvs(:, :, :, ji) )
+ end do
+end if
+
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
@@ -1229,13 +1342,13 @@ IF (LLES_CALL) THEN
CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
& GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) &
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
& GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
& GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
END IF
diff --git a/src/MNH/turb_cloud_index.f90 b/src/MNH/turb_cloud_index.f90
index 6e011097c60ff6adcc357ab828a413939959632d..3ab076106ce700ded50c86681ada39a2c8a34e16 100644
--- a/src/MNH/turb_cloud_index.f90
+++ b/src/MNH/turb_cloud_index.f90
@@ -135,7 +135,6 @@ REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),2) :: ZG_RVCI,ZQ_RVCI
INTEGER :: JI,JJ,JK ! loop counters
INTEGER :: IIB,IJB,IKB ! Begin of physical dimensions
INTEGER :: IIE,IJE,IKE ! End of physical dimensions
-INTEGER :: IKU ! array size in k
INTEGER, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: IMASK_CLOUD
! 0 except cloudy points or adjacent points (1)
TYPE(TFIELDDATA) :: TZFIELD
@@ -147,8 +146,7 @@ TYPE(TFIELDDATA) :: TZFIELD
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
-IKU = SIZE(PRM,3)
-IKE = IKU - JPVEXT
+IKE = SIZE(PRM,3) - JPVEXT
!
IMASK_CLOUD(:,:,:) = 0
PCEI(:,:,:) = 0.
@@ -167,8 +165,8 @@ ZRVCI0(:,:,:) = MAX ( PRRS(:,:,:,1) , 0. ) + MAX ( PRRS(:,:,:,2) , 0. )
IF (KRRI>=1) ZRVCI0(:,:,:) = ZRVCI0(:,:,:) + MAX ( PRRS(:,:,:,4) , 0. )
!
ZRVCI(:,:,:)= PTSTEP *ZRVCI0(:,:,:) /PRHODJ(:,:,:)
-ZG_RVCI(:,:,:,1) = GX_M_M(1,IKU,1,ZRVCI,PDXX,PDZZ,PDZX)
-ZG_RVCI(:,:,:,2) = GY_M_M(1,IKU,1,ZRVCI,PDYY,PDZZ,PDZY)
+ZG_RVCI(:,:,:,1) = GX_M_M(ZRVCI,PDXX,PDZZ,PDZX)
+ZG_RVCI(:,:,:,2) = GY_M_M(ZRVCI,PDYY,PDZZ,PDZY)
!
ZGNORM_RVCI(:,:,:) = SQRT( ZG_RVCI(:,:,:,1)*ZG_RVCI(:,:,:,1) + &
ZG_RVCI(:,:,:,2)*ZG_RVCI(:,:,:,2) )
@@ -185,8 +183,8 @@ ZWORK(:,:,:) = ZRVCI0 / PRHODJ(:,:,:) - &
( PRM(:,:,:,1)+ PRM(:,:,:,2) ) / PTSTEP
IF (KRRI>=1) ZWORK(:,:,:) = ZWORK(:,:,:) - PRM(:,:,:,4) / PTSTEP
!
-ZQ_RVCI(:,:,:,1) = GX_M_M(1,IKU,1,ZWORK,PDXX,PDZZ,PDZX)
-ZQ_RVCI(:,:,:,2) = GY_M_M(1,IKU,1,ZWORK,PDYY,PDZZ,PDZY)
+ZQ_RVCI(:,:,:,1) = GX_M_M(ZWORK,PDXX,PDZZ,PDZX)
+ZQ_RVCI(:,:,:,2) = GY_M_M(ZWORK,PDYY,PDZZ,PDZY)
!
ZQNORM_RVCI(:,:,:) = SQRT( ZQ_RVCI(:,:,:,1)*ZQ_RVCI(:,:,:,1) + &
ZQ_RVCI(:,:,:,2)*ZQ_RVCI(:,:,:,2) )
diff --git a/src/MNH/turb_hor.f90 b/src/MNH/turb_hor.f90
index 389d45e490327bfcb3de8fb896f2a308defaa235..522bb30b003feab886665e6d263510a524a4d7e8 100644
--- a/src/MNH/turb_hor.f90
+++ b/src/MNH/turb_hor.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -184,20 +184,8 @@ END MODULE MODI_TURB_HOR
!!
!! EXTERNAL
!! --------
-!! GX_M_U, GY_M_V
-!! GX_M_M, GY_M_M, GZ_M_M
-!! GY_U_UV,GX_V_UV
-!! GX_U_M, GY_V_M, GZ_W_M
-!! GX_W_UW,GY_W_UW
-!! : Cartesian vertical gradient operators
-!!
!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXM,DXF.DYM,DYF,DZM,DZF
-!! : Shuman functions (difference operators)
!!
-!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
@@ -259,13 +247,6 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-!
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_SHUMAN
-!
USE MODI_TURB_HOR_THERMO_FLUX
USE MODI_TURB_HOR_THERMO_CORR
USE MODI_TURB_HOR_DYN_CORR
diff --git a/src/MNH/turb_hor_dyn_corr.f90 b/src/MNH/turb_hor_dyn_corr.f90
index 1b5e6836c377d9767ebdec1f7f5fc003d5190e7f..4787f4dd84696cf26dabf5bbd9aa4e2b18227c04 100644
--- a/src/MNH/turb_hor_dyn_corr.f90
+++ b/src/MNH/turb_hor_dyn_corr.f90
@@ -274,11 +274,11 @@ IKU = SIZE(PUM,3)
!
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
-GX_U_M_PUM = GX_U_M(1,IKU,1,PUM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_V_M_PVM = GY_V_M(1,IKU,1,PVM,PDYY,PDZZ,PDZY)
-GZ_W_M_PWM = GZ_W_M(1,IKU,1,PWM,PDZZ)
+GX_U_M_PUM = GX_U_M(PUM,PDXX,PDZZ,PDZX)
+IF (.NOT. L2D) GY_V_M_PVM = GY_V_M(PVM,PDYY,PDZZ,PDZY)
+GZ_W_M_PWM = GZ_W_M(PWM,PDZZ)
!
-ZMZF_DZZ = MZF(1,IKU,1,PDZZ)
+ZMZF_DZZ = MZF(PDZZ)
!
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZFLX, 'TURB_HOR_DYN_CORR::ZFLX' )
@@ -395,7 +395,7 @@ CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PREC
PRUS(:,:,:)=PRUS &
-DXM(PRHODJ * ZFLX / MXF(PDXX) ) &
- +DZF(1,IKU,1, PDZX / MZM(1,IKU,1,PDXX) * MXM( MZM(1,IKU,1,PRHODJ*ZFLX) * PINV_PDZZ ) )
+ +DZF( PDZX / MZM(PDXX) * MXM( MZM(PRHODJ*ZFLX) * PINV_PDZZ ) )
CALL MPPDB_CHECK3DM("after turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
& PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
ELSE
@@ -488,8 +488,8 @@ IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRVS(:,:,:)=PRVS &
-DYM(PRHODJ * ZFLX / MYF(PDYY) ) &
- +DZF(1,IKU,1, PDZY / MZM(1,IKU,1,PDYY) * &
- MYM( MZM(1,IKU,1,PRHODJ*ZFLX) * PINV_PDZZ ) )
+ +DZF( PDZY / MZM(PDYY) * &
+ MYM( MZM(PRHODJ*ZFLX) * PINV_PDZZ ) )
ELSE
PRVS(:,:,:)=PRVS -DYM(PRHODJ * ZFLX / MYF(PDYY) )
END IF
@@ -572,17 +572,17 @@ END IF
!
! Complete the W tendency
!
-!PRWS(:,:,:)=PRWS(:,:,:) - DZM(1,IKU,1, PRHODJ*ZFLX/MZF(1,IKU,1,PDZZ) )
+!PRWS(:,:,:)=PRWS(:,:,:) - DZM( PRHODJ*ZFLX/MZF(PDZZ) )
ZDFDDWDZ(:,:,:) = - XCMFS * PK(:,:,:) * (4./3.)
ZDFDDWDZ(:,:,:IKB) = 0.
!
CALL TRIDIAG_W(PWM,ZFLX,ZDFDDWDZ,PTSTEP,ZMZF_DZZ,PRHODJ,ZWP)
!
-PRWS = PRWS(:,:,:) + MZM(1,IKU,1,PRHODJ(:,:,:))*(ZWP(:,:,:)-PWM(:,:,:))/PTSTEP
+PRWS = PRWS(:,:,:) + MZM(PRHODJ(:,:,:))*(ZWP(:,:,:)-PWM(:,:,:))/PTSTEP
!
!* recomputes flux using guess of W
!
-GZ_W_M_ZWP = GZ_W_M(1,IKU,1,ZWP,PDZZ)
+GZ_W_M_ZWP = GZ_W_M(ZWP,PDZZ)
ZFLX(:,:,IKB+1:)=ZFLX(:,:,IKB+1:) &
- XCMFS * PK(:,:,IKB+1:) * (4./3.) * (GZ_W_M_ZWP(:,:,IKB+1:) - GZ_W_M_PWM(:,:,IKB+1:))
!
@@ -605,18 +605,18 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_W2 )
CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID( GZ_M_M(1,IKU,1,PTHLM,PDZZ)*ZFLX, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID(ZFLX*MZF(1,IKU,1,GZ_M_W(1,IKU,1,PTHLM,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PTHLM,PDZZ)*ZFLX, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PTHLM,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( GZ_M_M(1,IKU,1,PRM(:,:,:,1),PDZZ)*ZFLX, &
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PRM(:,:,:,1),PDZZ)*ZFLX, &
X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID(ZFLX*MZF(1,IKU,1,GZ_M_W(1,IKU,1,PRM(:,:,:,1),PDZZ)), &
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PRM(:,:,:,1),PDZZ)), &
X_LES_RES_ddz_Rt_SBG_W2)
END IF
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( GZ_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)*ZFLX, &
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PSVM(:,:,:,JSV),PDZZ)*ZFLX, &
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
- CALL LES_MEAN_SUBGRID(ZFLX*MZF(1,IKU,1,GZ_M_W(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)), &
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)), &
X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/turb_hor_splt.f90 b/src/MNH/turb_hor_splt.f90
index 9fdace16e45e26608eccc6ec3b6077d9df398598..cb43941a8f96506c872550fc37fc5cf35bd703eb 100644
--- a/src/MNH/turb_hor_splt.f90
+++ b/src/MNH/turb_hor_splt.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -355,7 +355,7 @@ REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZMZM_PRHODJ ! MZM(PRHODJ)
!
INTEGER :: JSPLT ! current split
!
-INTEGER :: IKB, IKE, IIB, IIE, IJB, IJE, IKU
+INTEGER :: IKB, IKE, IIB, IIE, IJB, IJE
INTEGER :: JRR, JSV
!
INTEGER :: ISV
@@ -376,7 +376,6 @@ TYPE(LIST_ll), POINTER, SAVE :: TZFIELDS_ll
!
IKB = 1.+JPVEXT
IKE = SIZE(PUM,3) - JPVEXT
-IKU = SIZE(PUM,3)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
ISV=SIZE(PSVM,4)
!
@@ -389,7 +388,7 @@ ALLOCATE(ZMZM_PRHODJ(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)))
ZINV_PDXX = 1./PDXX
ZINV_PDYY = 1./PDYY
ZINV_PDZZ = 1./PDZZ
-ZMZM_PRHODJ = MZM(1,IKU,1,PRHODJ)
+ZMZM_PRHODJ = MZM(PRHODJ)
!
ZK(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
!
diff --git a/src/MNH/turb_hor_sv_corr.f90 b/src/MNH/turb_hor_sv_corr.f90
index 77489e8c655e657bfcf213a77324a6d749543ced..f9e2c7b5557ff6c0f31e75efcf9a3aa3347b3406 100644
--- a/src/MNH/turb_hor_sv_corr.f90
+++ b/src/MNH/turb_hor_sv_corr.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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 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 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ############################
MODULE MODI_TURB_HOR_SV_CORR
! ############################
@@ -142,7 +137,6 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) &
:: ZFLX, ZA
!
INTEGER :: JSV ! loop counter
-INTEGER :: IKU
!
REAL :: ZTIME1, ZTIME2
!
@@ -153,7 +147,6 @@ REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
REAL :: ZCSV !constant for the scalar flux
! ---------------------------------------------------------------------------
!
-IKU=SIZE(PTKEM,3)
CALL SECOND_MNH(ZTIME1)
!
IF(LBLOWSNOW) THEN
@@ -172,15 +165,15 @@ DO JSV=1,NSV
IF (LLES_CALL) THEN
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = ZCSV / ZCSVD * PLM(:,:,:) * PLEPS(:,:,:) * &
- ( GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)**2 )
+ ( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)**2 )
ELSE
ZFLX(:,:,:) = ZCSV / ZCSVD * PLM(:,:,:) * PLEPS(:,:,:) * &
- GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2
+ GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2
END IF
CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLX/PLEPS, &
X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV), .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_Sv2(:,:,:,JSV), .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Sv2(:,:,:,JSV), .TRUE. )
END IF
!
! covariance SvThv
@@ -189,12 +182,12 @@ DO JSV=1,NSV
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
- * ( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- + GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
+ * ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
) * (XCSHF+ZCSV) / (2.*ZCTSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
- * GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ * GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
* (XCSHF+ZCSV) / (2.*ZCTSVD)
END IF
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
@@ -204,12 +197,12 @@ DO JSV=1,NSV
ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
- * ( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- + GY_M_M(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY) * GY_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
+ * ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
) * (XCHF+ZCSV) / (2.*ZCQSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
- * GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
* (XCHF+ZCSV) / (2.*ZCQSVD)
END IF
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
diff --git a/src/MNH/turb_hor_sv_flux.f90 b/src/MNH/turb_hor_sv_flux.f90
index c50ea5761fe9a04e81cf947c052e881deca43577..ea0b84e61b4a94d33130cbdf89f306fcb0758ee9 100644
--- a/src/MNH/turb_hor_sv_flux.f90
+++ b/src/MNH/turb_hor_sv_flux.f90
@@ -268,9 +268,9 @@ DO JSV=1,ISV
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MXF(ZFLXX), X_LES_SUBGRID_USv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)*MZM(1,IKU,1,ZFLXX))), &
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLXX))), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
- CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MXF(ZFLXX), &
+ CALL LES_MEAN_SUBGRID( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MXF(ZFLXX), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -323,9 +323,9 @@ DO JSV=1,ISV
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MYF(ZFLXY), X_LES_SUBGRID_VSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*MZM(1,IKU,1,ZFLXY))), &
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLXY))), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
- CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MYF(ZFLXY), &
+ CALL LES_MEAN_SUBGRID( GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MYF(ZFLXY), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -340,8 +340,8 @@ DO JSV=1,ISV
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
-DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
-DYF( MYM(PRHODJ) * ZFLXY * PINV_PDYY ) &
- +DZF( 1,IKU,1,PMZM_PRHODJ * PINV_PDZZ * &
- ( MXF( MZM(1,IKU,1,ZFLXX * PINV_PDXX) * PDZX ) + MYF( MZM(1,IKU,1,ZFLXY * PINV_PDYY) * PDZY ) ) &
+ +DZF( PMZM_PRHODJ * PINV_PDZZ * &
+ ( MXF( MZM(ZFLXX * PINV_PDXX) * PDZX ) + MYF( MZM(ZFLXY * PINV_PDYY) * PDZY ) ) &
)
ELSE
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
@@ -352,8 +352,8 @@ DO JSV=1,ISV
IF (.NOT. LFLAT) THEN
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
-DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
- +DZF(1,IKU,1, PMZM_PRHODJ * PINV_PDZZ * &
- ( MXF( MZM(1,IKU,1,ZFLXX * PINV_PDXX) * PDZX ) ) &
+ +DZF( PMZM_PRHODJ * PINV_PDZZ * &
+ ( MXF( MZM(ZFLXX * PINV_PDXX) * PDZX ) ) &
)
ELSE
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
diff --git a/src/MNH/turb_hor_thermo_corr.f90 b/src/MNH/turb_hor_thermo_corr.f90
index ef91a4e90117d841d097131cc45d6f5156c845c2..cf9363d6363524a427c88f79d600b796d1db4b33 100644
--- a/src/MNH/turb_hor_thermo_corr.f90
+++ b/src/MNH/turb_hor_thermo_corr.f90
@@ -194,7 +194,7 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) &
:: ZFLX,ZWORK,ZA
! work arrays
!
-INTEGER :: IKB,IKE,IKU
+INTEGER :: IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
@@ -210,7 +210,6 @@ TYPE(TFIELDDATA) :: TZFIELD
!
IKB = 1+JPVEXT
IKE = SIZE(PTHLM,3)-JPVEXT
-IKU = SIZE(PTHLM,3)
!
!
!
@@ -237,10 +236,10 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
! Computes the horizontal variance <THl THl>
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
- ( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)**2 )
+ ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
ELSE
ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
- GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)**2
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2
END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
@@ -289,7 +288,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
@@ -306,13 +305,13 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= &
PLM(:,:,:) * PLEPS(:,:,:) * &
- (GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- + GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
+ (GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
) * (XCHT1+XCHT2)
ELSE
ZFLX(:,:,:)= &
PLM(:,:,:) * PLEPS(:,:,:) * &
- (GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ (GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
) * (XCHT1+XCHT2)
END IF
@@ -377,7 +376,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_ThlRt, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_ThlRt, .TRUE. )
CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
@@ -393,11 +392,11 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
! Computes the horizontal variance <Rnp Rnp>
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
- ( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
- GY_M_M(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
+ ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
ELSE
ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
- ( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
+ ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
@@ -445,7 +444,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Rt2, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Rt2, .TRUE. )
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS, X_LES_SUBGRID_DISS_Rt2, .TRUE. )
diff --git a/src/MNH/turb_hor_thermo_flux.f90 b/src/MNH/turb_hor_thermo_flux.f90
index 2efa2fb982b6420d0c4b8ee8e2328e386da818f7..bd7d1854aa5dfbaf2171ae889c7d9f38bcc63ed5 100644
--- a/src/MNH/turb_hor_thermo_flux.f90
+++ b/src/MNH/turb_hor_thermo_flux.f90
@@ -265,7 +265,7 @@ ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( SPREAD( PSFTHM(:,:)* PDIRCOSXW(:,:), 3,1) )
IF (.NOT. LFLAT) THEN
PRTHLS(:,:,:) = PRTHLS &
- DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
- + DZF(1,IKU,1, PMZM_PRHODJ *MXF(PDZX*(MZM(1,IKU,1,ZFLX * PINV_PDXX))) * PINV_PDZZ )
+ + DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
ELSE
PRTHLS(:,:,:) = PRTHLS - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX )
END IF
@@ -275,24 +275,24 @@ END IF
IF ( KRRL >= 1 ) THEN
IF (.NOT. LFLAT) THEN
ZFLXC = 2.*( MXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
- +MZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MXF( &
- PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) ) )&
+ +MZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( &
+ PDZX*(MZM( ZFLX*PINV_PDXX )) ) )&
)
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
(- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)
END IF
@@ -331,12 +331,12 @@ END IF
IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UThl )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)*MZM(1,IKU,1,ZFLX))),&
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
- CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX), &
+ CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX), &
X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
@@ -370,7 +370,7 @@ IF (KRR/=0) THEN
IF (.NOT. LFLAT) THEN
PRRS(:,:,:,1) = PRRS(:,:,:,1) &
- DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
- + DZF(1,IKU,1, PMZM_PRHODJ *MXF(PDZX*(MZM(1,IKU,1,ZFLX * PINV_PDXX))) * PINV_PDZZ )
+ + DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
ELSE
PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX )
END IF
@@ -381,24 +381,24 @@ IF (KRR/=0) THEN
IF (.NOT. LFLAT) THEN
ZFLXC = ZFLXC &
+ 2.*( MXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
- +MZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MXF( &
- PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) ) )&
+ +MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( &
+ PDZX*(MZM( ZFLX*PINV_PDXX )) ) )&
)
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM(1,IKU,1, ZFLX*PINV_PDXX )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
*PINV_PDZZ ) &
)
END IF
@@ -434,11 +434,11 @@ IF (KRR/=0) THEN
IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_URt )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)*MZM(1,IKU,1,ZFLX))),&
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
- CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
- CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX),&
X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -518,7 +518,7 @@ IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRTHLS(:,:,:) = PRTHLS &
- DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
- + DZF(1,IKU,1, PMZM_PRHODJ *MYF(PDZY*(MZM(1,IKU,1,ZFLX * PINV_PDYY))) * PINV_PDZZ )
+ + DZF( PMZM_PRHODJ *MYF(PDZY*(MZM(ZFLX * PINV_PDYY))) * PINV_PDZZ )
ELSE
PRTHLS(:,:,:) = PRTHLS - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY )
END IF
@@ -530,24 +530,24 @@ END IF
IF ( KRRL >= 1 .AND. .NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
ZFLXC = 2.*( MYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
- +MZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MYF( &
- PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) ) )&
+ +MZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( &
+ PDZY*(MZM( ZFLX*PINV_PDYY )) ) )&
)
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
*PINV_PDZZ ) &
)*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
(- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
*PINV_PDZZ ) &
)*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
*PINV_PDZZ ) &
)
END IF
@@ -586,12 +586,12 @@ END IF
IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VThl )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*MZM(1,IKU,1,ZFLX))),&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
- CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX),&
+ CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX),&
X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX),&
+ CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX),&
X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
@@ -633,7 +633,7 @@ IF (KRR/=0) THEN
PRRS(:,:,:,1) = PRRS(:,:,:,1) &
- DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
- + DZF(1,IKU,1, PMZM_PRHODJ *MYF(PDZY*(MZM(1,IKU,1,ZFLX * PINV_PDYY))) * PINV_PDZZ )
+ + DZF( PMZM_PRHODJ *MYF(PDZY*(MZM(ZFLX * PINV_PDYY))) * PINV_PDZZ )
ELSE
PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY )
END IF
@@ -645,24 +645,24 @@ IF (KRR/=0) THEN
IF (.NOT. LFLAT) THEN
ZFLXC = ZFLXC &
+ 2.*( MXF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
- + MZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MYF( &
- PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) ) )&
+ + MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( &
+ PDZY*(MZM( ZFLX*PINV_PDYY )) ) )&
)
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
* PINV_PDZZ ) &
)*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
(- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
* PINV_PDZZ ) &
)*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
(- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
- + DZF(1,IKU,1, MZM(1,IKU,1, PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM(1,IKU,1, ZFLX*PINV_PDYY )) )&
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
* PINV_PDZZ ) &
)
END IF
@@ -698,11 +698,11 @@ IF (KRR/=0) THEN
IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VRt )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*MZM(1,IKU,1,ZFLX))),&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
- CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX), &
+ CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX), &
X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
- CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX), &
+ CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX), &
X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
diff --git a/src/MNH/turb_hor_tke.f90 b/src/MNH/turb_hor_tke.f90
index 24ad7f953b77d50852f4e9d0b3a0e0414d0c89a0..ec8e9e2b63953f2eb38ebfad15f72c6837337fab 100644
--- a/src/MNH/turb_hor_tke.f90
+++ b/src/MNH/turb_hor_tke.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 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 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_TURB_HOR_TKE
! ####################
@@ -183,7 +178,7 @@ ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
!
IF (.NOT. LFLAT) THEN
PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
- - DZF(1,IKU,1, PMZM_PRHODJ * MXF( PDZX * MZM(1,IKU,1,ZFLX*PINV_PDXX)) * PINV_PDZZ)&
+ - DZF( PMZM_PRHODJ * MXF( PDZX * MZM(ZFLX*PINV_PDXX)) * PINV_PDZZ)&
) /PRHODJ
ELSE
PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
@@ -230,7 +225,7 @@ IF (.NOT. L2D) THEN
!
IF (.NOT. LFLAT) THEN
PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
- - DZF(1,IKU,1, PMZM_PRHODJ * MYF( PDZY * MZM(1,IKU,1,ZFLX*PINV_PDYY) ) * PINV_PDZZ ) &
+ - DZF( PMZM_PRHODJ * MYF( PDZY * MZM(ZFLX*PINV_PDYY) ) * PINV_PDZZ ) &
) /PRHODJ
ELSE
PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
diff --git a/src/MNH/turb_hor_uv.f90 b/src/MNH/turb_hor_uv.f90
index 9d7e398eeb98a46d5352bab8f30ea7b6d814a0f8..b28ffda5ad18a05276cd57018c5d61e689c165f1 100644
--- a/src/MNH/turb_hor_uv.f90
+++ b/src/MNH/turb_hor_uv.f90
@@ -204,7 +204,7 @@ REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) &
!
REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) ::ZDIRSINZW
! sinus of the angle between the vertical and the normal to the orography
-INTEGER :: IKB,IKE,IKU
+INTEGER :: IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
!
@@ -220,12 +220,11 @@ TYPE(TFIELDDATA) :: TZFIELD
!
IKB = 1+JPVEXT
IKE = SIZE(PUM,3)-JPVEXT
-IKU = SIZE(PUM,3)
!
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
-GX_V_UV_PVM = GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_U_UV_PUM = GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)
+GX_V_UV_PVM = GX_V_UV(PVM,PDXX,PDZZ,PDZX)
+IF (.NOT. L2D) GY_U_UV_PUM = GY_U_UV(PUM,PDYY,PDZZ,PDZY)
!
!
!* 12. < U'V'>
@@ -294,7 +293,7 @@ END IF
IF (.NOT. LFLAT) THEN
PRUS(:,:,:) = PRUS(:,:,:) &
- DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) ) &
- + DZF(1,IKU,1, MYF( MZM(1,IKU,1,ZFLX)*MXM(PDZY/MZM(1,IKU,1,PDYY))) &
+ + DZF( MYF( MZM(ZFLX)*MXM(PDZY/MZM(PDYY))) &
* MXM(PMZM_PRHODJ * PINV_PDZZ) )
ELSE
PRUS(:,:,:) = PRUS(:,:,:) - DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) )
@@ -304,7 +303,7 @@ END IF
IF (.NOT. LFLAT) THEN
PRVS(:,:,:) = PRVS(:,:,:) &
- DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) ) &
- + DZF(1,IKU,1, MXF( MZM(1,IKU,1,ZFLX)*MYM(PDZX/MZM(1,IKU,1,PDXX))) &
+ + DZF( MXF( MZM(ZFLX)*MYM(PDZX/MZM(PDXX))) &
* MYM(PMZM_PRHODJ * PINV_PDZZ) )
ELSE
PRVS(:,:,:) = PRVS(:,:,:) - DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) )
@@ -350,8 +349,8 @@ END IF
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
- CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
- CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/turb_hor_uw.f90 b/src/MNH/turb_hor_uw.f90
index 07f6c7cdbd2beafb7ce77d13c178eb9594361b5a..6928baca32b84536ba336131f42dbd095444e6ef 100644
--- a/src/MNH/turb_hor_uw.f90
+++ b/src/MNH/turb_hor_uw.f90
@@ -202,7 +202,7 @@ IKE = SIZE(PWM,3)-JPVEXT
IKU = SIZE(PWM,3)
!
!
-GX_W_UW_PWM = GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)
+GX_W_UW_PWM = GX_W_UW(PWM,PDXX,PDZZ,PDZX)
!
!
!* 13. < U'W'>
@@ -211,7 +211,7 @@ GX_W_UW_PWM = GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)
! residual part of < U'W'> depending on dw/dx
!
ZFLX(:,:,:) = &
- - XCMFS * MXM(MZM(1,IKU,1,PK)) * GX_W_UW_PWM
+ - XCMFS * MXM(MZM(PK)) * GX_W_UW_PWM
!! & to be tested
!! - (2./3.) * XCMFB * MZM( ZVPTU * MXM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
!
@@ -240,23 +240,23 @@ END IF
!
! compute the source for rho*U due to this residual flux ( the other part is
! taken into account in TURB_VER)
-PRUS(:,:,:) = PRUS(:,:,:) - DZF(1,IKU,1, ZFLX* MXM( PMZM_PRHODJ ) / MXM( PDZZ ) )
+PRUS(:,:,:) = PRUS(:,:,:) - DZF( ZFLX* MXM( PMZM_PRHODJ ) / MXM( PDZZ ) )
!
!computation of the source for rho*W due to this flux
IF (.NOT. LFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(1,IKU,1, MXM(PRHODJ) * PINV_PDXX) * ZFLX) &
- +DZM(1,IKU,1, PRHODJ * MXF( MZF(1,IKU,1, ZFLX*PDZX ) * PINV_PDXX ) / MZF(1,IKU,1,PDZZ) )
+ -DXF( MZM( MXM(PRHODJ) * PINV_PDXX) * ZFLX) &
+ +DZM( PRHODJ * MXF( MZF( ZFLX*PDZX ) * PINV_PDXX ) / MZF(PDZZ) )
ELSE
- PRWS(:,:,:) = PRWS(:,:,:) -DXF( MZM(1,IKU,1, MXM(PRHODJ) * PINV_PDXX) * ZFLX)
+ PRWS(:,:,:) = PRWS(:,:,:) -DXF( MZM( MXM(PRHODJ) * PINV_PDXX) * ZFLX)
END IF
!
IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
- ZWORK(:,:,:) =-MZF(1,IKU,1, MXF( &
- ZFLX *( GZ_U_UW(1,IKU,1,PUM,PDZZ) + GX_W_UW_PWM ) ) )
+ ZWORK(:,:,:) =-MZF( MXF( &
+ ZFLX *( GZ_U_UW(PUM,PDZZ) + GX_W_UW_PWM ) ) )
!
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
@@ -282,17 +282,17 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GZ_U_UW(1,IKU,1,PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MZF(1,IKU,1,ZFLX)),&
+ CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MZF(ZFLX)),&
X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MZF(1,IKU,1,ZFLX)), &
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
END IF
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MZF(1,IKU,1,ZFLX)), &
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
END DO
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/turb_hor_vw.f90 b/src/MNH/turb_hor_vw.f90
index 87031f8b23da785f77227e0118c4427c7fc8203b..eb1de6d6f538c67a22ef4c547ea80a9a5c622d69 100644
--- a/src/MNH/turb_hor_vw.f90
+++ b/src/MNH/turb_hor_vw.f90
@@ -197,7 +197,7 @@ IKE = SIZE(PWM,3)-JPVEXT
IKU = SIZE(PWM,3)
!
!
-IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)
+IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(PWM,PDYY,PDZZ,PDZY)
!
!
!* 14. < V'W'>
@@ -207,7 +207,7 @@ IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)
!
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = &
- - XCMFS * MYM(MZM(1,IKU,1,PK)) * GY_W_VW_PWM
+ - XCMFS * MYM(MZM(PK)) * GY_W_VW_PWM
!! & to be tested
!! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
ELSE
@@ -242,16 +242,16 @@ END IF
! compute the source for rho*V due to this residual flux ( the other part is
! taken into account in TURB_VER)
IF (.NOT. L2D) &
-PRVS(:,:,:) = PRVS(:,:,:) - DZF(1,IKU,1, ZFLX* MYM( PMZM_PRHODJ ) / MYM ( PDZZ ) )
+PRVS(:,:,:) = PRVS(:,:,:) - DZF( ZFLX* MYM( PMZM_PRHODJ ) / MYM ( PDZZ ) )
!
!computation of the source for rho*W due to this flux
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(1,IKU,1, MYM(PRHODJ) * PINV_PDYY) * ZFLX) &
- +DZM(1,IKU,1, PRHODJ * MYF( MZF(1,IKU,1, ZFLX*PDZY ) * PINV_PDYY ) / MZF(1,IKU,1,PDZZ) )
+ -DYF( MZM( MYM(PRHODJ) * PINV_PDYY) * ZFLX) &
+ +DZM( PRHODJ * MYF( MZF( ZFLX*PDZY ) * PINV_PDYY ) / MZF(PDZZ) )
ELSE
- PRWS(:,:,:) = PRWS(:,:,:) - DYF( MZM(1,IKU,1, MYM(PRHODJ) * PINV_PDYY) * ZFLX)
+ PRWS(:,:,:) = PRWS(:,:,:) - DYF( MZM( MYM(PRHODJ) * PINV_PDYY) * ZFLX)
END IF
END IF
!
@@ -260,7 +260,7 @@ IF (KSPLT==1) THEN
!Contribution to the dynamic production of TKE:
!
IF (.NOT. L2D) THEN
- ZWORK(:,:,:) =-MZF(1,IKU,1, MYF( ZFLX *( GZ_V_VW(1,IKU,1,PVM,PDZZ) + GY_W_VW_PWM ) ) )
+ ZWORK(:,:,:) =-MZF( MYF( ZFLX *( GZ_V_VW(PVM,PDZZ) + GY_W_VW_PWM ) ) )
!
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
@@ -287,19 +287,19 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(ZFLX)), X_LES_SUBGRID_WV , .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GZ_V_VW(1,IKU,1,PVM,PDZZ)*ZFLX)),&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLX)), X_LES_SUBGRID_WV , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*ZFLX)),&
X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*ZFLX)),&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*ZFLX)),&
X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)),&
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(ZFLX)),&
X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)), &
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
END IF
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)), &
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
END DO
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index de1cf6c4c1abd2b7864b008a415fc54ca5cc7880..37b7bcfd9f135dce15593afefb79f6af73c85268 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -225,13 +225,7 @@ END MODULE MODI_TURB_VER
!! field to be derivated
!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
!! of a variable located at a mass point
!!
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 6371555afdd737b51d3b70a3addb66b12bd59431..96b5b1f48b85f31796d469abc4ceff58609b99be 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -428,7 +428,7 @@ ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
-ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
!
ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
@@ -444,7 +444,7 @@ ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
! Preparation of the arguments for TRIDIAG_WIND
!
ZA(:,:,:) = -PTSTEP * XCMFS * &
- MXM( ZKEFF ) * MXM(MZM(KKA,KKU,KKL, PRHODJ )) / &
+ MXM( ZKEFF ) * MXM(MZM( PRHODJ )) / &
MXM( PDZZ )**2
!
!
@@ -498,7 +498,7 @@ PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
! vertical flux of the U wind component
!
ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
- DZM (KKA,KKU,KKL,PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
+ DZM (PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
!
! surface flux
ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
@@ -531,7 +531,7 @@ PWU(:,:,:) = ZFLXZ(:,:,:)
! Contribution to the dynamic production of TKE
! compute the dynamic production at the mass point
!
-PDP(:,:,:) = - MZF(KKA,KKU,KKL, MXF ( ZFLXZ * GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) ) )
+PDP(:,:,:) = - MZF( MXF ( ZFLXZ * GZ_U_UW(PUM,PDZZ) ) )
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
PDP(:,:,IKB:IKB) = - MXF ( &
@@ -543,8 +543,8 @@ PDP(:,:,IKB:IKB) = - MXF (
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(ZFLXZ)), X_LES_SUBGRID_WU )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) &
+ CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLXZ)), X_LES_SUBGRID_WU )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ) &
& *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
CALL SECOND_MNH(ZTIME2)
@@ -561,17 +561,17 @@ IF(HTURBDIM=='3DIM') THEN
!
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS &
- -DXF( MZM(KKA,KKU,KKL, MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
- +DZM(KKA,KKU,KKL, PRHODJ / MZF(KKA,KKU,KKL,PDZZ ) * &
- MXF( MZF(KKA,KKU,KKL, ZFLXZ*PDZX ) / PDXX ) &
+ -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
+ +DZM( PRHODJ / MZF(PDZZ ) * &
+ MXF( MZF( ZFLXZ*PDZX ) / PDXX ) &
)
ELSE
- PRWS(:,:,:)= PRWS -DXF( MZM(KKA,KKU,KKL, MXM(PRHODJ) /PDXX ) * ZFLXZ )
+ PRWS(:,:,:)= PRWS -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ )
END IF
!
! Complete the Dynamical production with the W wind component
!
- ZA(:,:,:)=-MZF(KKA,KKU,KKL, MXF ( ZFLXZ * GX_W_UW(KKA,KKU,KKL, PWM,PDXX,PDZZ,PDZX) ) )
+ ZA(:,:,:)=-MZF( MXF ( ZFLXZ * GX_W_UW( PWM,PDXX,PDZZ,PDZX) ) )
!
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
@@ -593,17 +593,17 @@ IF(HTURBDIM=='3DIM') THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(GX_W_UW(KKA,KKU,KKL,PWM,PDXX,&
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,&
PDZZ,PDZX)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW )
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
- * MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
+ * MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MXF(GX_U_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
- *MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
+ CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
+ *MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
END IF
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( MXF(GX_U_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,&
- PDZX)*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MXF(GX_U_M(PSVM(:,:,:,JSV),PDXX,PDZZ,&
+ PDZX)*MZF(ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -621,7 +621,7 @@ END IF
! Preparation of the arguments for TRIDIAG_WIND
!!
ZA(:,:,:) = - PTSTEP * XCMFS * &
- MYM( ZKEFF ) * MYM(MZM(KKA,KKU,KKL, PRHODJ )) / &
+ MYM( ZKEFF ) * MYM(MZM( PRHODJ )) / &
MYM( PDZZ )**2
!
!
@@ -673,7 +673,7 @@ PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
! vertical flux of the V wind component
!
ZFLXZ(:,:,:) = -XCMFS * MYM(ZKEFF) * &
- DZM(KKA,KKU,KKL, PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
+ DZM( PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
!
ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
( ZSOURCE(:,:,IKB:IKB) &
@@ -705,7 +705,7 @@ PWV(:,:,:) = ZFLXZ(:,:,:)
! Contribution to the dynamic production of TKE
! compute the dynamic production contribution at the mass point
!
-ZA(:,:,:) = - MZF(KKA,KKU,KKL, MYF ( ZFLXZ * GZ_V_VW(KKA,KKU,KKL,PVM,PDZZ) ) )
+ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GZ_V_VW(PVM,PDZZ) ) )
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
ZA(:,:,IKB:IKB) = &
@@ -720,8 +720,8 @@ PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(ZFLXZ)), X_LES_SUBGRID_WV )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(GZ_V_VW(KKA,KKU,KKL,PVM,PDZZ)*&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLXZ)), X_LES_SUBGRID_WV )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*&
& ZFLXZ)), X_LES_RES_ddxa_V_SBG_UaV )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -737,18 +737,18 @@ IF(HTURBDIM=='3DIM') THEN
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS(:,:,:) &
- -DYF( MZM(KKA,KKU,KKL, MYM(PRHODJ) /PDYY ) * ZFLXZ ) &
- +DZM(KKA,KKU,KKL, PRHODJ / MZF(KKA,KKU,KKL,PDZZ ) * &
- MYF( MZF(KKA,KKU,KKL, ZFLXZ*PDZY ) / PDYY ) &
+ -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ ) &
+ +DZM( PRHODJ / MZF(PDZZ ) * &
+ MYF( MZF( ZFLXZ*PDZY ) / PDYY ) &
)
ELSE
- PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM(KKA,KKU,KKL, MYM(PRHODJ) /PDYY ) * ZFLXZ )
+ PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ )
END IF
END IF
!
! Complete the Dynamical production with the W wind component
IF (.NOT. L2D) THEN
- ZA(:,:,:) = - MZF(KKA,KKU,KKL, MYF ( ZFLXZ * GY_W_VW(KKA,KKU,KKL, PWM,PDYY,PDZZ,PDZY) ) )
+ ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GY_W_VW( PWM,PDYY,PDZZ,PDZY) ) )
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
ZA(:,:,IKB:IKB) = - MYF ( &
@@ -771,13 +771,13 @@ IF(HTURBDIM=='3DIM') THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(GY_W_VW(KKA,KKU,KKL,PWM,PDYY,&
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,&
PDZZ,PDZY)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
CALL LES_MEAN_SUBGRID( MYF(GY_M_V(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)&
- *MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
+ *MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MYF(GY_V_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,&
- PDZY)*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
+ PDZY)*MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -793,7 +793,7 @@ END IF
!
IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. HTURBDIM == '1DIM') THEN
ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
- -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)
+ -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ)
! to be tested &
! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
! stores the W variance
diff --git a/src/MNH/turb_ver_sv_corr.f90 b/src/MNH/turb_ver_sv_corr.f90
index 280f94392d43526a27e3d6a529fcad99f815da36..b62268e7e82a28d876844fb7abbbcaa02f3e87d0 100644
--- a/src/MNH/turb_ver_sv_corr.f90
+++ b/src/MNH/turb_ver_sv_corr.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 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 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 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_TURB_VER_SV_CORR
! ####################
@@ -191,9 +186,9 @@ DO JSV=1,NSV
IF (LLES_CALL) THEN
! approximation: diagnosed explicitely (without implicit term)
ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)**2
- ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(KKA,KKU,KKL,ZFLXZ(:,:,:) )
+ ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:) )
CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
END IF
!
! covariance ThvSv
@@ -204,7 +199,7 @@ DO JSV=1,NSV
ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
* GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ) &
* GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(KKA,KKU,KKL,ZFLXZ)
+ ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
!
@@ -213,7 +208,7 @@ DO JSV=1,NSV
ZFLXZ(:,:,:)= ( XCHF * PPSI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
* GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ) &
* GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(KKA,KKU,KKL,ZFLXZ)
+ ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
END IF
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index 356cf67001e980360b50ae038cc3e4be6b892216..ed660517d50265bf29be78168517612611e9cdf1 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -377,7 +377,7 @@ IKTB =1+JPVEXT_TURB
!
ISV=SIZE(PSVM,4)
!
-ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
!
IF(LBLOWSNOW) THEN
! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
@@ -396,7 +396,7 @@ DO JSV=1,ISV
!
! Preparation of the arguments for TRIDIAG
ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
- ZKEFF * MZM(KKA,KKU,KKL,PRHODJ) / &
+ ZKEFF * MZM(PRHODJ) / &
PDZZ**2
ZSOURCE(:,:,:) = 0.
!
@@ -431,8 +431,8 @@ DO JSV=1,ISV
IF ( (OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL ) THEN
! Diagnostic of the cartesian vertical flux
!
- ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(KKA,KKU,KKL,PLM*SQRT(PTKEM)) / PDZZ * &
- DZM(KKA,KKU,KKL, PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV) )
+ ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM)) / PDZZ * &
+ DZM( PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV) )
! surface flux
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
! (in presence of slopes)
@@ -476,13 +476,13 @@ DO JSV=1,ISV
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)*MZF(KKA,KKU,KKL,ZFLXZ), &
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ), &
+ CALL LES_MEAN_SUBGRID( MZF(GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( -ZCSVP*SQRT(PTKEM)/PLM*MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM*ZFLXZ), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( -ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/turb_ver_thermo_corr.f90 b/src/MNH/turb_ver_thermo_corr.f90
index 7bcc6799f340016483d8ab7550c05a0cb2699348..44502079481db439d5b06edcd31ce7b00deb0826 100644
--- a/src/MNH/turb_ver_thermo_corr.f90
+++ b/src/MNH/turb_ver_thermo_corr.f90
@@ -467,7 +467,7 @@ ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2*KKL)+2.*PDZZ(:,:,IKB+KKL)) / &
( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+KKL) )
!
-ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
!
! Flags for 3rd order quantities
!
@@ -494,49 +494,49 @@ END IF
!* 4.2 <THl THl>
!
! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,PPHI3*PDTH_DZ**2)
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPHI3*PDTH_DZ**2)
ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
!
! Effect of 3rd order terms in temperature flux (at mass point)
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,&
+ ZF = ZF + M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,&
& PSQRT_TKE) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTH_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,GUSERV) * MZF(KKA,KKU,KKL,PFWTH)
+ ZF = ZF + M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTH_DZ,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWTH)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWTH)
END IF
!
IF (KRR/=0) THEN
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
+ ZF = ZF + M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
& PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
- & PEMOIST,PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
+ ZF = ZF + M3_TH2_W2R(PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ) * MZF(PFWR)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(PFWR)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- ZF = ZF + M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ ZF = ZF + M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
END IF
@@ -544,9 +544,9 @@ END IF
!
ZFLXZ(:,:,:) = ZF &
! + PIMPL * XCTV*PLM*PLEPS &
- ! *MZF(KKA,KKU,KKL,D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
- ! *DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ ) &
- + PIMPL * ZDFDDTDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ )
+ ! *MZF(D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
+ ! *DZM(PTHLP - PTHLM) / PDZZ ) &
+ + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM) / PDZZ )
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = XCTV * PPHI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
@@ -590,7 +590,7 @@ END IF
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Thl2 )
CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_ThlThv )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
@@ -604,7 +604,7 @@ END IF
!
!
! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
!
@@ -612,65 +612,65 @@ END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ ZF = ZF + M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKEM,&
- & PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA) * MZF(KKA,KKU,KKL,PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWTH)
+ ZF = ZF + M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKEM,&
+ & PDR_DZ) * MZF(PFWTH)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA) * MZF(PFWTH)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM) * MZF(PFWTH)
END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,&
+ ZF = ZF + M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKEM,&
- & PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(KKA,KKU,KKL,PFWR)
+ ZF = ZF + M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKEM,&
+ & PDTH_DZ) * MZF(PFWR)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(PFWR)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- ZF = ZF + M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,&
+ ZF = ZF + M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,&
& PSQRT_TKE) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFTHR
END IF
!
ZFLXZ(:,:,:) = ZF &
+ PIMPL * XCTV*PLM*PLEPS*0.5 &
- * MZF(KKA,KKU,KKL, ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
+ * MZF( ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
+D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*dthdz)/ddthdz term
- ) *PDR_DZ *DZM(KKA,KKU,KKL,PTHLP - PTHLM ) / PDZZ &
+ ) *PDR_DZ *DZM(PTHLP - PTHLM ) / PDZZ &
+( D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*drdz )/ddrdz term
+D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*drdz )/ddrdz term
- ) *PDTH_DZ *DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ &
+ ) *PDTH_DZ *DZM(PRP - PRM(:,:,:,1)) / PDZZ &
) &
- + PIMPL * ZDFDDTDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PTHLP - PTHLM(:,:,:)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ )
+ + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM(:,:,:)) / PDZZ ) &
+ + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = &
@@ -717,7 +717,7 @@ END IF
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_ThlRt )
CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_RtThv )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
@@ -732,49 +732,49 @@ END IF
!
!
! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,PPSI3*PDR_DZ**2)
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPSI3*PDR_DZ**2)
ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
!
! Effect of 3rd order terms in temperature flux (at mass point)
!
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,&
+ ZF = ZF + M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,&
& PSQRT_TKE) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDR_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(KKA,KKU,KKL,PFWR)
+ ZF = ZF + M3_R2_W2R(PREDR1,PREDTH1,PD,PDR_DZ,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWR)
END IF
!
IF (KRR/=0) THEN
! d(w'r'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,&
+ ZF = ZF + M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(PREDR1,&
& PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
END IF
!
! d(w'2r')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,&
- & PBLL_O_E,PETHETA,PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
+ ZF = ZF + M3_R2_W2TH(PD,PLM,PLEPS,PTKEM,&
+ & PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- ZF = ZF + M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,&
+ ZF = ZF + M3_R2_WTHR(PREDTH1,PD,PLEPS,&
& PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
END IF
@@ -782,9 +782,9 @@ END IF
!
ZFLXZ(:,:,:) = ZF &
+ PIMPL * XCTV*PLM*PLEPS &
- *MZF(KKA,KKU,KKL,D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
- *DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ )
+ *MZF(D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
+ *DZM(PRP - PRM(:,:,:,1)) / PDZZ ) &
+ + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
@@ -824,7 +824,7 @@ END IF
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_RtThv , .TRUE. )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Rt2 )
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 2e01a94afd4b1cc8602f9764a5eef2df521260bb..25c9d06f4aff387a740da65634569d1ddaf5bb3b 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -488,7 +488,7 @@ GUSERV = (KRR/=0)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
-ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
!
! Flags for 3rd order quantities
!
@@ -515,7 +515,7 @@ END IF
!
! Compute the turbulent flux F and F' at time t-dt.
!
-ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(KKA,KKU,KKL,PTHLM)/PDZZ
+ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
!
@@ -523,10 +523,10 @@ ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,
!
! d(w'2th')/dz
IF (GFWTH) THEN
- Z3RDMOMENT= M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
+ Z3RDMOMENT= M3_WTH_W2TH(PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
!
ZF = ZF + Z3RDMOMENT * PFWTH
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
END IF
!
@@ -534,35 +534,35 @@ END IF
IF (GFTH2) THEN
Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
!
- ZF = ZF + Z3RDMOMENT * MZM(KKA,KKU,KKL,PFTH2)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTH2)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA) * MZM(KKA,KKU,KKL,PFTH2)
+ & PD,PBLL_O_E,PETHETA) * MZM(PFTH2)
END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,&
+ ZF = ZF + M3_WTH_W2R(PD,ZKEFF,&
& PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(KKA,KKU,KKL,PFR2)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
- & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(KKA,KKU,KKL,PFR2)
+ ZF = ZF + M3_WTH_WR2(PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ Z3RDMOMENT= M3_WTH_WTHR(PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
& PLEPS,PEMOIST)
!
- ZF = ZF + Z3RDMOMENT * MZM(KKA,KKU,KKL,PFTHR)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
- & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(KKA,KKU,KKL,PFTHR)
+ & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR)
END IF
!
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
@@ -593,7 +593,7 @@ PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
! Conservative potential temperature flux :
!
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDTDZ * DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ
+ + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM) / PDZZ
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
@@ -622,16 +622,16 @@ END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PETHETA) * ZFLXZ )
+ PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
ELSE
- PTP(:,:,:)= PBETA * MZF(KKA,KKU,KKL, ZFLXZ )
+ PTP(:,:,:)= PBETA * MZF( ZFLXZ )
END IF
!
! Buoyancy flux at flux points
!
-PWTHV = MZM(KKA,KKU,KKL,PETHETA) * ZFLXZ
+PWTHV = MZM(PETHETA) * ZFLXZ
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
!
!* 2.3 Partial vertical divergence of the < Rc w > flux
@@ -639,14 +639,14 @@ PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ )
+ DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ )
END IF
END IF
!
@@ -654,22 +654,22 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WThl )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
- CALL LES_MEAN_SUBGRID( GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)*MZF(KKA,KKU,KKL,ZFLXZ),&
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WThl )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
& X_LES_RES_ddxa_W_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_ThlPz )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MZM(KKA,KKU,KKL,PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
+ CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
+ CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
END IF
!* diagnostic of mixing coefficient for heat
- ZA = DZM(KKA,KKU,KKL,PTHLP)
+ ZA = DZM(PTHLP)
WHERE (ZA==0.) ZA=1.E-6
ZA = - ZFLXZ / ZA * PDZZ
ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
- ZA = MZF(KKA,KKU,KKL, ZA )
+ ZA = MZF( ZA )
ZA = MIN(MAX(ZA,-1000.),1000.)
CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
!
@@ -694,17 +694,17 @@ IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
IF (KRR /= 0) THEN
! Compute the turbulent flux F and F' at time t-dt.
!
- ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(KKA,KKU,KKL,PRM(:,:,:,1))/PDZZ
+ ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1))/PDZZ
ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2r')/dz
IF (GFWR) THEN
- Z3RDMOMENT= M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
+ Z3RDMOMENT= M3_WR_W2R(PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
!
ZF = ZF + Z3RDMOMENT * PFWR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
& PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
END IF
!
@@ -712,35 +712,35 @@ IF (KRR /= 0) THEN
IF (GFR2) THEN
Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
- ZF = ZF + Z3RDMOMENT * MZM(KKA,KKU,KKL,PFR2)
+ ZF = ZF + Z3RDMOMENT * MZM(PFR2)
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(KKA,KKU,KKL,PFR2)
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2)
END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,&
+ ZF = ZF + M3_WR_W2TH(PD,ZKEFF,&
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(KKA,KKU,KKL,PFTH2)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
- &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(KKA,KKU,KKL,PFTH2)
+ ZF = ZF + M3_WR_WTH2(PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ Z3RDMOMENT= M3_WR_WTHR(PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
& PLEPS,PETHETA)
!
- ZF = ZF + Z3RDMOMENT * MZM(KKA,KKU,KKL,PFTHR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,Z3RDMOMENT,PREDR1, &
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(KKA,KKU,KKL,PFTHR)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(Z3RDMOMENT,PREDR1, &
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
END IF
!
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
@@ -771,7 +771,7 @@ IF (KRR /= 0) THEN
! cons. mixing ratio flux :
!
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ
+ + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
@@ -799,14 +799,14 @@ IF (KRR /= 0) THEN
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
- ZA(:,:,:) = PBETA * MZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PEMOIST) * ZFLXZ )
+ ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
!
! Buoyancy flux at flux points
!
- PWTHV = PWTHV + MZM(KKA,KKU,KKL,PEMOIST) * ZFLXZ
+ PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
@@ -814,14 +814,14 @@ IF (KRR /= 0) THEN
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ )
+ DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ )
END IF
END IF
!
@@ -829,14 +829,14 @@ IF (KRR /= 0) THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WRt )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
- CALL LES_MEAN_SUBGRID( GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)*MZF(KKA,KKU,KKL,ZFLXZ),&
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRt )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
& X_LES_RES_ddxa_W_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MZM(KKA,KKU,KKL,PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_RtPz )
+ CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID( MZF(MZM(PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_RtPz )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -855,14 +855,14 @@ END IF
IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
! recover the Conservative potential temperature flux :
- ZA(:,:,:) = DZM(KKA,KKU,KKL,PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
- (-PPHI3*MZM(KKA,KKU,KKL,PLM*PSQRT_TKE)) * XCSHF
+ ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
+ (-PPHI3*MZM(PLM*PSQRT_TKE)) * XCSHF
ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
* PDIRCOSZW(:,:)
!
! compute <w Rc>
- ZFLXZ(:,:,:) = MZM(KKA,KKU,KKL, PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
- MZM(KKA,KKU,KKL, PATHETA * 2.* PSRCM ) * ZA(:,:,:)
+ ZFLXZ(:,:,:) = MZM( PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
+ MZM( PATHETA * 2.* PSRCM ) * ZA(:,:,:)
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
! store the liquid water mixing ratio vertical flux
@@ -884,7 +884,7 @@ IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WRc )
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRc )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/two_wayn.f90 b/src/MNH/two_wayn.f90
index 52a22f8d530b86603579bc88ea8c555f242ced5c..5b361e3f9b57f7960993ed78924b5bab83fc2107 100644
--- a/src/MNH/two_wayn.f90
+++ b/src/MNH/two_wayn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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.
@@ -1286,7 +1286,7 @@ ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB) = 2.*ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB)
ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) = ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) &
+ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB:IKU-1)
!
-ZAVE_RHODJ=MZM(1,IKU,1,PRHODJ)
+ZAVE_RHODJ=MZM(PRHODJ)
PRWS(IXOR:IXEND,IYOR:IYEND,:) = PRWS(IXOR:IXEND,IYOR:IYEND,:) &
- ZK2W * ZAVE_RHODJ(IXOR:IXEND,IYOR:IYEND,:) * ( PWM(IXOR:IXEND,IYOR:IYEND,:) &
-ZWM(IXOR:IXEND,IYOR:IYEND,:)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index 49b6ef42936c3747e2784377d34bee9ae7ee0850..925c2225b66e5466ba7fc21484e247670678eb61 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -80,7 +80,7 @@ END MODULE MODI_VER_DYN
!! subroutine VER_INT_DYN : to initialize the horizontal momentum
!! subroutine WGUESS : to initialize vertical momentum
!! subroutine ANEL_BALANCE1 : to apply the anelastic correction
-!! functions MXM ,MYM ,MZM : Shuman operators
+!! functions MXM, MYM : Shuman operators
!!
!!
!! IMPLICIT ARGUMENTS
diff --git a/src/MNH/ver_int_dyn.f90 b/src/MNH/ver_int_dyn.f90
index 1065cdc10a890b91b3cdee4f2164fc58bcc768b4..912522f9835bd6d86bd2020c7baaa1a92d5c2eae 100644
--- a/src/MNH/ver_int_dyn.f90
+++ b/src/MNH/ver_int_dyn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -186,7 +186,7 @@ ZRHODV_SH(:,:,1) = ZRHODV_SH(:,:,2)
!* 3.1 Altitude of the mass points on the MESO-NH grid
! -----------------------------------------------
!
-ZZMASS(:,:,:)=MZF(1,IKU,1,XZZ(:,:,:))
+ZZMASS(:,:,:)=MZF(XZZ(:,:,:))
ZZMASS(:,:,SIZE(XZZ,3))=1.5*XZZ(:,:,SIZE(XZZ,3))-0.5*XZZ(:,:,SIZE(XZZ,3)-1)
!
!* 3.2 Interpolation on the MESO-NH grid
diff --git a/src/MNH/ver_int_thermo.f90 b/src/MNH/ver_int_thermo.f90
index caace8ad5fa37979d8840f7c279c6c98bf95ce92..1d3424a943e422cf37b2ec52dd4651470c25a108 100644
--- a/src/MNH/ver_int_thermo.f90
+++ b/src/MNH/ver_int_thermo.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -198,7 +198,7 @@ REAL,DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PLSRVM ! Large scale vapor
! ------------------------------
!
INTEGER ::ILUOUT0, IRESP
-INTEGER ::IKB,IKE,IIB,IIE,IJB,IJE,IKU
+INTEGER ::IKB,IKE,IIB,IIE,IJB,IJE
INTEGER, DIMENSION(2) ::IIJ
INTEGER :: IK4000
INTEGER ::JK
@@ -270,7 +270,6 @@ ILUOUT0 = TLUOUT0%NLU
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=JPVEXT+1
IKE=SIZE(XZZ,3)-JPVEXT
-IKU=SIZE(XZZ,3)
!
!
!-------------------------------------------------------------------------------
@@ -515,7 +514,7 @@ PDIAG = ZTIME2 - ZTIME1
!
!20140217 upgrade shuman fct MZF
!$ZZMASS(:,:,:)=MZF(XZZ(:,:,:))
-ZZMASS(:,:,:)=MZF(1,IKU,1,XZZ(:,:,:))
+ZZMASS(:,:,:)=MZF(XZZ(:,:,:))
!20131113 check
CALL MPPDB_CHECK3D(ZZMASS,"ver_int_thermo6::ZZMASS",PRECISION)
ZZMASS(:,:,SIZE(XZZ,3))=1.5*XZZ(:,:,SIZE(XZZ,3))-0.5*XZZ(:,:,SIZE(XZZ,3)-1)
diff --git a/src/MNH/ver_interp_field.f90 b/src/MNH/ver_interp_field.f90
index 1eb52591ae889b6f813b5238972b3f79384bb79f..e380b7da0d431d133a1decd4e6ace07786cf7887 100644
--- a/src/MNH/ver_interp_field.f90
+++ b/src/MNH/ver_interp_field.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 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.
@@ -157,9 +157,9 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
! -----------
!
!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(1,IKU,1,PZZ_LS(:,:,:))
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(1,IKU,1,PZZ(:,:,:))
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
!* move the first physical level if above the target grid
ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
@@ -199,9 +199,9 @@ CALL MPPDB_CHECK3D(PUT,"VERINTERPFIELD:PUT",PRECISION)
! -----------
!
!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(1,IKU,1,PZZ_LS(:,:,:))
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(1,IKU,1,PZZ(:,:,:))
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
!* move the first physical level if above the target grid
ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
@@ -246,9 +246,9 @@ PLSWM (:,:,:) = VER_INTERP_LIN(PLSWM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
! -------------------------
!
!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(1,IKU,1,PZZ_LS(:,:,:))
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(1,IKU,1,PZZ(:,:,:))
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
!
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
@@ -292,9 +292,9 @@ END DO
! ------------
!
!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(1,IKU,1,PZZ_LS(:,:,:))
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(1,IKU,1,PZZ(:,:,:))
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
!* move the first physical level if above the target grid
ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
diff --git a/src/MNH/ver_interp_to_mixed_grid.f90 b/src/MNH/ver_interp_to_mixed_grid.f90
index 1b2d4d6a0fb5905bb397b94dfcec75e811a99c00..94b161a5d4989fd24bcc8dc2305436acfc304d03 100644
--- a/src/MNH/ver_interp_to_mixed_grid.f90
+++ b/src/MNH/ver_interp_to_mixed_grid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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.
@@ -290,13 +290,13 @@ IF (HFILE=='ATM ') THEN
ALLOCATE(XZFLUX_MX(IIU,IJU,IKU))
ALLOCATE(XZMASS_MX(IIU,IJU,IKU))
CALL VERT_COORD(LSLEVE,PZS_LS,PZSMT_LS,XLEN1,XLEN2,XZHAT,XZFLUX_MX)
- XZMASS_MX(:,:,:)=MZF(1,IKU,1,XZFLUX_MX)
+ XZMASS_MX(:,:,:)=MZF(XZFLUX_MX)
XZMASS_MX(:,:,IKU)=1.5*XZFLUX_MX(:,:,IKU)-0.5*XZFLUX_MX(:,:,IKU-1)
ELSE IF (HFILE=='CHEM') THEN
ALLOCATE(ZZFLUX_MX(IIU,IJU,IKU))
ALLOCATE(ZZMASS_MX(IIU,IJU,IKU))
CALL VERT_COORD(LSLEVE,PZS_LS,PZSMT_LS,XLEN1,XLEN2,XZHAT,ZZFLUX_MX)
- ZZMASS_MX(:,:,:)=MZF(1,IKU,1,ZZFLUX_MX)
+ ZZMASS_MX(:,:,:)=MZF(ZZFLUX_MX)
ZZMASS_MX(:,:,IKU)=1.5*ZZFLUX_MX(:,:,IKU)-0.5*ZZFLUX_MX(:,:,IKU-1)
END IF
!
diff --git a/src/MNH/ver_prep_mesonh_case.f90 b/src/MNH/ver_prep_mesonh_case.f90
index 15ea1cc313fc52f699651a95190f5dab63a50c35..e50abec0ec100cf2792eddd685cd647ba7943322 100644
--- a/src/MNH/ver_prep_mesonh_case.f90
+++ b/src/MNH/ver_prep_mesonh_case.f90
@@ -169,7 +169,7 @@ CALL VERT_COORD(LSLEVE_LS,XZS_LS,XZSMT_LS,XLEN1_LS,XLEN2_LS,XZHAT_LS,XZFLUX_LS)
!
!20140217 upgrade MZF
!$XZMASS_LS(:,:,:)=MZF(XZFLUX_LS(:,:,:))
-XZMASS_LS(:,:,:)=MZF(1,ILU,1,XZFLUX_LS(:,:,:))
+XZMASS_LS(:,:,:)=MZF(XZFLUX_LS(:,:,:))
!20131112 add update_halo for this type of calculation
CALL MPPDB_CHECK3D(XZMASS_LS,"ver_prep_mesonh_case1.2a::XZMASS_LS",PRECISION)
CALL ADD3DFIELD_ll( TZFIELDS_ll, XZMASS_LS, 'VER_PREP_MESONH_CASE::XZMASS_LS' )
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index e4c5d3ac5eea7f6bbdc7af3a2feabff8e757dcba..711824444a53790ce8fd53934b8edf633a011d16 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -304,7 +304,7 @@ ENDIF
IKB = JPVEXT + 1
IKE = SIZE(PWT,3) - JPVEXT
- ZTMP = MZF(1,IKU,1,PWT)
+ ZTMP = MZF(PWT)
!
IF (ODRAG) THEN
WHERE (PDRAG==-1)
@@ -317,7 +317,7 @@ ENDIF
ZTMP(:,:,IKE+IK) = ZTMP(:,:,IKE)
END DO
!
- ZTMP = MZM(1,IKU,1, PNU * &
+ ZTMP = MZM( PNU * &
LAP_M(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTMP) )
!
DO IK = 1,JPVEXT
diff --git a/src/MNH/wguess.f90 b/src/MNH/wguess.f90
index 189707fef4876f91574364f272cb5a500f8bc0ab..d6324d60702c9724022327ca7d0efc5550ddf6a6 100644
--- a/src/MNH/wguess.f90
+++ b/src/MNH/wguess.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -140,8 +140,8 @@ END DO
!* 2.1 General case
! ------------
!
-PRHODJW= PDZZ*ZRHODJWC + MXF(PDZX*MZM(1,IKU,1,PRHODJU/PDXX)) &
- + MYF(PDZY*MZM(1,IKU,1,PRHODJV/PDYY))
+PRHODJW= PDZZ*ZRHODJWC + MXF(PDZX*MZM(PRHODJU/PDXX)) &
+ + MYF(PDZY*MZM(PRHODJV/PDYY))
!
!* 2.2 Copies on boundaries
! --------------------
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index 197584a2ddcda810ec96b097c9b279a1ce5ad459..558e573b5f4e57ee793e3a5ddcc68b80e545d3ba 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -199,7 +199,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!
CASE('MASK')
ALLOCATE(ZWORKTEMP(NBUWRNB))
- allocate( tzdates( NBUWRNB ) )
+ allocate( tzdates(NBUWRNB) )
ALLOCATE(ZWORKMASK(SIZE(XBUSURF,1),SIZE(XBUSURF,2),1,NBUWRNB,NBUMASK,1))
!
! local array
@@ -213,16 +213,16 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!
ZWORKTEMP(NBUWRNB)=ZWORKTEMP(NBUWRNB)+(1.-NBUSTEP*0.5)*PTSTEP
!
- tzdates(NBUWRNB )%tdate%year = tdtexp%tdate%year
- tzdates(NBUWRNB )%tdate%month = tdtexp%tdate%month
- tzdates(NBUWRNB )%tdate%day = tdtexp%tdate%day
- tzdates(NBUWRNB )%time = tdtexp%time + zworktemp(NBUWRNB )
+ tzdates(NBUWRNB)%tdate%year = tdtexp%tdate%year
+ tzdates(NBUWRNB)%tdate%month = tdtexp%tdate%month
+ tzdates(NBUWRNB)%tdate%day = tdtexp%tdate%day
+ tzdates(NBUWRNB)%time = tdtexp%time + zworktemp(NBUWRNB)
DO JT=1,NBUWRNB-1
ZWORKTEMP(JT) = ZWORKTEMP(NBUWRNB)-NBUSTEP*PTSTEP*(NBUWRNB-JT)
- tzdates(jt )%tdate%year = tdtexp%tdate%year
- tzdates(jt )%tdate%month = tdtexp%tdate%month
- tzdates(jt )%tdate%day = tdtexp%tdate%day
- tzdates(jt )%time = tdtexp%time + zworktemp(jt )
+ tzdates(jt)%tdate%year = tdtexp%tdate%year
+ tzdates(jt)%tdate%month = tdtexp%tdate%month
+ tzdates(jt)%tdate%day = tdtexp%tdate%day
+ tzdates(jt)%time = tdtexp%time + zworktemp(jt)
END DO
DEALLOCATE( ZWORKTEMP )
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 49ebac8c707aa801ebcab87d643cbe1b05d2fd81..9d80498ff21d8b01a72d5cd169db1be719a06cfb 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -482,18 +482,18 @@ IF (INDEX(CISO,'TK') /= 0) THEN
END IF
!
ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
-ZVOX(:,:,:)=GY_W_VW(1,IKU,1,XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(1,IKU,1,XVT,XDZZ)
+ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
ZVOX(:,:,2)=ZVOX(:,:,3)
-ZVOY(:,:,:)=GZ_U_UW(1,IKU,1,XUT,XDZZ)-GX_W_UW(1,IKU,1,XWT,XDXX,XDZZ,XDZX)
+ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
ZVOY(:,:,2)=ZVOY(:,:,3)
-ZVOZ(:,:,:)=GX_V_UV(1,IKU,1,XVT,XDXX,XDZZ,XDZX)-GY_U_UV(1,IKU,1,XUT,XDYY,XDZZ,XDZY)
+ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
ZVOZ(:,:,2)=ZVOZ(:,:,3)
ZVOZ(:,:,1)=ZVOZ(:,:,3)
-ZWORK31(:,:,:)=GX_M_M(1,IKU,1,XTHT,XDXX,XDZZ,XDZX)
-ZWORK32(:,:,:)=GY_M_M(1,IKU,1,XTHT,XDYY,XDZZ,XDZY)
-ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,XTHT,XDZZ)
-ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
ZPOVO(:,:,1) =-1.E+11
@@ -705,7 +705,7 @@ IF (LVAR_PR ) THEN
ZWORK21(:,:) = 0.
ZWORK22(:,:) = 0.
ZWORK23(:,:) = 0.
- ZWORK31(:,:,:) = DZF(1,IKU,1,XZZ(:,:,:))
+ ZWORK31(:,:,:) = DZF(XZZ(:,:,:))
DO JK = IKB,IKE
!* Calcul de qtot
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
@@ -744,13 +744,13 @@ IF (LHU_FLX) THEN
ZWORK35(:,:,:) = XRHODREF(:,:,:) * XRT(:,:,:,1)
ZWORK31(:,:,:) = MXM(ZWORK35(:,:,:)) * XUT(:,:,:)
ZWORK32(:,:,:) = MYM(ZWORK35(:,:,:)) * XVT(:,:,:)
- ZWORK35(:,:,:) = GX_U_M(1,IKU,1,ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK32,XDYY,XDZZ,XDZY)
+ ZWORK35(:,:,:) = GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
ZWORK36(:,:,:) = ZWORK35(:,:,:) + XRHODREF(:,:,:) * (XRT(:,:,:,2) + &
XRT(:,:,:,3) + XRT(:,:,:,4) + XRT(:,:,:,5) + XRT(:,:,:,6))
ZWORK33(:,:,:) = MXM(ZWORK36(:,:,:)) * XUT(:,:,:)
ZWORK34(:,:,:) = MYM(ZWORK36(:,:,:)) * XVT(:,:,:)
- ZWORK36(:,:,:) = GX_U_M(1,IKU,1,ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK34,XDYY,XDZZ,XDZY)
+ ZWORK36(:,:,:) = GX_U_M(ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK34,XDYY,XDZZ,XDZY)
ENDIF
!
! Integration sur 3000 m
@@ -761,7 +761,7 @@ IF (LHU_FLX) THEN
IKTOP(:,:)=JK
END WHERE
END DO
- ZDELTAZ(:,:,:)=DZF(1,IKU,1,XZZ)
+ ZDELTAZ(:,:,:)=DZF(XZZ)
ZWORK21(:,:) = 0.
ZWORK22(:,:) = 0.
ZWORK25(:,:) = 0.
@@ -2275,7 +2275,7 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%LTIMEDEP = .TRUE.
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
- ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(1,IKU,1,XZZ(:,:,:))*1E6/XRADIUS
+ ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(XZZ(:,:,:))*1E6/XRADIUS
TZFIELD%CMNHNAME = 'MCOREF'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'MCOREF'
@@ -2585,7 +2585,7 @@ END IF
!
IF (LVORT) THEN
! Vorticity x
- ZWORK31(:,:,:)=MYF(MZF(1,IKU,1,MXM(ZVOX(:,:,:))))
+ ZWORK31(:,:,:)=MYF(MZF(MXM(ZVOX(:,:,:))))
TZFIELD%CMNHNAME = 'UM1'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UM1'
@@ -2599,7 +2599,7 @@ IF (LVORT) THEN
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
! Vorticity y
- ZWORK32(:,:,:)=MZF(1,IKU,1,MXF(MYM(ZVOY(:,:,:))))
+ ZWORK32(:,:,:)=MZF(MXF(MYM(ZVOY(:,:,:))))
TZFIELD%CMNHNAME = 'VM1'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VM1'
@@ -2639,7 +2639,7 @@ IF (LVORT) THEN
ENDIF
!
! Vorticity z
- ZWORK31(:,:,:)=MXF(MYF(MZM(1,IKU,1,ZVOZ(:,:,:))))
+ ZWORK31(:,:,:)=MXF(MYF(MZM(ZVOZ(:,:,:))))
TZFIELD%CMNHNAME = 'WM1'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'WM1'
@@ -2701,11 +2701,11 @@ END IF
!
! Virtual Potential Vorticity in PV units
IF (LMOIST_V .AND. (NRR>0) ) THEN
- ZWORK31(:,:,:)=GX_M_M(1,IKU,1,ZTHETAV,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(1,IKU,1,ZTHETAV,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,ZTHETAV,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAV,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAV,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAV,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
TZFIELD%CMNHNAME = 'POVOV'
@@ -2747,11 +2747,11 @@ END IF
! Equivalent Potential Vorticity in PV units
IF (LMOIST_E .AND. (NRR>0) ) THEN
!
- ZWORK31(:,:,:)=GX_M_M(1,IKU,1,ZTHETAE,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(1,IKU,1,ZTHETAE,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,ZTHETAE,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAE,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAE,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAE,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
TZFIELD%CMNHNAME = 'POVOE'
@@ -2794,11 +2794,11 @@ END IF
!
! Equivalent Saturated Potential Vorticity in PV units
IF (LMOIST_ES .AND. (NRR>0) ) THEN
- ZWORK31(:,:,:)=GX_M_M(1,IKU,1,ZTHETAES,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(1,IKU,1,ZTHETAES,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,ZTHETAES,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAES,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAES,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAES,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
TZFIELD%CMNHNAME = 'POVOES'
@@ -2821,7 +2821,7 @@ ENDIF
!
IF (LDIV) THEN
!
- ZWORK31=GX_U_M(1,IKU,1,XUT,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,XVT,XDYY,XDZZ,XDZY)
+ ZWORK31=GX_U_M(XUT,XDXX,XDZZ,XDZX) + GY_V_M(XVT,XDYY,XDZZ,XDZY)
TZFIELD%CMNHNAME = 'HDIV'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'HDIV'
@@ -2847,7 +2847,7 @@ IF (LDIV) THEN
TZFIELD%LTIMEDEP = .TRUE.
ZWORK31=MXM(XRHODREF*XRT(:,:,:,1))*XUT
ZWORK32=MYM(XRHODREF*XRT(:,:,:,1))*XVT
- ZWORK33=GX_U_M(1,IKU,1,ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK32,XDYY,XDZZ,XDZY)
+ ZWORK33=GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
END IF
!
@@ -2920,13 +2920,13 @@ IF (LGEO .OR. LAGEO) THEN
ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
- ZWORK31(:,:,:)=-MXM(GY_M_M(1,IKU,1,ZPHI,XDYY,XDZZ,XDZY)*XCPD*XTHVREF/ZCORIOZ)
+ ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)*XCPD*XTHVREF/ZCORIOZ)
!
ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
- ZWORK32(:,:,:)=MYM(GX_M_M(1,IKU,1,ZPHI,XDXX,XDZZ,XDZX)*XCPD*XTHVREF/ZCORIOZ)
+ ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)*XCPD*XTHVREF/ZCORIOZ)
!
ELSE IF(CEQNSYS=='LHE') THEN
ZPHI(:,:,:)= ((XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)) &
@@ -2936,13 +2936,13 @@ IF (LGEO .OR. LAGEO) THEN
ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
- ZWORK31(:,:,:)=-MXM(GY_M_M(1,IKU,1,ZPHI,XDYY,XDZZ,XDZY)/ZCORIOZ)
+ ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)/ZCORIOZ)
!
ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
- ZWORK32(:,:,:)=MYM(GX_M_M(1,IKU,1,ZPHI,XDXX,XDZZ,XDZX)/ZCORIOZ)
+ ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)/ZCORIOZ)
END IF
DEALLOCATE(ZPHI)
!
@@ -3497,7 +3497,7 @@ ENDIF
!* B-V frequency to assess thermal tropopause
!
IF (LBV_FR) THEN
- ZWORK32(:,:,:)=DZM(1,IKU,1,XTHT(:,:,:))/ MZM(1,IKU,1,XTHT(:,:,:))
+ ZWORK32(:,:,:)=DZM(XTHT(:,:,:))/ MZM(XTHT(:,:,:))
DO JK=1,IKU
DO JJ=1,IJU
DO JI=1,IIU
@@ -3523,7 +3523,7 @@ IF (LBV_FR) THEN
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
IF (NRR > 0) THEN
- ZWORK32(:,:,:)=DZM(1,IKU,1,ZTHETAE(:,:,:))/ MZM(1,IKU,1,ZTHETAE(:,:,:))
+ ZWORK32(:,:,:)=DZM(ZTHETAE(:,:,:))/ MZM(ZTHETAE(:,:,:))
DO JK=1,IKU
DO JJ=1,IJU
DO JI=1,IIU
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 29d7fed2d1cdef685ee2d3744efcb0fd08733d6c..7008f40e5ce147a157910c03790fa7ae0899e78c 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -421,7 +421,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
ZCLMR=1.E-4 ! detection of clouds for cloud mixing ratio > .1g/kg
!
GMASK2(:,:)=.TRUE.
- ZWORK31(:,:,:)= MZM(1,IKU,1, XRT(:,:,:,2) ) ! cloud mixing ratio at zz levels
+ ZWORK31(:,:,:)= MZM( XRT(:,:,:,2) ) ! cloud mixing ratio at zz levels
DO JK=IKE,IKB,-1
WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
GMASK2(:,:)=.FALSE.
@@ -431,7 +431,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
!
IF (LUSERI) THEN
GMASK2(:,:)=.TRUE.
- ZWORK31(:,:,:)= MZM(1,IKU,1, XRT(:,:,:,4) ) ! cloud mixing ratio at zz levels
+ ZWORK31(:,:,:)= MZM( XRT(:,:,:,4) ) ! cloud mixing ratio at zz levels
DO JK=IKE,IKB,-1
WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
GMASK2(:,:)=.FALSE.
@@ -467,7 +467,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
! Higher top of the different species of clouds
!
IWORK1(:,:)=IKB ! initialization with the ground values
- ZWORK31(:,:,:)=MZM(1,IKU,1,ZTEMP(:,:,:)) ! temperature (K) at zz levels
+ ZWORK31(:,:,:)=MZM(ZTEMP(:,:,:)) ! temperature (K) at zz levels
IF(CRAD/='NONE') ZWORK31(:,:,IKB)=XTSRAD(:,:)
ZWORK21(:,:)=0.
ZWORK22(:,:)=0.
@@ -1125,7 +1125,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
! *********************
! Geopotential in meters
! *********************
- ZWORK31(:,:,:) = MZF(1,IKU,1,XZZ(:,:,:))
+ ZWORK31(:,:,:) = MZF(XZZ(:,:,:))
CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
DO JK=1,IPRES
@@ -1194,18 +1194,18 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
! Potential Vorticity
! *********************
ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
- ZVOX(:,:,:)=GY_W_VW(1,IKU,1,XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(1,IKU,1,XVT,XDZZ)
+ ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
ZVOX(:,:,2)=ZVOX(:,:,3)
- ZVOY(:,:,:)=GZ_U_UW(1,IKU,1,XUT,XDZZ)-GX_W_UW(1,IKU,1,XWT,XDXX,XDZZ,XDZX)
+ ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
ZVOY(:,:,2)=ZVOY(:,:,3)
- ZVOZ(:,:,:)=GX_V_UV(1,IKU,1,XVT,XDXX,XDZZ,XDZX)-GY_U_UV(1,IKU,1,XUT,XDYY,XDZZ,XDZY)
+ ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
ZVOZ(:,:,2)=ZVOZ(:,:,3)
ZVOZ(:,:,1)=ZVOZ(:,:,3)
- ZWORK31(:,:,:)=GX_M_M(1,IKU,1,XTHT,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(1,IKU,1,XTHT,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,XTHT,XDZZ)
- ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
ZPOVO(:,:,1) =-1.E+11
@@ -1343,18 +1343,18 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
! Potential Vorticity
! *********************
ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
- ZVOX(:,:,:)=GY_W_VW(1,IKU,1,XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(1,IKU,1,XVT,XDZZ)
+ ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
ZVOX(:,:,2)=ZVOX(:,:,3)
- ZVOY(:,:,:)=GZ_U_UW(1,IKU,1,XUT,XDZZ)-GX_W_UW(1,IKU,1,XWT,XDXX,XDZZ,XDZX)
+ ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
ZVOY(:,:,2)=ZVOY(:,:,3)
- ZVOZ(:,:,:)=GX_V_UV(1,IKU,1,XVT,XDXX,XDZZ,XDZX)-GY_U_UV(1,IKU,1,XUT,XDYY,XDZZ,XDZY)
+ ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
ZVOZ(:,:,2)=ZVOZ(:,:,3)
ZVOZ(:,:,1)=ZVOZ(:,:,3)
- ZWORK31(:,:,:)=GX_M_M(1,IKU,1,XTHT,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(1,IKU,1,XTHT,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,XTHT,XDZZ)
- ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
ZPOVO(:,:,1) =-1.E+11
@@ -1451,7 +1451,7 @@ IF (LCOARSE) THEN
CALL BLOCKAVG(ZWORK31,IDX,IDX,ZUU_AVG)
ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
CALL BLOCKAVG(ZWORK31,IDX,IDX,ZVV_AVG)
- ZWORK31=MZF(1,IKU,1,ZWT_PRM*ZWT_PRM)
+ ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
CALL BLOCKAVG(ZWORK31,IDX,IDX,ZWW_AVG)
CALL BLOCKAVG(XTKET,IDX,IDX,ZWORK31)
ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
@@ -1481,7 +1481,7 @@ IF (LCOARSE) THEN
CALL MOVINGAVG(ZWORK31,IDX,IDX,ZUU_AVG)
ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
CALL MOVINGAVG(ZWORK31,IDX,IDX,ZVV_AVG)
- ZWORK31=MZF(1,IKU,1,ZWT_PRM*ZWT_PRM)
+ ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
CALL MOVINGAVG(ZWORK31,IDX,IDX,ZWW_AVG)
CALL MOVINGAVG(XTKET,IDX,IDX,ZWORK31)
ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 22fe2bc3926138caa12cbeab4b3e1f3677531a53..971ea13e7a50f4b01177976e8e05779918c73815 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -172,6 +172,7 @@ END MODULE MODI_WRITE_LFIFM_n
!! C.Lac 18/02/2019: add rain fraction as an output field
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Tulet 02/2020: correction for dust and sea salts
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -257,6 +258,8 @@ USE MODI_WRITE_BALLOON_n
USE MODI_DUSTLFI_n
USE MODI_SALTLFI_n
USE MODI_CH_AER_REALLFI_n
+USE MODI_SALT_FILTER
+USE MODI_DUST_FILTER
!
!20131128
USE MODE_MPPDB
@@ -1219,6 +1222,7 @@ IF (NSV >=1) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
+ CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF)
DO JSV = NSV_DSTBEG,NSV_DSTEND
TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1276,22 +1280,34 @@ IF (NSV >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- DO JMODE=1, NMODE_SLT
- DO JMOM = 1, IMOMENTS
- !Index from which names are picked
- ISV_NAME_IDX = (JPSALTORDER(JMODE)-1)*IMOMENTS + JMOM
- !Index which counts in the XSVT
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_SLTBEG -1) !Previous list of tracers
-
- TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T' !The refererence which will be written to file
+!
+ IF (IMOMENTS == 1) THEN
+ DO JMODE=1, NMODE_SLT
+ ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*3 + 2
+ JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
+ + 1 & !Number of moments in this mode
+ + (NSV_SLTBEG -1) !Previous list of tracers
+ TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- YSLTNAMES((JMODE-1)*IMOMENTS+JMOM)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on moments
- END DO ! Loop on modes
+ YSLTNAMES((JMODE-1)*IMOMENTS+1)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
+ END DO ! Loop on mode
+ ELSE
+ DO JMODE=1, NMODE_SLT
+ DO JMOM = 1, IMOMENTS
+ ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*IMOMENTS + JMOM
+ JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
+ + JMOM & !Number of moments in this mode
+ + (NSV_SLTBEG -1)
+ TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T' !The refererence which will be written to file
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ YSLTNAMES((JMODE-1)*IMOMENTS+JMOM)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
+ END DO ! Loop on moment
+ END DO ! loop on mode
+ END IF ! IMOMENTS
!
DO JSV = NSV_SLTBEG,NSV_SLTEND
YCHNAMES(JSV-JSA) = YSLTNAMES(JSV-NSV_SLTBEG+1)
@@ -1308,6 +1324,7 @@ IF (NSV >=1) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
+ CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF)
DO JSV = NSV_SLTBEG,NSV_SLTEND
TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index f5d3a81f2e14d54d1385efac2eef39bb161e3921..ad714bd569127529dc61feaf0b50dd6a0d7a32ae 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -64,25 +64,25 @@ END MODULE MODI_WRITE_STATION_n
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CH_M9_n, ONLY: CNAMES
+USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
+USE MODD_CONF
USE MODD_CST
+USE MODD_DIAG_IN_RUN
+USE MODD_DIM_n
+USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_GRID_n
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT
+USE MODD_NSV
USE MODD_PARAMETERS
-!
-USE MODD_CH_M9_n, ONLY: CNAMES
-USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
+USE MODD_PARAM_n, ONLY: CRAD
+USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
-USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-USE MODD_LG, ONLY: CLGNAMES
-USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
USE MODD_SALT, ONLY: CSALTNAMES, LSALT, NMODE_SLT
-USE MODD_NSV
-USE MODD_DIAG_IN_RUN
-USE MODD_PARAM_n, ONLY: CRAD
-!
-USE MODD_DIM_n
-USE MODD_GRID_n
USE MODD_STATION_n
!
USE MODE_AERO_PSD
@@ -195,6 +195,20 @@ YUNIT (JPROC) = 'degree'
YCOMMENT (JPROC) = 'Latitude'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
!
+IF (LCARTESIAN) THEN
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'X'
+ YUNIT (JPROC) = 'm'
+ YCOMMENT (JPROC) = 'X Pos'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%X(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'Y'
+ YUNIT (JPROC) = 'm'
+ YCOMMENT (JPROC) = 'Y Pos'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Y(II)
+ENDIF
+!
JPROC = JPROC + 1
YTITLE (JPROC) = 'ZON_WIND'
YUNIT (JPROC) = 'm s-1'
@@ -362,6 +376,15 @@ IF (SIZE(TSTATION%TKE,1)>0) THEN
END IF
!
!
+IF (LPASPOL) THEN
+ JSV=1
+ JPROC = JPROC+1
+ WRITE (YTITLE(JPROC),FMT='(A2,I3.3)') 'Sv',JSV
+ YUNIT (JPROC) = 'kg kg-1'
+ YCOMMENT (JPROC) = ' '
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SV(:,II,JSV)
+ENDIF
+!
IF (SIZE(TSTATION%SV,3)>=1) THEN
! User scalar variables
DO JSV = 1,NSV_USER
diff --git a/src/MNH/zdiffusetup.f90 b/src/MNH/zdiffusetup.f90
index 3b7abb83c752596d0e25eb7aa264231b45efe6b0..955853512eb79517e052560b117e01f2952d3117 100644
--- a/src/MNH/zdiffusetup.f90
+++ b/src/MNH/zdiffusetup.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2020 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.
@@ -151,7 +151,7 @@ ALLOCATE (ZN4HGTI_HALO2(IIB-2:IIE+2,IJB-2:IJE+2),ZN4HGTJ_HALO2(IIB-2:IIE+2,IJB-2
NULLIFY(TZHGTMASS_ll,TZHGTHALO2_ll)
! Compute height field at mass points
-ZZMASS = MZF(1,IKU,1,PZZ)
+ZZMASS = MZF(PZZ)
CALL INIT_HALO2_ll(TZHGTHALO2_ll,1,IIU,IJU,IKU)
CALL ADD3DFIELD_ll( TZHGTMASS_ll, ZZMASS, 'ZDIFFUSETUP::ZZMASS' )
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index e89ea60a34fab24e948a7040ae516eb254a807aa..a912f800b0dadff45dcd117e54bfe49c4443c0c5 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -180,7 +180,7 @@ CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
-LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
+LIBS += -L${GA_ROOT}/lib -lga -larmci
endif
#
# Gribex flags
diff --git a/src/SURFEX/allocate_physio.F90 b/src/SURFEX/allocate_physio.F90
index 1028fa2498a5949727561ed5e83c6b1bc3f45250..745a7d007573acc54b03ab9a38911feb85faedc7 100644
--- a/src/SURFEX/allocate_physio.F90
+++ b/src/SURFEX/allocate_physio.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original xx/xxxx
!! Modified 10/2014 P. Samuelsson MEB
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!
!
USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
@@ -99,11 +100,7 @@ ELSE
ENDIF
! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
!
-IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
- ALLOCATE(PK%XH_TREE (ISIZE ))
-ELSE
- ALLOCATE(PK%XH_TREE (0 ))
-ENDIF
+ALLOCATE(PK%XH_TREE (ISIZE ))
!
IF (IO%CPHOTO/='NON') THEN
ALLOCATE(PK%XRE25 (ISIZE ))
diff --git a/src/SURFEX/ch_emission_fluxn.F90 b/src/SURFEX/ch_emission_fluxn.F90
index 25b6a7e646b86a910fcd2d6f54bc7569a41a46c6..f9eae54518a9396b0c73cce922894b0fad2493f7 100644
--- a/src/SURFEX/ch_emission_fluxn.F90
+++ b/src/SURFEX/ch_emission_fluxn.F90
@@ -1,4 +1,4 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2000-2020 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.
@@ -28,6 +28,7 @@
!! P.Tulet 01/01/05 add dust, orilam
!! M.Leriche 2015 suppress ZDEPOT
!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+! P. Wautelet 11/02/2020: bugfix: set correct filein before call to INIT_IO_SURF_n
!!
!! EXTERNAL
!! --------
@@ -53,6 +54,7 @@ USE MODI_GET_LUOUT
USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX
USE MODI_CH_AER_EMISSION
!UPG*AERO1
+USE MODI_SET_SURFEX_FILEIN
!!
!------------------------------------------------------------------------------
!
@@ -208,6 +210,7 @@ DO JI=1,SIZE(CHE%TSEMISS)
!
IF (.NOT. LIOINIT) THEN
! Must be done once before reading
+ CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'
LIOINIT=.TRUE.
diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90
index cad66666339946c838b566938c50ad491b38e4f0..b04278c2088347b63e33deac72c1660e34f2c7ff 100644
--- a/src/SURFEX/convert_patch_isba.F90
+++ b/src/SURFEX/convert_patch_isba.F90
@@ -46,6 +46,7 @@
!! coupled to atmosphere)
!! P Samuelsson 10/2014 MEB
! P. Wautelet 15/02/2019: bugfix: allocate ZSTRESS only when its size has a meaning
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!
!----------------------------------------------------------------------------
!
@@ -215,7 +216,6 @@ IF (OFIX) THEN
PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!
- IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN
CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
@@ -223,7 +223,6 @@ IF (OFIX) THEN
CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,&
PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
- ENDIF
!
IF (IO%CPHOTO/='NON') THEN
!
diff --git a/src/SURFEX/get_surf_varn.F90 b/src/SURFEX/get_surf_varn.F90
index f732f03161620077971e172764a7af89d51acc92..de14d16e00dcc1c9b80ee0ee6ff3bc89e9816833 100644
--- a/src/SURFEX/get_surf_varn.F90
+++ b/src/SURFEX/get_surf_varn.F90
@@ -10,7 +10,8 @@
PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN, PQS_SEA, &
PQS_WATER, PQS_NATURE, PQS_TOWN, PPSNG, PPSNV, &
PZS, PSERIES, PTWSNOW, PSSO_STDEV, PLON, PLAT, &
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, &
+ PWALL_O_HOR, PBUILD_HEIGHT )
! #######################################################################
!
!!**** *GET_SURF_VAR_n* - gets some surface fields on atmospheric grid
@@ -47,6 +48,7 @@
! S. Riette 06/2010 PSSO_STDEV and PTWSNOW added
! B. Decharme 09/2012 Argument added in GET_FLUX_n
! B. Decharme 05/2013 Argument added in GET_FLUX_n for debug in ARP/AL/AR
+!! C. Lac 11/2019 correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -144,8 +146,11 @@ REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLON ! longitude
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAT ! latitude
!
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBARE ! bare soil fraction on grid mesh (-)
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Leaf Area Index on grid mesh (-)
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_TREE ! Height of trees on grid mesh (-)
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Leaf Area Index on grid mesh (-)
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_TREE ! Height of trees on grid mesh (-)
+!
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density on grid mesh [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height on grid mesh [m]
!
!-------------------------------------------------------------------------------
!
@@ -425,7 +430,8 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
+IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) .OR. &
+ PRESENT(PWALL_O_HOR) .OR. PRESENT (PBUILD_HEIGHT) ) THEN
!
! Get parameters over town tile
!
@@ -440,8 +446,9 @@ IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
IMASK(:)=0
CALL GET_1D_MASK(KI_TOWN, KI, PTOWN, IMASK(1:KI_TOWN))
!
- CALL GET_VAR_TOWN_n(TM%TD%O, TM%TD%D, HPROGRAM, KI_TOWN, &
- ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN))
+ CALL GET_VAR_TOWN_n(TM%TOP, TM%TD%O, TM%TD%D, TM%NT,HPROGRAM, KI_TOWN, &
+ ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN),&
+ ZFIELD4(1:KI_TOWN), ZFIELD5(1:KI_TOWN) )
!
IF(PRESENT(PQS_TOWN))THEN
PQS_TOWN (:) = XUNDEF
@@ -464,6 +471,20 @@ IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
END DO
ENDIF
!
+ IF(PRESENT(PWALL_O_HOR))THEN
+ PWALL_O_HOR (:) = XUNDEF
+ DO JI = 1, KI_TOWN
+ PWALL_O_HOR(IMASK(JI)) = ZFIELD4(JI)
+ END DO
+ ENDIF
+ !
+ IF(PRESENT(PBUILD_HEIGHT))THEN
+ PBUILD_HEIGHT (:) = XUNDEF
+ DO JI = 1, KI_TOWN
+ PBUILD_HEIGHT(IMASK(JI)) = ZFIELD5(JI)
+ END DO
+ ENDIF
+ !
END IF
!
!* 5. Orography
diff --git a/src/SURFEX/get_var_townn.F90 b/src/SURFEX/get_var_townn.F90
index 0f2e9c9d7a8501a326655eb869dbe19ee0f69416..382f32216f17819a49f02764db3ef54b5a2889e6 100644
--- a/src/SURFEX/get_var_townn.F90
+++ b/src/SURFEX/get_var_townn.F90
@@ -3,7 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_TOWN_n (DGO, D, HPROGRAM,KI,PQS,PZ0,PZ0H)
+ SUBROUTINE GET_VAR_TOWN_n (TOP, DGO, D, NT, HPROGRAM,KI,PQS,PZ0,PZ0H, &
+ PWALL_O_HOR,PBUILD_HEIGHT )
! ###################################################
!
!!**** *GET_VAR_TOWN_n* - routine to get variables defined only over town
@@ -33,6 +34,7 @@
!! -------------
!! Original 02/2006
! M. Jidane 08/2008 Z0 and Z0H recovery from town tiles
+!! C.Lac 11/2019 correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -40,6 +42,8 @@
!
!
USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -54,19 +58,24 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(TEB_OPTIONS_t), INTENT(IN) :: TOP
TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
-TYPE(DIAG_t), INTENT(IN) :: D
+TYPE(DIAG_t), INTENT(IN) :: D
+TYPE(TEB_NP_t), INTENT(IN) :: NT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
REAL, DIMENSION(KI), INTENT(OUT) :: PQS ! surface humidity
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! surface roughness length
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! surface roughness length for heat
+REAL, DIMENSION(KI), INTENT(OUT) :: PWALL_O_HOR ! Facade surface density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(KI), INTENT(OUT) :: PBUILD_HEIGHT ! Building height [m]
!
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+INTEGER :: JP ! loop counter on TEB patches
INTEGER :: ILUOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -76,17 +85,28 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_TOWN_N',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
IF (DGO%LSURF_VARS) THEN
- PQS = D%XQS
- ELSE
- PQS = XUNDEF
+ PQS = D%XQS
+ELSE
+ PQS = XUNDEF
ENDIF
IF (DGO%LCOEF) THEN
- PZ0 = D%XZ0
- PZ0H = D%XZ0H
- ELSE
- PZ0 = XUNDEF
- PZ0H = XUNDEF
-ENDIF
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
+ELSE
+ PZ0 = XUNDEF
+ PZ0H = XUNDEF
+ENDIF
+!
+!* building height and external wall coverage fraction
+!
+PWALL_O_HOR = 0.
+PBUILD_HEIGHT = 0.
+
+DO JP=1,TOP%NTEB_PATCH
+ PWALL_O_HOR (:) = PWALL_O_HOR (:) + TOP%XTEB_PATCH(:,JP) * NT%AL(JP)%XWALL_O_HOR(:)
+ PBUILD_HEIGHT(:) = PBUILD_HEIGHT(:) + TOP%XTEB_PATCH(:,JP) * NT%AL(JP)%XBLD_HEIGHT(:)
+END DO
+
IF (LHOOK) CALL DR_HOOK('GET_VAR_TOWN_N',1,ZHOOK_HANDLE)
!
!==============================================================================
diff --git a/src/SURFEX/get_vegn.F90 b/src/SURFEX/get_vegn.F90
index a41238194f6801df7bdcbfa3720681b65c25c90f..d1e9c583dea8d354a300c86d77501cd24ee6236b 100644
--- a/src/SURFEX/get_vegn.F90
+++ b/src/SURFEX/get_vegn.F90
@@ -29,6 +29,7 @@
!! MODIFICATIONS
!! -------------
!! Original 07/2009
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,16 +101,16 @@ IPATCH_BONE = VEGTYPE_TO_PATCH(NVT_BONE, IO%NPATCH)
IPATCH_BOND = VEGTYPE_TO_PATCH(NVT_BOND, IO%NPATCH)
-!ZWORK(:) = S%XVEGTYPE(:,NVT_TRBE) + S%XVEGTYPE(:,NVT_TRBD) + S%XVEGTYPE(:,NVT_TEBE) + &
-! S%XVEGTYPE(:,NVT_TEBD) + S%XVEGTYPE(:,NVT_TENE) + S%XVEGTYPE(:,NVT_BOBD) + &
-! S%XVEGTYPE(:,NVT_BONE) + S%XVEGTYPE(:,NVT_BOND)
-
ZH_TREE(:) = 0.
ZLAI(:) = 0.
ZWORK(:) = 0.
!
DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+END DO
!
+DO JP = 1,IO%NPATCH
IF (JP==IPATCH_TRBE .OR. JP==IPATCH_TRBD .OR. JP==IPATCH_TEBE .OR. JP==IPATCH_TEBD .OR. &
JP==IPATCH_TENE .OR. JP==IPATCH_BOBD .OR. JP==IPATCH_BONE .OR. JP==IPATCH_BOND) THEN
!
diff --git a/src/SURFEX/init_isban.F90 b/src/SURFEX/init_isban.F90
index 4bdbb57e1112e5df8c0cf986a6e72663295b7cbe..283b107f5744b132310c3f43feb9f084748da5b4 100644
--- a/src/SURFEX/init_isban.F90
+++ b/src/SURFEX/init_isban.F90
@@ -59,6 +59,7 @@ SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
!! P.Tulet 06/16 : add MEGAN coupling
!! J.Pianezzej 02/2019 : correction for use of MEGAN
! P. Wautelet 21/11/2019: initialize YSNOW_SCHEME
+! S. Donnier 02/2020 : correction for ECOCLIMAP SG (20 vegtypes possible)
!!
!-------------------------------------------------------------------------------
!
@@ -371,7 +372,10 @@ ISIZE_LMEB_PATCH=COUNT(IM%O%LMEB_PATCH(:))
!* 2.2 Check:
! ------
!
-IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 )THEN
+! modif ECOSG
+!IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 )THEN
+IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 .AND. IM%O%NPATCH/=20 )THEN
+! fin modif ECOSG
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND NPATCH')
ENDIF
!
diff --git a/src/SURFEX/mode_aer_surf.F90 b/src/SURFEX/mode_aer_surf.F90
index e38f84a6480ea33bc163205106b8a4411443b125..a23ac0cdb8bb8f53f88d4f3148a08d0dead73d78 100644
--- a/src/SURFEX/mode_aer_surf.F90
+++ b/src/SURFEX/mode_aer_surf.F90
@@ -215,6 +215,7 @@ REAL,DIMENSION(JPMODE*3) :: ZMMIN
!
REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor
REAL, PARAMETER :: ZDEN2MOL = 1E-6 * 6.0221367E+23 / 28.9644E-3
+REAL :: ZEMISRADIUSI, ZEMISRADIUSJ
INTEGER :: JJ, JN ! [idx] loop counters
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -227,6 +228,23 @@ DO JJ=1, SIZE(PSVT,2)
ZSV(:,JJ) = PSVT(:,JJ) * ZDEN2MOL * PRHODREF(:)
ZSV(:,JJ) = MAX(ZSV(:,JJ),1E-40 * ZDEN2MOL * PRHODREF(:))
ENDDO
+!Get minimum values possible for aerosols moments
+IF (CRGUNIT=="MASS") THEN
+ ZEMISRADIUSI = XEMISRADIUSI * EXP(-3.*(LOG(XEMISSIGI))**2)
+ ZEMISRADIUSJ = XEMISRADIUSJ * EXP(-3.*(LOG(XEMISSIGJ))**2)
+ELSE
+ ZEMISRADIUSI = XEMISRADIUSI
+ ZEMISRADIUSJ = XEMISRADIUSJ
+END IF
+
+ZMMIN(1) = XSURF_TINY
+ZMMIN(2) = ZMMIN(1) * (ZEMISRADIUSI**3)*EXP(4.5 * LOG(XEMISSIGI)**2)
+ZMMIN(3) = ZMMIN(1) * (ZEMISRADIUSI**6)*EXP(18. * LOG(XEMISSIGI)**2)
+
+ZMMIN(4) = XSURF_TINY
+ZMMIN(5) = ZMMIN(4) * (ZEMISRADIUSJ**3)*EXP(4.5 * LOG(XEMISSIGJ)**2)
+ZMMIN(6) = ZMMIN(4) * (ZEMISRADIUSJ**6)*EXP(18. * LOG(XEMISSIGJ)**2)
+
!
CALL INIT_VAR(ZSV,ZFAC,ZCTOTA)
!
diff --git a/src/SURFEX/mode_read_grib.F90 b/src/SURFEX/mode_read_grib.F90
index ec71d31314156d270939ae14202ce729473420d3..344ea5967b0658f1a362b4eef77366bc302691fa 100644
--- a/src/SURFEX/mode_read_grib.F90
+++ b/src/SURFEX/mode_read_grib.F90
@@ -1,10 +1,11 @@
-!SFX_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 1994-2020 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.
!-------------------------------------------------------------------
! Modifications:
! P. Wautelet 19/09/2019: correct support of 64bit integers (MNH_INT=8)
+! Q. Rodier 27/01/2020: switch of GRIB number ID for Orography in ARPEGE in EPyGrAM v1.3.7
!-------------------------------------------------------------------
! #####################
MODULE MODE_READ_GRIB
@@ -516,7 +517,11 @@ SELECT CASE (HINMODEL)
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,228002,IRET,PZS)
CASE ('ARPEGE','MOCAGE')
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,5,IRET,PZS)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,4,IRET,PZS)
+ IF (IRET /= 0) THEN
+ ! Old version of EPyGraM (bug corrected since 01/2020)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,5,IRET,PZS)
+ END IF
ELSE
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,8,IRET,PZS)
ENDIF
diff --git a/src/configure b/src/configure
index 2e6f572cb49dcbfc706c4399c5c2fb064bdf1609..9a6a4f7a257cc4a8ae8f4e5c046866aaf7870498 100755
--- a/src/configure
+++ b/src/configure
@@ -9,9 +9,9 @@ if [ "x$XYZ" = "x" ]
then
#
export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-4}
-export VERSION_BUG=${VERSION_BUG:-2}
+export VERSION_BUG=${VERSION_BUG:-3}
export VERSION_XYZ=${VERSION_XYZ:-${VERSION_MASTER}-${VERSION_BUG}${VER_OASIS:+-${VER_OASIS}}}
-export VERSION_DATE=${VERSION_DATE:-"03/04/2019"}
+export VERSION_DATE=${VERSION_DATE:-"06/03/2020"}
export VERSION_LIBAEC=${VERSION_LIBAEC:-"0.3.2"}
export VERSION_HDF=${VERSION_HDF:-"1.8.20"}
export VERSION_CDFC=${VERSION_CDFC:-"4.5.0"}
@@ -52,8 +52,8 @@ case "$TARG" in
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel-compilers-19/19.0.4.243
-module load intel-mpi-19/19.0.4.243
+module load intel-compilers/19.0.5
+module load intel-mpi/19.0.5
ulimit -s unlimited
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
@@ -118,6 +118,9 @@ module load ncl_ncarg/6.3.0
"}
;;
'Linux irene'*)
+ MODEL_NAME=`lscpu | grep 'Model name' `
+ case ${MODEL_NAME} in
+*Intel*) # Irene Intel core
export MNH_ARCH=`echo $ARCH | grep LX`
export ARCH=${MNH_ARCH:-LXifort}
export VER_MPI=${VER_MPI:-MPIINTEL}
@@ -131,6 +134,30 @@ module load mpi/intelmpi/2018.0.3.222
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
"}
+;;
+*AMD*) # Irene AMD core
+ export MNH_ARCH=`echo $ARCH | grep LX`
+ export ARCH=${MNH_ARCH:-LXifort}
+ export VER_MPI=${VER_MPI:-MPIAUTO}
+ export OPTLEVEL=${OPTLEVEL:-O2}
+ export MVWORK=${MVWORK:-NO}
+ export VER_CDF=${VER_CDF:-CDFAUTO}
+ export VERSION_XYZ="${VERSION_XYZ}-AMD"
+ export MNHENV=${MNHENV:-"
+module purge
+module load intel/19.0.5.281
+module load mpi/openmpi/4.0.2
+# Set some openmpi variable for pb with nb of cores >> 1024
+export OMPI_MCA_coll_hcoll_enable=0
+export HCOLL_ENABLE_MCAST_ALL=0
+export OMPI_MCA_coll_tuned_barrier_algorithm=2
+# For GA version set GA/ARMCI variables
+export ARMCI_VERBOSE=1
+export ARMCI_STRIDED_METHOD=IOV ARMCI_IOV_METHOD=BATCHED
+export ARMCI_SHR_BUF_METHOD=COPY
+"}
+;;
+ esac
;;
'Linux beaufix'*|'Linux prolix'*)
diff --git a/src/job_make_examples_BullX_jeanzay b/src/job_make_examples_BullX_jeanzay
new file mode 100755
index 0000000000000000000000000000000000000000..82ee2e6a67cd69fbdaea3cc6d92201974141e7dc
--- /dev/null
+++ b/src/job_make_examples_BullX_jeanzay
@@ -0,0 +1,65 @@
+#!/bin/bash
+#SBATCH -J Examples
+#SBATCH -N 2 # nodes number
+#SBATCH -n 4 # CPUs number (on all nodes)
+#SBATCH -q qos_cpu-dev
+#SBATCH --exclusive
+#SBATCH -o Examples.eo%j #
+#SBATCH -e Examples.eo%j #
+#SBATCH -t 01:00:00 # time limit
+#SBATCH --export=NONE
+
+# Echo des commandes
+ulimit -c 0
+ulimit -s unlimited
+# Arrete du job des la premiere erreur
+#set -e
+set -x
+# Nom de la machine
+hostname
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-3-MPIINTEL-O2
+export MONORUN="Exec srun -l -n 1 --export=ALL numabind_core_slurm"
+export MPIRUN="Exec srun -l -n 4 --export=ALL numabind_core_slurm"
+export POSTRUN="time "
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
+