diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
index 2b0b71df0a7e9d2597db598d5851b5924f75b2bf..e662f00c317a49d983669ee5dff5717f2a7def49 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
@@ -21,7 +21,8 @@
&NAM_CONF CCONF = "START", NVERB=5, NMODEL = 2,
CEXP = "16JAN", CSEG = "12B18" ,
CSPLIT='BSPLITTING'
- !NHALO=3 JPHEXT=3
+ NHALO=3
+ !JPHEXT=3
/
&NAM_DYN XSEGLEN = 300., LCORIO = T, LNUMDIFU = F,
XALKTOP = 0.001, XALZBOT = 14500. /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
index 4dea95d5aa9b2d3397c0bd34b0d0b9a13f29d424..005f9db707414508b8a3dd2e887337bd0ec56ec1 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
@@ -1,5 +1,7 @@
&NAM_LUNITn CINIFILE = "16JAN_06_MNH2" ,CINIFILEPGD="16JAN98_9km.neste1" /
-&NAM_DYNn CPRESOPT = "RICHA", NITR = 8, XRELAX = 1.,
+&NAM_DYNn
+ ! CPRESOPT = "ZRESI" ,
+ NITR = 8, XRELAX = 1.,
LHORELAX_UVWTH = F, LHORELAX_RV = F, LHORELAX_RC= F, LHORELAX_RR= F,
LHORELAX_RS= F, LHORELAX_RI= F, LHORELAX_RG= F, LHORELAX_TKE= F,
NRIMX = 0, NRIMY = 0, LVE_RELAX = T, XT4DIFU = 1500. /
diff --git a/src/LIB/SURCOUCHE/src/modd_mpif.f90 b/src/LIB/SURCOUCHE/src/modd_mpif.f90
index b2d11175fd2a348290bca6bff55d10171846b6be..a36b3748a77cd6dedf33847c195473bbdadac049 100644
--- a/src/LIB/SURCOUCHE/src/modd_mpif.f90
+++ b/src/LIB/SURCOUCHE/src/modd_mpif.f90
@@ -7,7 +7,9 @@
!-----------------------------------------------------------------
! $Source$
! $Name$
-! $Revision$
+! $Revision$
+! J.Escobar 5/06/2018 : add cpp key MNH_USE_MPI_STATUSES_IGNORE for use of true MPI_STATUSES_IGNORE
+! & bypass bug with ifort+openmpi
! $Date$
!-----------------------------------------------------------------
!-----------------------------------------------------------------
@@ -19,5 +21,10 @@ MODULE MODD_MPIF
#else
IMPLICIT NONE
INCLUDE 'mpif.h'
+#ifdef MNH_USE_MPI_STATUSES_IGNORE
+ ! bypass ifort bug with use only MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
+ double precision XXXXXX
+ equivalence ( MPI_STATUSES_IGNORE , XXXXXX )
+#endif
#endif
END MODULE MODD_MPIF
diff --git a/src/LIB/SURCOUCHE/src/modd_var_ll.f90 b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
index d78105df9f9a7e71c52985f8c7f96fff1e231ff9..8ce4b7d1848d7a5917106c220bc88339ce948896 100644
--- a/src/LIB/SURCOUCHE/src/modd_var_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
@@ -44,11 +44,14 @@
!! -------------
!
! Original 04/05/99
-
+! Modifications
+! J.Escobar 5/06/2018 : add cpp key MNH_USE_MPI_STATUSES_IGNORE for use of true MPI_STATUSES_IGNORE
!-------------------------------------------------------------------------------
!
USE MODD_STRUCTURE_ll
- !USE MODD_MPIF, ONLY : MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
+#ifdef MNH_USE_MPI_STATUSES_IGNORE
+ USE MODD_MPIF, ONLY : MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
+#endif
!
IMPLICIT NONE
!
@@ -138,6 +141,8 @@ INTEGER,SAVE :: NZ_PROC_ll = 0 ! Number of proc to use in the Z splitting
!
INTEGER, PARAMETER :: NMODULO_MSSGTAG = 10
!
- INTEGER, POINTER, DIMENSION(:,:) :: MNH_STATUSES_IGNORE
+#ifndef MNH_USE_MPI_STATUSES_IGNORE
+ INTEGER, POINTER, DIMENSION(:,:) :: MNH_STATUSES_IGNORE
+#endif
!
END MODULE MODD_VAR_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
index 8ee22c5c4fe44bbd32e3054f500113d3b1c0adfc..dcfd6cf0800a4fd5de862306e03ba188bc60c4fe 100644
--- a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
@@ -100,6 +100,7 @@ CONTAINS
! R. Guivarch 29/11/99 x and y splitting -> YSPLITTING
! J. Escobar 24/09/2013 : temp patch for problem of gridnesting with different SHAPE
! M.Moge 10/02/2015 construct halo extended (needed for an interpolation in SPAWNING)
+ ! J. Escobar 5/06/2018 : add cpp key MNH_USE_MPI_STATUSES_IGNORE for use of true MPI_STATUSES_IGNORE
!
!-------------------------------------------------------------------------------
!
@@ -188,10 +189,11 @@ CONTAINS
MPI_PRECISION = MNH_MPI_REAL
MPI_2PRECISION = MNH_MPI_2REAL
!
- ! For bug with intelmpi+ilp64+i8 declare MNH_STATUSES_INGORE
+ ! For bug with intelmpi+ilp64+i8 declare MNH_STATUSES_IGNORE
!
- ALLOCATE(MNH_STATUSES_IGNORE(MPI_STATUS_SIZE,NPROC))
- !MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
+#ifndef MNH_USE_MPI_STATUSES_IGNORE
+ ALLOCATE(MNH_STATUSES_IGNORE(MPI_STATUS_SIZE,NPROC*2))
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index b5c4b84a3342e8c050b71238f4d30a08f5d04bbc..60d3ddde528c16ac6356c9509dbcddbacd8c23a3 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -82,6 +82,7 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
!! M. Chong * LA * Juin 2010 : add LiNOx
!! C. Barthe * LACy * Jan. 2015 : convert trig. pt into lat,lon in ascii file
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
+!! J.Escobar : 28/03/2018 : Correction of multiple // bug & compiler indepedent mnh_random_number
!!
!-------------------------------------------------------------------------------
!
@@ -126,6 +127,7 @@ USE MODE_PACK_PGI
USE MODE_ll
USE MODE_ELEC_ll
USE MODE_GRIDPROJ
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -265,7 +267,6 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMODULE ! Electric field module (V/m)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIST ! distance between the trig. pt and the cell pts (m)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGLOB ! sum of the cross sections
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQFLASH ! total charge in excess of xqexcess (C/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_TRIG ! Global coordinates of triggering point
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_SEG ! Global coordinates of segments
REAL, DIMENSION(:), ALLOCATABLE :: ZEM_TRIG ! Electric field module at the triggering pt
@@ -299,6 +300,11 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLNOX
REAL :: ZLGHTLENGTH, ZCOEF
INTEGER :: IFLASH_COUNT, IFLASH_COUNT_GLOB ! Total number of flashes within the timestep
!
+REAL,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZCELL_NEW
+!
+INTEGER :: ILJ
+INTEGER :: NIMAX_ll, NJMAX_ll ! dimensions of global domain
+!
!-------------------------------------------------------------------------------
!
!* 1. INITIALIZATION
@@ -314,6 +320,7 @@ IKE = SIZE(PRT,3) - JPVEXT
IKU = SIZE(PRT,3)
!
! global indexes of the local subdomains origin
+CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
CALL GET_OR_ll('B',IXOR,IYOR)
!
!
@@ -368,6 +375,7 @@ ALLOCATE (ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (GPOSS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZEMODULE(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
ALLOCATE (ZCELL(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMAX_CELL))
+
!
ZQMT(:,:,:,:) = 0.
ZQMTOT(:,:,:) = 0.
@@ -431,8 +439,17 @@ GEND_CELL = .FALSE.
INB_CELL = 0
ZE_TRIG_THRES = XETRIG * (1. - XEBALANCE)
!
+CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
+ PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
+ PRT(:,:,:,5),PRT(:,:,:,6))
+CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
+ ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
+ ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
+
CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
PEFIELDU, PEFIELDV, PEFIELDW)
+CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
+ PEFIELDU, PEFIELDV, PEFIELDW)
!
! electric field module including pressure effect
ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
@@ -456,11 +473,12 @@ DO WHILE (.NOT. GEND_DOMAIN .AND. INB_CELL .LT. NMAX_CELL)
INB_CELL = INB_CELL + 1 ! one cell is detected
ZEMAX(INB_CELL) = ZMAXE
! local coordinates of the maximum electric field
- ICELL_LOC(1:3,INB_CELL) = MAXLOC(ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE), &
- MASK=GPOSS(IIB:IIE,IJB:IJE,IKB:IKE))
+ ICELL_LOC(1:3,INB_CELL) = MAXLOC(ZEMODULE, MASK=GPOSS )
IICOORD = ICELL_LOC(1,INB_CELL)
IJCOORD = ICELL_LOC(2,INB_CELL)
- IKCOORD = ICELL_LOC(3,INB_CELL)
+ ICELL_LOC(1,INB_CELL) = IICOORD + IXOR -1
+ ICELL_LOC(2,INB_CELL) = IJCOORD + IYOR -1
+ IKCOORD = ICELL_LOC(3,INB_CELL)
ICELL_LOC(4,INB_CELL) = IPROC_CELL
!
! Broadcast the center of the cell to all procs
@@ -490,6 +508,7 @@ DO WHILE (.NOT. GEND_DOMAIN .AND. INB_CELL .LT. NMAX_CELL)
COUNT_BEF = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
CALL SUM_ELEC_ll (COUNT_BEF)
!
+ ZCELL_NEW = ZCELL(:,:,IK,INB_CELL)
DO II = IIB, IIE
DO IJ = IJB, IJE
IF ((ZCELL(II,IJ,IK,INB_CELL) .EQ. 0.) .AND. &
@@ -509,12 +528,13 @@ DO WHILE (.NOT. GEND_DOMAIN .AND. INB_CELL .LT. NMAX_CELL)
(ZCELL(II-1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
(ZCELL(II+1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
(ZCELL(II+1,IJ-1,IK,INB_CELL) .EQ. 1.)) THEN
- ZCELL(II,IJ,IK,INB_CELL) = 1.
GPOSS(II,IJ,IK) = .FALSE.
+ ZCELL_NEW(II,IJ) = 1.
END IF
END IF
END DO
END DO
+ ZCELL(:,:,IK,INB_CELL) = ZCELL_NEW
!
COUNT_AFT = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
CALL SUM_ELEC_ll(COUNT_AFT)
@@ -705,6 +725,17 @@ IF (INB_CELL .GE. 1) THEN
!
IF (KRR == 7) ZSIGLOB(:,:,:) = ZSIGLOB(:,:,:) + ZSIGMA(:,:,:,6)
!
+IF (KRR == 7) THEN
+ CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH",PRECISION,&
+ ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,&
+ ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
+ ZSIGMA(:,:,:,5),ZSIGMA(:,:,:,6))
+ELSE
+ CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG",PRECISION,&
+ ZLBDAR,ZLBDAS,ZLBDAG,&
+ ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
+ ZSIGMA(:,:,:,5))
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -759,6 +790,9 @@ IF (INB_CELL .GE. 1) THEN
!
GCG = .FALSE.
GCG_POS = .FALSE.
+
+ CALL MPPDB_CHECK3DM("flash:: 4. ZFLASH(IL)",PRECISION,&
+ ZFLASH(:,:,:,IL))
!
!
!-------------------------------------------------------------------------------
@@ -800,6 +834,9 @@ IF (INB_CELL .GE. 1) THEN
ZEM_TRIG(IL) = ZEM_TRIG(IL)/ZPRES_COEF(IIBL_LOC,IJBL_LOC,IKBL)
ENDIF
ENDIF
+
+ CALL MPPDB_CHECK3DM("flash:: 5. ZFLASH(IL)",PRECISION,&
+ ZFLASH(:,:,:,IL))
!
CALL MPI_BCAST (GNEW_FLASH(IL),1, MPI_LOGICAL, IPROC_TRIG(IL), &
NMNH_COMM_WORLD, IERR)
@@ -953,11 +990,9 @@ IF (INB_CELL .GE. 1) THEN
!
!* 8.3 distribute the branches
!
- ALLOCATE (ZWORK(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
!
CALL BRANCH_GEOM(IKB, IKE)
!
- DEALLOCATE (ZWORK)
DEALLOCATE (IMAX_BRANCH)
DEALLOCATE (IMASKQ_DIST)
END IF ! end if count(gprop)
@@ -967,6 +1002,8 @@ IF (INB_CELL .GE. 1) THEN
!
!* 9. NEUTRALIZATION
! --------------
+ CALL MPPDB_CHECK3DM("flash:: 9. ZQMTOT",PRECISION,ZQMTOT)
+ CALL MPPDB_CHECK3DM("flash:: 9. ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
!
!* 9.1 charge carried by the lightning flash
!
@@ -1018,6 +1055,9 @@ IF (INB_CELL .GE. 1) THEN
!
!* 9.4 charge neutralization
!
+ CALL MPPDB_CHECK3DM("flash:: 9.4 ZQFLASH,ZSIGLOB",PRECISION,&
+ ZQFLASH,ZSIGLOB)
+
ZDQDT(:,:,:,:) = 0.
!
IF (GNEUTRALIZATION) THEN
@@ -1111,6 +1151,13 @@ IF (INB_CELL .GE. 1) THEN
!
!* 9.6 update the source term
!
+ CALL MPPDB_CHECK3DM("flash:: 9.6 PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+ CALL MPPDB_CHECK3DM("flash:: 9.6 ZDQDT",PRECISION,&
+ ZDQDT(:,:,:,1),ZDQDT(:,:,:,2),ZDQDT(:,:,:,3),ZDQDT(:,:,:,4),&
+ ZDQDT(:,:,:,5),ZDQDT(:,:,:,6),ZDQDT(:,:,:,7))
+
DO II = IIB, IIE
DO IJ = IJB, IJE
DO IK = IKB, IKE
@@ -1318,6 +1365,11 @@ IF (INB_CELL .GE. 1) THEN
!* 11.1 ion attachment
!
IF (INB_NEUT_OK .NE. 0) THEN
+
+ CALL MPPDB_CHECK3DM("flash:: PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+
PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE
PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) / XECHARGE
!
@@ -1333,6 +1385,10 @@ IF (INB_CELL .GE. 1) THEN
!
PRSVS(:,:,:,1) = PRSVS(:,:,:,1) * XECHARGE
PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) * XECHARGE
+
+ CALL MPPDB_CHECK3DM("flash:: after ION PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
ENDIF
!
!
@@ -1356,8 +1412,16 @@ IF (INB_CELL .GE. 1) THEN
IF ((MAXVAL(INB_FLASH(:))+1) < INBFTS_MAX) THEN
IF (INB_NEUT_OK .NE. 0) THEN
+ CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
+ PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
+ PRT(:,:,:,5),PRT(:,:,:,6))
+ CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
+ ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
+ ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
PEFIELDU, PEFIELDV, PEFIELDW)
+ CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
+ PEFIELDU, PEFIELDV, PEFIELDW)
! electric field module including pressure effect
ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
(PEFIELDU(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
@@ -1561,13 +1625,13 @@ DO IL = 1, INB_CELL
DO WHILE (IFOUND .NE. 1)
!
! random choice of the 3 global ind.
- CALL RANDOM_NUMBER(ZRANDOM)
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
II_TRIG_GLOB = IWEST_GLOB_TRIG + &
INT(ANINT(ZRANDOM * (IEAST_GLOB_TRIG - IWEST_GLOB_TRIG)))
- CALL RANDOM_NUMBER(ZRANDOM)
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
IJ_TRIG_GLOB = ISOUTH_GLOB_TRIG + &
INT(ANINT(ZRANDOM * (INORTH_GLOB_TRIG - ISOUTH_GLOB_TRIG)))
- CALL RANDOM_NUMBER(ZRANDOM)
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
IK_TRIG = IDOWN_TRIG + INT(ANINT(ZRANDOM * (IUP_TRIG - IDOWN_TRIG)))
!
! global ind. --> local ind. of the potential triggering pt
@@ -1665,6 +1729,7 @@ INTEGER :: IKSTEP, IIDECAL
!
!* 1. BUILD THE POSITIVE/NEGATIVE LEADER
! ----------------------------------
+CALL MPPDB_CHECK3DM("flash:: one_leader ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
!
IKSTEP = ISIGN_LEADER * ISIGNE_EZ(IL)
! the positive leader propagates parallel to the electric field
@@ -1815,6 +1880,7 @@ CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
CALL MPI_BCAST (ITYPE(IL), 1, &
MPI_INTEGER, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
!
+CALL MPPDB_CHECK3DM("flash:: one_leader end ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
!
END SUBROUTINE ONE_LEADER
!
@@ -1831,7 +1897,8 @@ END SUBROUTINE ONE_LEADER
!
IMPLICIT NONE
!
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZSIGN_AREA
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZSIGN_AREA,ZSIGN_AREA_NEW
+
REAL, DIMENSION(INB_CELL) :: ZSIGN ! sign of the charge immediatly below/above the triggering pt
!
INTEGER, DIMENSION(INB_CELL) :: IEND ! if 1, no more neighbour pts meeting the conditions
@@ -1911,6 +1978,7 @@ DO WHILE (IEND_GLOB .NE. INB_CELL)
ENDIF
ENDIF
!
+ ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX) = ZSIGN_AREA (:,:,IKMIN:IKMAX)
DO II = IIB, IIE
DO IJ = IJB, IJE
DO IK = IKMIN, IKMAX
@@ -1947,13 +2015,14 @@ DO WHILE (IEND_GLOB .NE. INB_CELL)
(ZSIGN_AREA(II-1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
(ZSIGN_AREA(II+1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
(ZSIGN_AREA(II+1,IJ-1,IK-1) .EQ. ZSIGN(IL))) THEN
- ZSIGN_AREA(II,IJ,IK) = ZSIGN(IL)
+ ZSIGN_AREA_NEW(II,IJ,IK) = ZSIGN(IL)
GPROP(II,IJ,IK,IL) = .TRUE.
END IF
END IF
END DO
END DO
END DO
+ ZSIGN_AREA (:,:,IKMIN:IKMAX) = ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX)
!
COUNT_AFT2(IL) = COUNT(ZSIGN_AREA(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. ZSIGN(IL))
CALL SUM_ELEC_ll(COUNT_AFT2(IL))
@@ -1963,7 +2032,6 @@ DO WHILE (IEND_GLOB .NE. INB_CELL)
ELSE
IEND(IL) = 0
END IF
-
! broadcast IEND and find the proc where IEND = 1
CALL MAX_ELEC_ll (IEND(IL), IPROC_END)
IEND_GLOB = IEND_GLOB + IEND(IL)
@@ -2001,10 +2069,18 @@ LOGICAL :: GRANDOM ! T = the gridpoints are chosen randomly
INTEGER, DIMENSION(NPROC) :: INBPT_PROC
REAL, DIMENSION(:), ALLOCATABLE :: ZAUX
!
+INTEGER*8, DIMENSION(:), ALLOCATABLE :: I8VECT , I8VECT_LL
+INTEGER , DIMENSION(:), ALLOCATABLE :: IRANK , IRANK_LL , IORDER_LL
+INTEGER :: JI,JJ,JK,JIL , ICHOICE,IPOINT
+INTEGER, DIMENSION(NPROC+1) :: IDISPL
+!
+!
!
!* 1. ON EACH PROC, COUNT THE NUMBER OF POINTS AT DISTANCE D
!* THAT CAN RECEIVE A BRANCH
! ------------------------------------------------------
+CALL MPPDB_CHECK3DM("flash:: branch ZFLASH,IMASKQ_DIST",PRECISION,&
+ ZFLASH(:,:,:,IL),IMASKQ_DIST*1.0)
!
IM = 1
ISTOP = 0
@@ -2055,73 +2131,64 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
CALL MPI_ALLGATHER(IPT_DIST, 1, MPI_INTEGER, &
INBPT_PROC, 1, MPI_INTEGER, NMNH_COMM_WORLD, IERR)
!
- IF (IPROC .EQ. 0) THEN
- IF (INBPT_PROC(1) .NE. 0) THEN
- IMIN = 1
- IMAX = INBPT_PROC(1)
- ELSE
- IMIN = 0
- IMAX = 0
- END IF
- ELSE
- IF (INBPT_PROC(IPROC+1) .NE. 0) THEN
- IMIN = SUM(INBPT_PROC(1:IPROC)) + 1
- IMAX = SUM(INBPT_PROC(1:IPROC+1))
- ELSE
- IMIN = 0
- IMAX = 0
- END IF
- END IF
+ IDISPL(1) = 0
+ DO JI=2, NPROC+1
+ IDISPL(JI) = IDISPL(JI-1)+INBPT_PROC(JI-1)
+ ENDDO
!
- ZWORK(:,:,:) = 0.
+ ALLOCATE (I8VECT(IPT_DIST))
+ ALLOCATE (IRANK(IPT_DIST))
IF (IPT_DIST .GT. 0) THEN
- WHERE (IMASKQ_DIST(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. IM)
- ZWORK(IIB:IIE,IJB:IJE,IKB:IKE) = 1.
- END WHERE
-!
- ALLOCATE (ZVECT(IPT_DIST))
- ALLOCATE (ZAUX(IPT_DIST))
- ZVECT(:) = PACK(ZWORK(:,:,:), MASK=(IMASKQ_DIST(:,:,:).EQ.IM))
- ZVECT(:) = 0.
- ZAUX(:) = 0.
- DO II = 1, IPT_DIST
- ZVECT(II) = REAL(IMIN + II - 1)
- END DO
+ JIL=0
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (IMASKQ_DIST(JI,JJ,JK) .EQ. IM) THEN
+ JIL = JIL + 1
+ I8VECT(JIL) = NJMAX_ll*NIMAX_ll*(JK-1) + NIMAX_ll*(IYOR+JJ-1) + (IXOR+JI-1)
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ IRANK(:) = IPROC
END IF
+!
+ ALLOCATE(I8VECT_LL(IPT_DIST_GLOB))
+ ALLOCATE(IRANK_LL(IPT_DIST_GLOB))
+ ALLOCATE(IORDER_LL(IPT_DIST_GLOB))
+ CALL MPI_ALLGATHERV(I8VECT,IPT_DIST, MPI_INTEGER8,I8VECT_LL , &
+ INBPT_PROC, IDISPL, MPI_INTEGER8, NMNH_COMM_WORLD, IERR)
+ CALL MPI_ALLGATHERV(IRANK,IPT_DIST, MPI_INTEGER,IRANK_LL , &
+ INBPT_PROC, IDISPL, MPI_INTEGER, NMNH_COMM_WORLD, IERR)
+ CALL N8QUICK_SORT(I8VECT_LL, IORDER_LL)
!
DO IPOINT = 1, MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
- IFOUND = 0
- DO WHILE (IFOUND .NE. 1)
-! randomly chose points in zvect
- CALL RANDOM_NUMBER(ZRANDOM)
- ICHOICE = INT(ANINT(ZRANDOM * IPT_DIST_GLOB))
- IF (ICHOICE .EQ. 0) ICHOICE = 1
- DO II = 1, IPT_DIST
- IF (ZVECT(II) .EQ. ICHOICE) THEN
- ZVECT(II) = 0.
- IFOUND = 1
- END IF
- END DO
- CALL SUM_ELEC_ll(IFOUND)
- END DO
+ IFOUND = 0
+ DO WHILE (IFOUND .NE. 1)
+ ! randomly chose points in zvect
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
+ ICHOICE = INT(ANINT(ZRANDOM * IPT_DIST_GLOB))
+ IF (ICHOICE .EQ. 0) ICHOICE = 1
+ IF (I8VECT_LL(ICHOICE) .NE. 0 ) THEN
+ IFOUND = 1
+ ! The points is in this processors , get is coord and set it
+ IF (IRANK_LL(IORDER_LL(ICHOICE)) .EQ. IPROC) THEN
+ JK = I8VECT_LL(ICHOICE) / ( NJMAX_ll*NIMAX_ll ) +1
+ JJ = ( I8VECT_LL(ICHOICE) - NJMAX_ll*NIMAX_ll*(JK-1) ) / NIMAX_ll - IYOR +1
+ JI = MOD(I8VECT_LL(ICHOICE),NIMAX_ll) - IXOR +1
+ ZFLASH(JI,JJ,JK,IL) = 2.
+ END IF
+ I8VECT_LL(ICHOICE) = 0.
+ ENDIF
+ END DO
END DO
!
INB_SEG_TO_BRANCH = INB_SEG_TO_BRANCH - MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
!
- IF (IPT_DIST .GT. 0) THEN
- WHERE (ZVECT(:) .EQ. 0.)
- ZAUX(:) = 1.
- END WHERE
-!
- ZWORK(:,:,:) = 0.
- ZWORK(:,:,:) = UNPACK(ZAUX(:), MASK=(IMASKQ_DIST(:,:,:).EQ.IM), FIELD=0.0)
- WHERE (ZWORK(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. 1.)
- ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 2.
- ZCELL(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 0.
- END WHERE
- DEALLOCATE (ZVECT)
- DEALLOCATE (ZAUX)
- ENDIF
+ DEALLOCATE(I8VECT,I8VECT_LL,IRANK,IRANK_LL,IORDER_LL)
+ CALL MPPDB_CHECK3DM("flash:: branch IPT_DIST ZFLASH",PRECISION,&
+ ZFLASH(:,:,:,IL))
END IF
END IF !IPT_DIST .LE. IMAX_BRANCH(IM)
ELSE
@@ -2130,6 +2197,7 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
END IF ! end if ipt_dist > 0
!
! next distance
+ CALL MPPDB_CHECK3DM("flash:: branch IM+1 ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
IM = IM + 1
END DO ! end loop / do while / radius IM
!
@@ -2157,6 +2225,8 @@ IF (INB_SEG_AFT .GT. INB_SEG_BEF) THEN
END DO
END IF
!
+CALL MPPDB_CHECK3DM("flash:: end branch ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+!
END SUBROUTINE BRANCH_GEOM
!
!--------------------------------------------------------------------------------
@@ -2520,6 +2590,245 @@ END SUBROUTINE WRITE_OUT_LMA
!
!-------------------------------------------------------------------------------
!
+RECURSIVE SUBROUTINE N8QUICK_SORT(PLIST, KORDER)
+
+! Quick sort routine from:
+! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to
+! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150.
+! Modified by Alan Miller to include an associated integer array which gives
+! the positions of the elements in the original order.
+!
+IMPLICIT NONE
+!
+INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST
+INTEGER, DIMENSION (:), INTENT(OUT) :: KORDER
+!
+! Local variable
+INTEGER :: JI
+
+DO JI = 1, SIZE(PLIST)
+ KORDER(JI) = JI
+END DO
+
+CALL N8QUICK_SORT_1(1, SIZE(PLIST), PLIST, KORDER)
+
+END SUBROUTINE N8QUICK_SORT
+!
+!-------------------------------------------------------------------------------
+!
+RECURSIVE SUBROUTINE N8QUICK_SORT_1(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST1
+INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER1
+! Local variables
+INTEGER :: JI, JJ, ITEMP
+INTEGER*8 :: ZREF, ZTEMP
+INTEGER, PARAMETER :: IMAX_SIMPLE_SORT_SIZE = 6
+
+IF (KRIGHT_END < KLEFT_END + IMAX_SIMPLE_SORT_SIZE) THEN
+ ! Use interchange sort for small PLISTs
+ CALL N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
+ !
+ELSE
+ !
+ ! Use partition ("quick") sort
+ ! valeur au centre du tableau
+ ZREF = PLIST1((KLEFT_END + KRIGHT_END)/2)
+ JI = KLEFT_END - 1
+ JJ = KRIGHT_END + 1
+
+ DO
+ ! Scan PLIST from left end until element >= ZREF is found
+ DO
+ JI = JI + 1
+ IF (PLIST1(JI) >= ZREF) EXIT
+ END DO
+ ! Scan PLIST from right end until element <= ZREF is found
+ DO
+ JJ = JJ - 1
+ IF (PLIST1(JJ) <= ZREF) EXIT
+ END DO
+
+
+ IF (JI < JJ) THEN
+ ! Swap two out-of-order elements
+ ZTEMP = PLIST1(JI)
+ PLIST1(JI) = PLIST1(JJ)
+ PLIST1(JJ) = ZTEMP
+ ITEMP = KORDER1(JI)
+ KORDER1(JI) = KORDER1(JJ)
+ KORDER1(JJ) = ITEMP
+ ELSE IF (JI == JJ) THEN
+ JI = JI + 1
+ EXIT
+ ELSE
+ EXIT
+ END IF
+ END DO
+
+ IF (KLEFT_END < JJ) CALL N8QUICK_SORT_1(KLEFT_END, JJ, PLIST1, KORDER1)
+ IF (JI < KRIGHT_END) CALL N8QUICK_SORT_1(JI, KRIGHT_END,PLIST1,KORDER1)
+END IF
+
+END SUBROUTINE N8QUICK_SORT_1
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST2, KORDER2)
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST2
+INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER2
+! Local variables
+INTEGER :: JI, JJ, ITEMP
+INTEGER*8 :: ZTEMP
+
+! boucle sur tous les points
+DO JI = KLEFT_END, KRIGHT_END - 1
+ !
+ ! boucle sur les points suivants le point JI
+ DO JJ = JI+1, KRIGHT_END
+ !
+ ! si la distance de JI au point est plus grande que celle de JJ
+ IF (PLIST2(JI) > PLIST2(JJ)) THEN
+ ! distance de JI au point (la plus grande)
+ ZTEMP = PLIST2(JI)
+ ! le point JJ est déplacé à l'indice JI dans le tableau
+ PLIST2(JI) = PLIST2(JJ)
+ ! le point JI est déplacé à l'indice JJ dans le tableau
+ PLIST2(JJ) = ZTEMP
+ ! indice du point JI dans le tableau
+ ITEMP = KORDER2(JI)
+ ! l'indice du point JJ est mis à la place JI
+ KORDER2(JI) = KORDER2(JJ)
+ ! l'indice du point JI est mis à la place JJ
+ KORDER2(JJ) = ITEMP
+ END IF
+ !
+ END DO
+ !
+END DO
+
+END SUBROUTINE N8INTERCHANGE_SORT
+!-------------------------------------------------------------------------------
+ SUBROUTINE MNH_RANDOM_NUMBER(ZRANDOM)
+
+ REAL :: ZRANDOM
+ INTEGER ,SAVE :: NSEED_MNH = 26032012
+
+ ZRANDOM = r8_uniform_01 (NSEED_MNH)
+
+ END SUBROUTINE MNH_RANDOM_NUMBER
+
+!------------------------------------------------------------------------------------------
+
+ FUNCTION r8_uniform_01 ( seed )
+
+ !*****************************************************************************80
+ !
+ !! R8_UNIFORM_01 returns a unit pseudorandom R8.
+ !
+ ! Discussion:
+ !
+ ! An R8 is a real ( kind = 8 ) value.
+ !
+ ! For now, the input quantity SEED is an integer variable.
+ !
+ ! This routine implements the recursion
+ !
+ ! seed = ( 16807 * seed ) mod ( 2^31 - 1 )
+ ! r8_uniform_01 = seed / ( 2^31 - 1 )
+ !
+ ! The integer arithmetic never requires more than 32 bits,
+ ! including a sign bit.
+ !
+ ! If the initial seed is 12345, then the first three computations are
+ !
+ ! Input Output R8_UNIFORM_01
+ ! SEED SEED
+ !
+ ! 12345 207482415 0.096616
+ ! 207482415 1790989824 0.833995
+ ! 1790989824 2035175616 0.947702
+ !
+ ! Licensing:
+ !
+ ! This code is distributed under the GNU LGPL license.
+ ! Souce here : https://people.sc.fsu.edu/~jburkardt/f_src/uniform/uniform.f90
+ !
+ ! Modified:
+ !
+ ! 31 May 2007
+ !
+ ! Author:
+ !
+ ! John Burkardt
+ !
+ ! Reference:
+ !
+ ! Paul Bratley, Bennett Fox, Linus Schrage,
+ ! A Guide to Simulation,
+ ! Second Edition,
+ ! Springer, 1987,
+ ! ISBN: 0387964673,
+ ! LC: QA76.9.C65.B73.
+ !
+ ! Bennett Fox,
+ ! Algorithm 647:
+ ! Implementation and Relative Efficiency of Quasirandom
+ ! Sequence Generators,
+ ! ACM Transactions on Mathematical Software,
+ ! Volume 12, Number 4, December 1986, pages 362-376.
+ !
+ ! Pierre L'Ecuyer,
+ ! Random Number Generation,
+ ! in Handbook of Simulation,
+ ! edited by Jerry Banks,
+ ! Wiley, 1998,
+ ! ISBN: 0471134031,
+ ! LC: T57.62.H37.
+ !
+ ! Peter Lewis, Allen Goodman, James Miller,
+ ! A Pseudo-Random Number Generator for the System/360,
+ ! IBM Systems Journal,
+ ! Volume 8, Number 2, 1969, pages 136-143.
+ !
+ ! Parameters:
+ !
+ ! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which should
+ ! NOT be 0. On output, SEED has been updated.
+ !
+ ! Output, real ( kind = 8 ) R8_UNIFORM_01, a new pseudorandom variate,
+ ! strictly between 0 and 1.
+ !
+ IMPLICIT NONE
+
+ INTEGER ( kind = 4 ), PARAMETER :: i4_huge = 2147483647
+ INTEGER ( kind = 4 ) k
+ REAL r8_uniform_01
+ INTEGER ( kind = 4 ) seed
+
+ IF ( seed == 0 ) THEN
+ WRITE ( *, '(a)' ) ' '
+ WRITE ( *, '(a)' ) 'R8_UNIFORM_01 - Fatal error!'
+ WRITE ( *, '(a)' ) ' Input value of SEED = 0.'
+ STOP 1
+ END IF
+
+ k = seed / 127773
+
+ seed = 16807 * ( seed - k * 127773 ) - k * 2836
+
+ IF ( seed < 0 ) THEN
+ seed = seed + i4_huge
+ END IF
+
+ r8_uniform_01 = REAL ( seed ) * 4.656612875D-10
+
+ RETURN
+ END FUNCTION r8_uniform_01
+!
END SUBROUTINE FLASH_GEOM_ELEC_n
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index 8d2031dcea845ff4b376103fc94e7d854cf902fd..51185a2d8b433d21773b1e7cdcd33f877aa83872 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -149,6 +149,7 @@ END MODULE MODI_SPAWN_FIELD2
!! 29/04/2016 (J.Escobar) bug in use of ZSVT_C in SET_LSFIELD_1WAY_ll
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification 05/03/2018 (J.Escobar) bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -305,90 +306,90 @@ END IF
! ---------------------------------------------------------
!
!
-IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
-!
-!* 2.1 special case of spawning - no change of resolution :
-!
-!* 2.1.1 variables which always exist
-!
- PUT (:,:,:) = XUT1(KXOR:KXEND,KYOR:KYEND,:)
- PVT (:,:,:) = XVT1(KXOR:KXEND,KYOR:KYEND,:)
- PWT (:,:,:) = XWT1(KXOR:KXEND,KYOR:KYEND,:)
- PTHVT(:,:,:) = ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
-!
- PLSUM (:,:,:) = PUT(:,:,:)
- PLSVM (:,:,:) = PVT(:,:,:)
- PLSWM (:,:,:) = PWT(:,:,:)
- PLSTHM(:,:,:) = XTHT1(KXOR:KXEND,KYOR:KYEND,:)
-!
- PLSRVM(:,:,:) = 0.
-!
-!$20140707
-CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
-CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
-!$
-!* 2.1.2 TKE variable
-!
- IF (HTURB /= 'NONE') THEN
- PTKET(:,:,:) = XTKET1(KXOR:KXEND,KYOR:KYEND,:)
- ENDIF
-!
-!* 2.1.3 moist variables
-!
- IF (CONF_MODEL(1)%NRR /= 0) THEN
- PRT (:,:,:,:) = XRT1 (KXOR:KXEND,KYOR:KYEND,:,:)
- PLSRVM(:,:,:) = XRT1 (KXOR:KXEND,KYOR:KYEND,:,1)
- PHUT (:,:,:) = ZHUT (KXOR:KXEND,KYOR:KYEND,:)
- ENDIF
-!
-!* 2.1.4 scalar variables
-!
- IF (NSV /= 0) THEN
- PSVT (:,:,:,:) = FIELD_MODEL(1)%XSVT (KXOR:KXEND,KYOR:KYEND,:,:)
- ENDIF
-!
-!* 2.1.5 secondary prognostic variables
-!
- IF (CONF_MODEL(1)%NRR > 1) THEN
- PSRCT(:,:,:) = XSRCT1 (KXOR:KXEND,KYOR:KYEND,:)
- PSIGS(:,:,:) = XSIGS1(KXOR:KXEND,KYOR:KYEND,:)
- ENDIF
-!
-!* 2.1.6 Large scale variables
-!
- PLSUM (:,:,:) = XLSUM1 (KXOR:KXEND,KYOR:KYEND,:)
- PLSVM (:,:,:) = XLSVM1 (KXOR:KXEND,KYOR:KYEND,:)
- PLSWM (:,:,:) = XLSWM1 (KXOR:KXEND,KYOR:KYEND,:)
- PLSTHM(:,:,:) = XLSTHM1 (KXOR:KXEND,KYOR:KYEND,:)
- IF ( CONF_MODEL(1)%NRR > 0 ) THEN
- PLSRVM (:,:,:) = XLSRVM1 (KXOR:KXEND,KYOR:KYEND,:)
- END IF
-!
-!* 2.1.7 Advective forcing fields for 2D (Modif MT)
-!
- IF (L2D_ADV_FRC) THEN
- PDTHFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDTHFRC (KXOR:KXEND,KYOR:KYEND,:,:)
- PDRVFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDRVFRC (KXOR:KXEND,KYOR:KYEND,:,:)
- ENDIF
- IF (L2D_REL_FRC) THEN
- PTHREL(:,:,:,:)= RELFRC_MODEL(1)%XTHREL (KXOR:KXEND,KYOR:KYEND,:,:)
- PRVREL(:,:,:,:)= RELFRC_MODEL(1)%XRVREL (KXOR:KXEND,KYOR:KYEND,:,:)
- ENDIF
-!
-!* 2.1.8 Turbulent fluxes for 2D (Modif MT)
-!
- IF (LUV_FLX) THEN
- PVU_FLUX_M(:,:,:)= XVU_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
- END IF
-!
- IF (LTH_FLX) THEN
- PVTH_FLUX_M(:,:,:)= XVTH_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
- PWTH_FLUX_M(:,:,:)= XWTH_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-ELSE
+!!$IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
+!!$!
+!!$!* 2.1 special case of spawning - no change of resolution :
+!!$!
+!!$!* 2.1.1 variables which always exist
+!!$!
+!!$ PUT (:,:,:) = FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PVT (:,:,:) = FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PWT (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PTHVT(:,:,:) = ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
+!!$!
+!!$ PLSUM (:,:,:) = FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSVM (:,:,:) = FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSWM (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSTHM(:,:,:) = FIELD_MODEL(1)%XTHT(KXOR:KXEND,KYOR:KYEND,:)
+!!$!
+!!$ PLSRVM(:,:,:) = 0.
+!!$!
+!!$!$20140707
+!!$CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
+!!$CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
+!!$!$
+!!$!* 2.1.2 TKE variable
+!!$!
+!!$ IF (HTURB /= 'NONE') THEN
+!!$ PTKET(:,:,:) = FIELD_MODEL(1)%XTKET(KXOR:KXEND,KYOR:KYEND,:)
+!!$ ENDIF
+!!$!
+!!$!* 2.1.3 moist variables
+!!$!
+!!$ IF (CONF_MODEL(1)%NRR /= 0) THEN
+!!$ PRT (:,:,:,:) = FIELD_MODEL(1)%XRT (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ PLSRVM(:,:,:) = FIELD_MODEL(1)%XRT (KXOR:KXEND,KYOR:KYEND,:,1)
+!!$ PHUT (:,:,:) = ZHUT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ ENDIF
+!!$!
+!!$!* 2.1.4 scalar variables
+!!$!
+!!$ IF (NSV /= 0) THEN
+!!$ PSVT (:,:,:,:) = FIELD_MODEL(1)%XSVT (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ ENDIF
+!!$!
+!!$!* 2.1.5 secondary prognostic variables
+!!$!
+!!$ IF (CONF_MODEL(1)%NRR > 1) THEN
+!!$ PSRCT (:,:,:) = FIELD_MODEL(1)%XSRCT (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PSIGS(:,:,:) = FIELD_MODEL(1)%XSIGS(KXOR:KXEND,KYOR:KYEND,:)
+!!$ ENDIF
+!!$!
+!!$!* 2.1.6 Large scale variables
+!!$!
+!!$ PLSUM (:,:,:) = LSFIELD_MODEL(1)%XLSUM (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSVM (:,:,:) = LSFIELD_MODEL(1)%XLSVM (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSWM (:,:,:) = LSFIELD_MODEL(1)%XLSWM (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PLSTHM(:,:,:) = LSFIELD_MODEL(1)%XLSTHM (KXOR:KXEND,KYOR:KYEND,:)
+!!$ IF ( CONF_MODEL(1)%NRR > 0 ) THEN
+!!$ PLSRVM (:,:,:) = LSFIELD_MODEL(1)%XLSRVM (KXOR:KXEND,KYOR:KYEND,:)
+!!$ END IF
+!!$!
+!!$!* 2.1.7 Advective forcing fields for 2D (Modif MT)
+!!$!
+!!$ IF (L2D_ADV_FRC) THEN
+!!$ PDTHFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDTHFRC (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ PDRVFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDRVFRC (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ ENDIF
+!!$ IF (L2D_REL_FRC) THEN
+!!$ PTHREL(:,:,:,:)= RELFRC_MODEL(1)%XTHREL (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ PRVREL(:,:,:,:)= RELFRC_MODEL(1)%XRVREL (KXOR:KXEND,KYOR:KYEND,:,:)
+!!$ ENDIF
+!!$!
+!!$!* 2.1.8 Turbulent fluxes for 2D (Modif MT)
+!!$!
+!!$ IF (LUV_FLX) THEN
+!!$ PVU_FLUX_M(:,:,:)= EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
+!!$ END IF
+!!$!
+!!$ IF (LTH_FLX) THEN
+!!$ PVTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XVTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
+!!$ PWTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XWTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
+!!$ END IF
+!!$!
+!!$!-------------------------------------------------------------------------------
+!!$!
+!!$ELSE
!
!-------------------------------------------------------------------------------
!
@@ -702,7 +703,7 @@ ELSE
CALL MPPDB_CHECK3D(PWTH_FLUX_M,"SPAWN_FIELD2:PWTH_FLUX_M",PRECISION)
ENDIF
!
-END IF
+!!$END IF
!
IF (CONF_MODEL(1)%NRR>=3) THEN
WHERE (PRT(:,:,:,3)<1.E-20)
diff --git a/src/MNH/spawn_grid2.f90 b/src/MNH/spawn_grid2.f90
index 3a12eae81b52d2f589045de288e7dc5d9821cb48..25f6aa1b46727aae81c911838399cf12f7fb1eef 100644
--- a/src/MNH/spawn_grid2.f90
+++ b/src/MNH/spawn_grid2.f90
@@ -146,6 +146,7 @@ END MODULE MODI_SPAWN_GRID2
!! Modification 10/06/15 (M.Moge) bug fix for reproductibility
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 05/03/2018 : bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -306,18 +307,18 @@ OSLEVE = LSLEVE1
PLEN1 = XLEN11
PLEN2 = XLEN21
!
-IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
-!
-!* 2.1 special case of spawning - no change of resolution :
-!$ in our case we don't get them here !
- PXHAT(:) = XXHAT1(KXOR:KXEND)
- PYHAT(:) = XYHAT1(KYOR:KYEND)
- PZS (:,:) = XZS1 (KXOR:KXEND,KYOR:KYEND)
- PZS_LS(:,:)= XZS1 (KXOR:KXEND,KYOR:KYEND)
- PZSMT (:,:) = XZSMT1(KXOR:KXEND,KYOR:KYEND)
- PZSMT_LS(:,:) = XZSMT1(KXOR:KXEND,KYOR:KYEND)
-!
-ELSE
+!!$IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
+!!$!
+!!$!* 2.1 special case of spawning - no change of resolution :
+!!$!$ in our case we don't get them here !
+!!$ PXHAT(:) = GRID_MODEL(1)%XXHAT(KXOR:KXEND)
+!!$ PYHAT(:) = GRID_MODEL(1)%XYHAT(KYOR:KYEND)
+!!$ PZS (:,:) = GRID_MODEL(1)%XZS (KXOR:KXEND,KYOR:KYEND)
+!!$ PZS_LS(:,:)= GRID_MODEL(1)%XZS (KXOR:KXEND,KYOR:KYEND)
+!!$ PZSMT (:,:) = GRID_MODEL(1)%XZSMT(KXOR:KXEND,KYOR:KYEND)
+!!$ PZSMT_LS(:,:) = GRID_MODEL(1)%XZSMT(KXOR:KXEND,KYOR:KYEND)
+!!$!
+!!$ELSE
!
!* 2.2 general case - change of resolution :
!
@@ -483,7 +484,7 @@ ELSE
!
!* 2.2.2 interpolation of ZS performed later
!
-END IF
+!!$END IF
!
PLONOR = XLONORI
PLATOR = XLATORI
diff --git a/src/MNH/spawn_pressure2.f90 b/src/MNH/spawn_pressure2.f90
index e2af77d73ce1777bc8e76969e1e24a9e248ad743..4a4077c296999362a58b8729cfebd4827cd65b70 100644
--- a/src/MNH/spawn_pressure2.f90
+++ b/src/MNH/spawn_pressure2.f90
@@ -102,6 +102,7 @@ END MODULE MODI_SPAWN_PRESSURE2
!! 2014 (M.Faivre) parallelization
!! 10/02/15 (M.Moge) correction of M.Faivre's parallelization attempt
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 05/03/2018 (J.Escobar) bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -204,14 +205,14 @@ IKE=IKU-JPVEXT
! -----------------------
!
!
-IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
-!
- PPABST (:,:,:) = XPABST1 (KXOR:KXEND,KYOR:KYEND,:)
-!
- CALL GOTO_MODEL(IMI)
- RETURN
-!
-END IF
+!!$IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
+!!$!
+!!$ PPABST (:,:,:) = FIELD_MODEL(1)%XPABST (KXOR:KXEND,KYOR:KYEND,:)
+!!$!
+!!$ CALL GOTO_MODEL(IMI)
+!!$ RETURN
+!!$!
+!!$END IF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/spawn_surf2_rain.f90 b/src/MNH/spawn_surf2_rain.f90
index 7d3c5dfab332e2623e50b8f0032df88daeee2ccc..2a776304a2947ffc2616a6035cb98c84e6b9e888 100644
--- a/src/MNH/spawn_surf2_rain.f90
+++ b/src/MNH/spawn_surf2_rain.f90
@@ -108,6 +108,7 @@ END MODULE MODI_SPAWN_SURF2_RAIN
!! J.Escobar 2/05/2016 : bug in use of global/local bounds for call of BIKHARDT
!! C.Lac 10/2016 : Add droplet deposition for fog
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 05/03/2018 : bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -195,46 +196,46 @@ YMETHOD='BI'
!* 3. INITIALIZATION OF THE SURFACE VARIABLES OF MODEL 2:
! --------------------------------------------------
!
-IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
-!
-!* 3.1 special case of spawning - no change of resolution :
-!
- IF (SIZE(XINPRC1) /= 0 ) THEN
- PINPRC(:,:) = XINPRC1(KXOR:KXEND,KYOR:KYEND)
- PACPRC(:,:) = XACPRC1(KXOR:KXEND,KYOR:KYEND)
- END IF
-!
- IF (SIZE(XINDEP1) /= 0 ) THEN
- PINDEP(:,:) = XINDEP1(KXOR:KXEND,KYOR:KYEND)
- PACDEP(:,:) = XACDEP1(KXOR:KXEND,KYOR:KYEND)
- END IF
-!
- IF (SIZE(XINPRR1) /= 0 ) THEN
- PINPRR(:,:) = XINPRR1 (KXOR:KXEND,KYOR:KYEND)
- PINPRR3D(:,:,:) = XINPRR3D1(KXOR:KXEND,KYOR:KYEND,:)
- PEVAP3D(:,:,:) = XEVAP3D1 (KXOR:KXEND,KYOR:KYEND,:)
- PACPRR(:,:) = XACPRR1 (KXOR:KXEND,KYOR:KYEND)
- END IF
-!
- IF (SIZE(XINPRS1) /= 0 ) THEN
- PINPRS(:,:) = XINPRS1(KXOR:KXEND,KYOR:KYEND)
- PACPRS(:,:) = XACPRS1(KXOR:KXEND,KYOR:KYEND)
- END IF
-!
- IF (SIZE(XINPRG1) /= 0 ) THEN
- PINPRG(:,:) = XINPRG1(KXOR:KXEND,KYOR:KYEND)
- PACPRG(:,:) = XACPRG1(KXOR:KXEND,KYOR:KYEND)
- END IF
-!
- IF (SIZE(XINPRH1) /= 0 ) THEN
- PINPRH(:,:) = XINPRH1(KXOR:KXEND,KYOR:KYEND)
- PACPRH(:,:) = XACPRH1(KXOR:KXEND,KYOR:KYEND)
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-ELSE
+!!$IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
+!!$!
+!!$!* 3.1 special case of spawning - no change of resolution :
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
+!!$ PINPRC(:,:) = PRECIP_MODEL(1)%XINPRC(KXOR:KXEND,KYOR:KYEND)
+!!$ PACPRC(:,:) = PRECIP_MODEL(1)%XACPRC(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINDEP) /= 0 ) THEN
+!!$ PINDEP(:,:) = PRECIP_MODEL(1)%XINDEP(KXOR:KXEND,KYOR:KYEND)
+!!$ PACDEP(:,:) = PRECIP_MODEL(1)%XACDEP(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
+!!$ PINPRR(:,:) = PRECIP_MODEL(1)%XINPRR(KXOR:KXEND,KYOR:KYEND)
+!!$ PINPRR3D(:,:,:) = PRECIP_MODEL(1)%XINPRR3D(KXOR:KXEND,KYOR:KYEND,:)
+!!$ PEVAP3D(:,:,:) = PRECIP_MODEL(1)%XEVAP3D(KXOR:KXEND,KYOR:KYEND,:)
+!!$ PACPRR(:,:) = PRECIP_MODEL(1)%XACPRR(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
+!!$ PINPRS(:,:) = PRECIP_MODEL(1)%XINPRS(KXOR:KXEND,KYOR:KYEND)
+!!$ PACPRS(:,:) = PRECIP_MODEL(1)%XACPRS(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
+!!$ PINPRG(:,:) = PRECIP_MODEL(1)%XINPRG(KXOR:KXEND,KYOR:KYEND)
+!!$ PACPRG(:,:) = PRECIP_MODEL(1)%XACPRG(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$ IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
+!!$ PINPRH(:,:) = PRECIP_MODEL(1)%XINPRH(KXOR:KXEND,KYOR:KYEND)
+!!$ PACPRH(:,:) = PRECIP_MODEL(1)%XACPRH(KXOR:KXEND,KYOR:KYEND)
+!!$ END IF
+!!$!
+!!$!
+!!$!-------------------------------------------------------------------------------
+!!$!
+!!$ELSE
!
!* 3.2 general case - change of resolution :
! -----------------------------------
@@ -348,7 +349,7 @@ ELSE
!
!-------------------------------------------------------------------------------
!
-END IF
+!!$END IF
!
!* 3.3 Informations from model SON1
! ----------------------------
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index 636c97b290dcd92b5e9341306ea494ccc3b2cb1e..2ada33c135deedc776974a60b4bdc4a30aa7f30d 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -61,6 +61,7 @@ CC = gcc
FC = gfortran
ifeq "$(VER_MPI)" "MPIAUTO"
F90 = mpif90
+CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE
else
F90 = gfortran
endif
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index 9da29243ddacf339705eef170a2d627db18707c0..0ded924d2b4c945eacd2a3c4e444a5c02d5ee172 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -9,7 +9,7 @@
##########################################################
#OBJDIR_PATH=/home/escj/azertyuiopqsdfghjklm/wxcvbn/azertyuiopqsdfghjklmwxcvbn
#
-OPT_BASE = -g -w -assume nosource_include -assume byterecl -fpe0 -ftz -fpic -traceback -fp-model precise -switch fe_inline_all_arg_copy_inout
+OPT_BASE = -g -w -assume nosource_include -assume byterecl -fpe0 -ftz -fpic -traceback -fp-model precise -switch fe_inline_all_arg_copy_inout -fno-common
OPT_PERF0 = -O0
OPT_PERF2 = -O2
OPT_PERF3 = -O3 -xHost
@@ -74,6 +74,7 @@ export TAU_MAKEFILE?=/home/escj/PATCH/TAU/TAU-2.21.1-IFORT10-OMPI152-THREAD/x86_
LIBS += -lz
else
F90 = mpif90
+CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE
endif
else
ifeq "$(VER_MPI)" "MPIINTEL"
@@ -83,8 +84,9 @@ export TAU_MAKEFILE?=/home/escj/PATCH/TAU/TAU-2.21.1-IFORT10-OMPI152-THREAD/x86_
LIBS += -lz
else
F90 = mpiifort
+CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE
endif
-ifeq "$(MNH_INT)" "I8"
+ifeq "$(MNH_INT)" "8"
OPT_BASE += -ilp64
endif
else
diff --git a/src/SURFEX/canopy_blowsnw.F90 b/src/SURFEX/canopy_blowsnw.F90
index 52cd5ce9a07f6bed651f614b7b7f74da4071b988..ed5cfd426f3e5e8117732e13f5fc381f3a089c9f 100644
--- a/src/SURFEX/canopy_blowsnw.F90
+++ b/src/SURFEX/canopy_blowsnw.F90
@@ -32,6 +32,8 @@
!! MODIFICATIONS
!! -------------
!! Original 05/2014
+!! Modif
+!! J.Escobar 27/04/2018 : BUG?! => uncomment USE MODI_CANOPY_BLOWSNW_SUBL
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -47,7 +49,7 @@ USE MODE_BLOWSNW_SURF
USE MODI_RMC01_SURF
USE MODI_CANOPY_EVOL_BLOWSNW
-!USE MODI_CANOPY_BLOWSNW_SUBL
+USE MODI_CANOPY_BLOWSNW_SUBL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
diff --git a/src/SURFEX/pgd_megan.F90 b/src/SURFEX/pgd_megan.F90
index 2da76d748a600a363121a572fa2aef7c2d5ab674..f8b715a7ce98c499d8a9d018e88f4b0f1954d773 100644
--- a/src/SURFEX/pgd_megan.F90
+++ b/src/SURFEX/pgd_megan.F90
@@ -34,6 +34,7 @@
!!
!! Original 15/06/2017
!! Modified 06/07/2017 J. Pianezze : adapatation to SurfEx v8.0
+!! 27/04/2018 J.Escobar : missing USE MODI_GET_SURF_MASK_n
!!
!----------------------------------------------------------------------------
!
@@ -55,6 +56,7 @@ USE MODI_PGD_FIELD
USE MODI_READ_NAM_PGD_MEGAN
USE MODI_UNPACK_SAME_RANK
USE MODI_GET_SURF_SIZE_n
+USE MODI_GET_SURF_MASK_n
!
USE MODE_POS_SURF
!