diff --git a/src/LIB/SURCOUCHE/src/extern_userio.f90 b/src/LIB/SURCOUCHE/src/extern_userio.f90
index 96d7acf4159eec7d8ef3f53f5c639351681b2ed0..85746e3d2366d32168f09baa864aa624bf9c0186 100644
--- a/src/LIB/SURCOUCHE/src/extern_userio.f90
+++ b/src/LIB/SURCOUCHE/src/extern_userio.f90
@@ -29,7 +29,7 @@ CALL E_INITIO_ll()
END SUBROUTINE INITIO_ll
SUBROUTINE OPEN_ll(UNIT,FILE,MODE,LFIPAR,COMM,STATUS,ACCESS, &
- IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD)
+ IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD,OPARALLELIO)
USE MODE_IO_ll, ONLY : E_OPEN_ll=>OPEN_ll
USE MODD_IO_ll, ONLY : LFIPARAM
IMPLICIT NONE
@@ -49,21 +49,32 @@ CHARACTER(len=*),INTENT(IN) :: ACTION
CHARACTER(len=*),INTENT(IN), OPTIONAL :: DELIM
CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD
INTEGER, INTENT(IN), OPTIONAL :: COMM
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CALL E_OPEN_ll(UNIT,FILE,MODE,LFIPAR,COMM,STATUS,ACCESS, &
- IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD)
+IF ( PRESENT(OPARALLELIO) ) THEN
+ CALL E_OPEN_ll(UNIT,FILE,MODE,LFIPAR,COMM,STATUS,ACCESS, &
+ IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD,OPARALLELIO=OPARALLELIO)
+ELSE
+ CALL E_OPEN_ll(UNIT,FILE,MODE,LFIPAR,COMM,STATUS,ACCESS, &
+ IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD)
+ENDIF
END SUBROUTINE OPEN_ll
-SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS)
+SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS,OPARALLELIO)
USE MODE_IO_ll, ONLY : E_CLOSE_ll=>CLOSE_ll
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: HFILE
INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CALL E_CLOSE_ll(HFILE,IOSTAT,STATUS)
+IF( PRESENT(OPARALLELIO) ) THEN
+ CALL E_CLOSE_ll(HFILE,IOSTAT,STATUS,OPARALLELIO=OPARALLELIO)
+ELSE
+ CALL E_CLOSE_ll(HFILE,IOSTAT,STATUS)
+ENDIF
END SUBROUTINE CLOSE_ll
@@ -115,7 +126,7 @@ CALL E_FMLOOK_ll(HFILEM,HFIPRI,KNUMBR,KRESP)
END SUBROUTINE FMLOOK_ll
SUBROUTINE FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR&
- & ,KRESP)
+ & ,KRESP,OPARALLELIO)
USE MODE_FM, ONLY : E_FMOPEN_ll=>FMOPEN_ll
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) ::HFILEM ! name of the file.
@@ -128,21 +139,31 @@ INTEGER, INTENT(IN) ::KFTYPE ! type of FM-file.
INTEGER, INTENT(IN) ::KVERB ! level of verbose.
INTEGER, INTENT(OUT)::KNINAR ! number of articles initially present in the file.
INTEGER, INTENT(OUT)::KRESP ! return-code if a problem araised.
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CALL E_FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR,KRESP)
+IF( PRESENT(OPARALLELIO) ) THEN
+ CALL E_FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR,KRESP,OPARALLELIO=OPARALLELIO)
+ELSE
+ CALL E_FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR,KRESP)
+ENDIF
END SUBROUTINE FMOPEN_ll
-SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP)
+SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP,OPARALLELIO)
USE MODE_FM, ONLY : E_FMCLOS_ll=>FMCLOS_ll
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
CHARACTER(LEN=*), INTENT(IN) ::HSTATU ! status for the closed file
CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
INTEGER, INTENT(OUT)::KRESP ! return-code if problems araised
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
+
+IF( PRESENT(OPARALLELIO) ) THEN
+ CALL E_FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP,OPARALLELIO=OPARALLELIO)
+ELSE
+ CALL E_FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP)
+ENDIF
-CALL E_FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP)
-
END SUBROUTINE FMCLOS_ll
!
@@ -167,7 +188,7 @@ CALL E_FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
END SUBROUTINE FMREADX0_ll
SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
USE MODE_FMREAD, ONLY : E_FMREADX1_ll=>FMREADX1_ll
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
@@ -179,8 +200,14 @@ INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
INTEGER, INTENT(OUT)::KLENCH ! length of comment string
CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+
+IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL E_FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP,KIMAX_ll,KJMAX_ll)
+ELSE
+ CALL E_FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
+ENDIF
END SUBROUTINE FMREADX1_ll
diff --git a/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90 b/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
index 4218ee5b9be09ddbc78ae0b488ea686f4303ce92..1443c323b807d7b9145d1080651d6ff9d2d79b7a 100644
--- a/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
+++ b/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
@@ -714,15 +714,23 @@
END SUBROUTINE UNSET_LSFIELD_2WAY_ll
!
! #########################################
- SUBROUTINE LS_FORCING_ll( KCHILD, KINFO )
+ SUBROUTINE LS_FORCING_ll( KCHILD, KINFO, OEXTRAPOL, OCYCLIC_EXTRAPOL )
! #########################################
!
USE MODE_LS_ll, ONLY : E_LS_FORCING_ll => LS_FORCING_ll
!
INTEGER, INTENT(IN) :: KCHILD
INTEGER, INTENT(OUT) :: KINFO
-!
- CALL E_LS_FORCING_ll( KCHILD, KINFO )
+ LOGICAL, OPTIONAL, INTENT(IN) :: OEXTRAPOL
+ LOGICAL, OPTIONAL, INTENT(IN) :: OCYCLIC_EXTRAPOL
+!
+ IF ( PRESENT(OEXTRAPOL) .AND. PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+ CALL E_LS_FORCING_ll( KCHILD, KINFO, OEXTRAPOL, OCYCLIC_EXTRAPOL )
+ ELSEIF ( PRESENT(OEXTRAPOL) ) THEN
+ CALL E_LS_FORCING_ll( KCHILD, KINFO, OEXTRAPOL )
+ ELSE
+ CALL E_LS_FORCING_ll( KCHILD, KINFO )
+ ENDIF
!
END SUBROUTINE LS_FORCING_ll
!
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 05945def2b9549e626c2fbaf23967b1e3264c1e3..5803897a48e3ce44bb26c79405f1644637aee75f 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -167,12 +167,13 @@ RETURN
END SUBROUTINE FMREADX0_ll
SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
USE MODD_FM
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
USE MODE_SCATTER_ll
USE MODE_ALLOCBUFFER_ll
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
!
!* 0. DECLARATIONS
! ------------
@@ -189,6 +190,9 @@ INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
INTEGER, INTENT(INOUT)::KRESP ! return-code
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
!
!* 0.2 Declarations of local variables
!
@@ -218,7 +222,11 @@ IF (ASSOCIATED(TZFD)) THEN
IF (IRESP /= 0) GOTO 1000
ELSE ! multiprocessor execution
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ ELSE
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ENDIF
IF (ASSOCIATED(TZFD%CDF)) THEN
CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
ELSE
@@ -241,7 +249,11 @@ IF (ASSOCIATED(TZFD)) THEN
CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
ELSE
!Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ENDIF
END IF
END IF !(GSMONOPROC)
@@ -265,8 +277,8 @@ RETURN
END SUBROUTINE FMREADX1_ll
SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
USE MODD_FM
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
USE MODE_SCATTER_ll
@@ -275,6 +287,7 @@ USE MODE_ALLOCBUFFER_ll
USE MODD_TIMEZ, ONLY : TIMEZ
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
!JUANZ
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
#ifdef MNH_GA
USE MODE_GA
#endif
@@ -290,6 +303,9 @@ INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
INTEGER, INTENT(INOUT)::KRESP ! return-code
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
!
!
!* 0.2 Declarations of local variables
@@ -351,7 +367,11 @@ IF (ASSOCIATED(TZFD)) THEN
CALL SECOND_MNH2(T0)
IF (ISP == TZFD%OWNER) THEN
! I/O processor case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ ELSE
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ENDIF
IF (ASSOCIATED(TZFD%CDF)) THEN
CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
ELSE
@@ -372,11 +392,19 @@ IF (ASSOCIATED(TZFD)) THEN
!
IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ENDIF
ELSE IF (HDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM)
+ ENDIF
PFIELD(:,:) = SPREAD(PFIELD(:,2),DIM=2,NCOPIES=3)
ELSE
#ifdef MNH_GA
@@ -450,6 +478,7 @@ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
#ifdef MNH_GA
USE MODE_GA
#endif
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
IMPLICIT NONE
@@ -744,7 +773,7 @@ IF (ASSOCIATED(TZFD)) THEN
END IF
CALL SECOND_MNH2(T0)
IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
END IF
DEALLOCATE(T_TX2DP)
@@ -1792,6 +1821,7 @@ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
USE MODD_TIMEZ, ONLY : TIMEZ
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
!JUANZ
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
@@ -1947,7 +1977,7 @@ IF (ASSOCIATED(TZFD)) THEN
IF (NB_REQ .GT.0 ) THEN
!ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
!CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
!DEALLOCATE(STATUSES)
DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
END IF
@@ -1965,7 +1995,7 @@ IF (ASSOCIATED(TZFD)) THEN
CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,STATUS,IERR)
!NB_REQ = NB_REQ + 1
!CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
END IF
CALL SECOND_MNH2(T1)
TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 219632afaf59acae408708c5497e3aa7498e7669..ba87714e639d1fd035a6c0f302a2b3c7404fd7db 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -797,6 +797,7 @@ CONTAINS
#ifdef MNH_GA
USE MODE_GA
#endif
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
!
!* 0.1 Declarations of arguments
@@ -1199,7 +1200,7 @@ CONTAINS
CALL SECOND_MNH2(T0)
IF (NB_REQ .GT.0 ) THEN
!ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
!CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
!DEALLOCATE(STATUSES)
DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
@@ -2507,6 +2508,8 @@ CONTAINS
USE MODE_UTIL
#endif
!!!! MOD SB
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
@@ -2631,7 +2634,7 @@ CONTAINS
!CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
END IF
IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
DEALLOCATE(T_TX3DP(1)%X)
END IF
DEALLOCATE(T_TX3DP,REQ_TAB)
diff --git a/src/LIB/SURCOUCHE/src/modd_structure_ll.f90 b/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
index 4b0d194c5ac46a5b43397fe11ba8394141ddab22..3edf470ce6da9f08105f9659fc2f0dfa0af9cd19 100644
--- a/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
@@ -48,6 +48,7 @@
!
! Original 04/05/98
! Juan 19/08/2005: distinction Halo NORD/SUD & EST/WEST
+! M.Moge 05/02/2015: extended HALO (halo size + 1)
!
!-------------------------------------------------------------------------------
!
@@ -496,7 +497,12 @@ END INTERFACE
! subsets of correspondants for the halos communications
!
TYPE(CRSPD_ll), POINTER :: TSEND_HALO1, TRECV_HALO1, &
- TSEND_HALO2, TRECV_HALO2
+ TSEND_HALO2, TRECV_HALO2, &
+ TSEND_HALO_EXTENDED, TRECV_HALO_EXTENDED
+!
+! size of the halo used with TSEND_HALO_EXTENDED, TRECV_HALO_EXTENDED
+!
+ INTEGER :: HALOSIZE_EXTENDED
!
! subsets of correspondants for the transpositions communications
!
@@ -673,6 +679,8 @@ END INTERFACE
NULLIFY(TP%TRECV_HALO1)
NULLIFY(TP%TSEND_HALO2)
NULLIFY(TP%TRECV_HALO2)
+ NULLIFY(TP%TSEND_HALO_EXTENDED)
+ NULLIFY(TP%TRECV_HALO_EXTENDED)
NULLIFY(TP%TSEND_TRANS_BX)
NULLIFY(TP%TRECV_TRANS_BX)
NULLIFY(TP%TSEND_TRANS_XY)
diff --git a/src/LIB/SURCOUCHE/src/modd_var_ll.f90 b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
index 860eaf384621c0f83b2b8a9dc1e2b145c8ea1d27..d78105df9f9a7e71c52985f8c7f96fff1e231ff9 100644
--- a/src/LIB/SURCOUCHE/src/modd_var_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
@@ -1,3 +1,4 @@
+
!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
@@ -47,6 +48,7 @@
!-------------------------------------------------------------------------------
!
USE MODD_STRUCTURE_ll
+ !USE MODD_MPIF, ONLY : MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
!
IMPLICIT NONE
!
@@ -135,5 +137,7 @@ INTEGER,SAVE :: NZ_PROC_ll = 0 ! Number of proc to use in the Z splitting
INTEGER, PARAMETER :: NNEXTTAG = 50
!
INTEGER, PARAMETER :: NMODULO_MSSGTAG = 10
+!
+ INTEGER, POINTER, DIMENSION(:,:) :: MNH_STATUSES_IGNORE
!
END MODULE MODD_VAR_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index 89de182fa3eb51109af559adb503cd72530cd837..c330f236843ab580d40985c9f416330dcc605b0f 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
@@ -88,22 +88,34 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_N2
-SUBROUTINE ALLOCBUFFER_X1(PTAB_P,PTAB,HDIR,OALLOC)
+SUBROUTINE ALLOCBUFFER_X1(PTAB_P,PTAB,HDIR,OALLOC, KIMAX_ll, KJMAX_ll)
!
REAL,DIMENSION(:),POINTER :: PTAB_P
REAL,DIMENSION(:),TARGET,INTENT(IN) :: PTAB
CHARACTER(LEN=*), INTENT(IN) :: HDIR
LOGICAL, INTENT(OUT):: OALLOC
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
INTEGER :: IIMAX,IJMAX
SELECT CASE(HDIR)
CASE('XX')
- CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
ALLOCATE(PTAB_P(IIMAX+2*JPHEXT))
OALLOC = .TRUE.
CASE('YY')
- CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
ALLOCATE(PTAB_P(IJMAX+2*JPHEXT))
OALLOC = .TRUE.
CASE default
@@ -112,27 +124,44 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_X1
-SUBROUTINE ALLOCBUFFER_X2(PTAB_P,PTAB,HDIR,OALLOC)
+SUBROUTINE ALLOCBUFFER_X2(PTAB_P,PTAB,HDIR,OALLOC, KIMAX_ll, KJMAX_ll)
USE MODD_IO_ll, ONLY : LPACK, L2D
!
REAL,DIMENSION(:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PTAB
CHARACTER(LEN=*), INTENT(IN) :: HDIR
LOGICAL, INTENT(OUT):: OALLOC
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
INTEGER :: IIMAX,IJMAX
SELECT CASE(HDIR)
CASE('XX')
- CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
ALLOCATE(PTAB_P(IIMAX+2*JPHEXT,SIZE(PTAB,2)))
OALLOC = .TRUE.
CASE('YY')
- CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
ALLOCATE(PTAB_P(IJMAX+2*JPHEXT,SIZE(PTAB,2)))
OALLOC = .TRUE.
CASE('XY')
- CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
IF (LPACK .AND. L2D) THEN ! 2D compact case
ALLOCATE(PTAB_P(IIMAX+2*JPHEXT,1))
ELSE
diff --git a/src/LIB/SURCOUCHE/src/mode_construct_ll.f90 b/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
index 4f3ba19958615747ea55e5e51cca08579c7c41f6..b54e1a3b17701e6a5136cc6192f71ed1b85b375b 100644
--- a/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
@@ -43,6 +43,7 @@
!! -------------
! Original 01/05/98
! Juan 19/08/2005: distinction Halo NORD/SUD & EST/WEST
+! M.Moge 10/02/2015 CONSTRUCT_HALO_EXTENDED
!
!! Implicit Arguments
!! ------------------
@@ -1303,6 +1304,321 @@
!
END SUBROUTINE CONSTRUCT_HALO1
!
+! ##################################################
+ SUBROUTINE CONSTRUCT_HALO_EXTENDED( TPCOMDATA, TPPROCONF, HALOSIZE )
+! ##################################################
+!
+!!**** *CONSTRUCT_HALO_EXTENDED* - routine to construct the extended halo of size HALOSIZE correspondants
+!
+!! Purpose
+!! -------
+! the purpose of the routine is to fill the structured type variable
+! TPCOMDATA with informations concerning the communications of
+! halo of size HALOSIZE
+!
+!!** Method
+!! ------
+! we compute for the local processor,
+! - intersections between extended zones of the global domain
+! and local physical zone to find the send correspondant
+! of the local processor
+! - intersections between physical zones of the global domain
+! and local extended zone to find the receive correspondant
+! of the local processor
+!
+! we complete these correspondants in case of cyclic conditions
+!
+!! External
+!! --------
+!
+! Module MODE_TOOLS_ll
+! ADD_ZONE, INTERSECTION, GLOBAL2LOCAL, EXTRACT_ZONE
+! LWEST_ll, LSOUTH_ll, LEAST_ll, LNORTH_ll
+!
+! Module MODE_CONSTRUCT_ll
+! INI_CYCLIC
+!
+!! Implicit Arguments
+!! ------------------
+!
+! Module MODD_STRUCTURE_ll
+! types ZONE_ll, PROC_COM_DATA_ll, PROCONF_ll
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT - Horizontal External points number
+!
+! Module MODD_VAR_ll
+! IP - Number of local processor=subdomain
+! NPROC - Number of processors
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+! Module MODD_DIM_ll
+! CLBCX - X-direction LBC type at left(1) and right(2) boundaries
+! CLBCY - Y-direction LBC type at left(1) and right(2) boundaries
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge * CNRS - LA * (adaptation of subroutine CONSTRUCT_HALO1)
+!!
+!! Modifications
+!! -------------
+! Original 10/02/2015
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll, &
+ INTERSECTION, GLOBAL2LOCAL, ADD_ZONE, &
+ EXTRACT_ZONE_EXTENDED
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(PROC_COM_DATA_ll), POINTER :: TPCOMDATA ! communications data structure
+ TYPE(PROCONF_ll), POINTER :: TPPROCONF ! splitting data structure
+ INTEGER, INTENT(IN) :: HALOSIZE ! size of the halo
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZPZS ! Physical zone splitting
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZEZS_EXTENDED ! Extended zone splitting with halo of size HALOSIZE
+!
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZINTER ! Intermediate zone
+!
+ INTEGER :: JI ! loop control variable
+
+ INTEGER :: ICURMODEL
+ INTEGER :: ISHIFTS, ISHIFTN, &
+ ISHIFTE, ISHIFTW
+ INTEGER :: ISHIFTSI, ISHIFTNI, &
+ ISHIFTEI, ISHIFTWI
+ INTEGER :: IS, IE, IW ,IN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. ALLOCATE OF THE LOCAL VARIABLES :
+! -------------------------------
+!
+ ALLOCATE( TZPZS(NPROC), TZEZS_EXTENDED(NPROC), TZINTER(NPROC) )
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. EXTRACTION OF PHYSICAL AND EXTENDED 2WAY SPLITTING :
+! --------------------------------------------------
+!
+ CALL EXTRACT_ZONE_EXTENDED( TPPROCONF%TSPLITS_B, TZPZS, TZEZS_EXTENDED, HALOSIZE )
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTATION OF INTERSECTION BETWEEN LOCAL PHYSICAL ZONE
+!* AND EXTENDED SPLITTING -> SEND CORRESPONDANT :
+! --------------------------------------------
+!
+ CALL INTERSECTION( TZEZS_EXTENDED, NPROC, TZPZS(IP), TZINTER )
+!
+ ICURMODEL = TCRRT_COMDATA%NUMBER
+ ICURMODEL = TPCOMDATA%NUMBER
+!
+ ISHIFTS = 0
+ ISHIFTW = 0
+ ISHIFTN = 0
+ ISHIFTE = 0
+!
+ IF (TPPROCONF%TBOUND(IP)%SOUTH) ISHIFTS = 1
+ IF (TPPROCONF%TBOUND(IP)%WEST) ISHIFTW = 1
+ IF (TPPROCONF%TBOUND(IP)%NORTH) ISHIFTN = 1
+ IF (TPPROCONF%TBOUND(IP)%EAST) ISHIFTE = 1
+!
+ IF ((ISHIFTS.NE.0).OR.(ISHIFTW.NE.0).OR.(ISHIFTN.NE.0).OR. &
+ (ISHIFTE.NE.0)) THEN
+!
+ DO JI = 1, NPROC
+!
+! if intersection not void and intersected zone is zone itself
+!
+ IF ((TZINTER(JI)%NUMBER.NE.0).AND.(TZINTER(JI)%NUMBER.NE.IP)) THEN
+ ISHIFTSI = 2
+ ISHIFTWI = 2
+ ISHIFTNI = 2
+ ISHIFTEI = 2
+!
+ IF (TPPROCONF%TBOUND(JI)%SOUTH) ISHIFTSI = 1
+ IF (TPPROCONF%TBOUND(JI)%WEST) ISHIFTWI = 1
+ IF (TPPROCONF%TBOUND(JI)%NORTH) ISHIFTNI = 1
+ IF (TPPROCONF%TBOUND(JI)%EAST) ISHIFTEI = 1
+!
+ IS = 0
+ IN = 0
+ IW = 0
+ IE = 0
+!
+! if intersected zone is on a border too
+!
+ IF ((ISHIFTS == ISHIFTSI).AND.(CLBCX(ICURMODEL, 1) /= 'CYCL')) THEN
+ IS = -HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTN == ISHIFTNI).AND.(CLBCX(ICURMODEL, 2) /= 'CYCL')) THEN
+ IN = HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTW == ISHIFTWI).AND.(CLBCY(ICURMODEL, 1) /= 'CYCL')) THEN
+ IW = -HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTE == ISHIFTEI).AND.(CLBCY(ICURMODEL, 2) /= 'CYCL')) THEN
+ IE = HALOSIZE
+ ENDIF
+!
+ TZINTER(JI) = ZONE_ll(&
+ TZINTER(JI)%NUMBER ,&
+ TZINTER(JI)%MSSGTAG ,&
+ TZINTER(JI)%NXOR + IW ,&
+ TZINTER(JI)%NXEND + IE ,&
+ TZINTER(JI)%NYOR + IS ,&
+ TZINTER(JI)%NYEND + IN ,&
+ TZINTER(JI)%NZOR ,&
+ TZINTER(JI)%NZEND )
+ ENDIF
+!
+ ENDDO
+!
+ ENDIF
+!
+ TPCOMDATA%HALOSIZE_EXTENDED = HALOSIZE
+ NULLIFY(TPCOMDATA%TSEND_HALO_EXTENDED)
+ DO JI = 1, NPROC
+ IF((TZINTER(JI)%NUMBER.NE.0).AND.(TZINTER(JI)%NUMBER.NE.IP)) THEN
+ TZINTER(JI)%MSSGTAG = 1
+ CALL ADD_ZONE( TPCOMDATA%TSEND_HALO_EXTENDED, TZINTER(JI) )
+ ENDIF
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTATION OF INTERSECTION BETWEEN LOCAL EXTENDED ZONE
+! AND PHYSICAL SPLITTING -> RECV CORRESPONDANT :
+! --------------------------------------------
+!
+ CALL INTERSECTION( TZPZS, NPROC, TZEZS_EXTENDED(IP), TZINTER )
+!
+ IF ((ISHIFTS.NE.0).OR.(ISHIFTW.NE.0).OR.(ISHIFTN.NE.0).OR. &
+ (ISHIFTE.NE.0)) THEN
+!
+ DO JI = 1, NPROC
+!
+! if intersection not void and intersected zone is zone itself
+!
+ IF ((TZINTER(JI)%NUMBER.NE.0).AND.(TZINTER(JI)%NUMBER.NE.IP)) THEN
+ ISHIFTSI = 2
+ ISHIFTWI = 2
+ ISHIFTNI = 2
+ ISHIFTEI = 2
+!
+ IF (TPPROCONF%TBOUND(JI)%SOUTH) ISHIFTSI = 1
+ IF (TPPROCONF%TBOUND(JI)%WEST) ISHIFTWI = 1
+ IF (TPPROCONF%TBOUND(JI)%NORTH) ISHIFTNI = 1
+ IF (TPPROCONF%TBOUND(JI)%EAST) ISHIFTEI = 1
+!
+ IS = 0
+ IN = 0
+ IW = 0
+ IE = 0
+!
+! if intersected zone is on a border too
+!
+ IF ((ISHIFTS == ISHIFTSI).AND.(CLBCX(ICURMODEL, 1) /= 'CYCL')) THEN
+ IS = -HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTN == ISHIFTNI).AND.(CLBCX(ICURMODEL, 2) /= 'CYCL')) THEN
+ IN = HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTW == ISHIFTWI).AND.(CLBCY(ICURMODEL, 1) /= 'CYCL')) THEN
+ IW = -HALOSIZE
+ ENDIF
+!
+ IF ((ISHIFTE == ISHIFTEI).AND.(CLBCY(ICURMODEL, 2) /= 'CYCL')) THEN
+ IE = HALOSIZE
+ ENDIF
+!
+ TZINTER(JI) = ZONE_ll(TZINTER(JI)%NUMBER, &
+ TZINTER(JI)%MSSGTAG, &
+ TZINTER(JI)%NXOR + IW,&
+ TZINTER(JI)%NXEND + IE, &
+ TZINTER(JI)%NYOR + IS, &
+ TZINTER(JI)%NYEND + IN,&
+ TZINTER(JI)%NZOR,&
+ TZINTER(JI)%NZEND)
+ ENDIF
+!
+ ENDDO
+!
+ ENDIF
+!
+ NULLIFY(TPCOMDATA%TRECV_HALO_EXTENDED)
+ DO JI = 1, NPROC
+ IF((TZINTER(JI)%NUMBER.NE.0).AND.(TZINTER(JI)%NUMBER.NE.IP)) THEN
+ TZINTER(JI)%MSSGTAG = 1
+ CALL ADD_ZONE( TPCOMDATA%TRECV_HALO_EXTENDED, TZINTER(JI) )
+ ENDIF
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. MODIFICATIONS IN CASE OF CYCLIC CONDITIONS :
+! ------------------------------------------
+!
+ NULLIFY(TPCOMDATA%TSEND_BOUNDX)
+ NULLIFY(TPCOMDATA%TRECV_BOUNDX)
+ NULLIFY(TPCOMDATA%TSEND_BOUNDY)
+ NULLIFY(TPCOMDATA%TRECV_BOUNDY)
+ NULLIFY(TPCOMDATA%TSEND_BOUNDXY)
+ NULLIFY(TPCOMDATA%TRECV_BOUNDXY)
+!
+ CALL INI_CYCLIC( TPPROCONF, &
+ TPCOMDATA%TSEND_HALO_EXTENDED, &
+ TPCOMDATA%TRECV_HALO_EXTENDED, &
+ TPCOMDATA%TSEND_BOUNDX, &
+ TPCOMDATA%TRECV_BOUNDX, &
+ TPCOMDATA%TSEND_BOUNDY, &
+ TPCOMDATA%TRECV_BOUNDY, &
+ TPCOMDATA%TSEND_BOUNDXY, &
+ TPCOMDATA%TRECV_BOUNDXY, &
+ TZPZS ,TZEZS_EXTENDED, HALOSIZE )
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. SWITCH FROM GLOBAL COORDINATES TO LOCAL COORDINATES :
+! ---------------------------------------------------
+!
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TSEND_HALO_EXTENDED)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TRECV_HALO_EXTENDED)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TSEND_BOUNDX)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TRECV_BOUNDX)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TSEND_BOUNDY)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TRECV_BOUNDY)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TSEND_BOUNDXY)
+ CALL GLOBAL2LOCAL(TPPROCONF, TPCOMDATA%TRECV_BOUNDXY)
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. DEALLOCATION OF LOCAL VARIABLES :
+! -------------------------------
+!
+ DEALLOCATE( TZPZS, TZEZS_EXTENDED, TZINTER )
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE CONSTRUCT_HALO_EXTENDED
+!
! ################################################
SUBROUTINE CONSTRUCT_1DX( TPCOMDATA, TPPROCONF )
! ################################################
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
index 4f7309ae3a46d88e2e22bd5ba0c7ebf60fc0c1c8..767482a5ccab76a4db3d721566ebbc2e0e097dcc 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
@@ -714,6 +714,8 @@
!JUANZ
USE MODD_CONFZ, ONLY : LMNH_MPI_BSEND
!JUANZ
+!
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
IMPLICIT NONE
!
@@ -882,7 +884,7 @@ endif
! JUAN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,KINFO)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,KINFO)
TPMAILRECV => TPCRSPDRECV
NB_REQ = NFIRST_REQ_RECV
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
index 7597fca05d770fe307f2ffe6ee8e6d5efef7388d..ca137a3805112565e44b1056e950ff516ef14267 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
@@ -28,7 +28,7 @@
!! Routines Of The User Interface
!! ------------------------------
!
-! SUBROUTINES : UPDATE_HALO_ll, UPDATE_1DHALO_ll, REMAP_2WAY_X_ll,
+! SUBROUTINES : UPDATE_HALO_ll, UPDATE_HALO_EXTENDED_ll, UPDATE_1DHALO_ll, REMAP_2WAY_X_ll,
! REMAP_X_2WAY_ll, REMAP_X_Y_ll, REMAP_Y_X_ll
!
!! Implicit Arguments
@@ -77,6 +77,7 @@
! R. Guivarch June 29, 1998 MPI_PRECISION
! N. Gicquel, P. Kloos - October 01, 1998 - COPY_CRSPD,
! COPY_ZONE, COPY_CRSPD_TRANS, COPY_ZONE_TRANS
+! M. Moge 01/12/14 UPDATE_HALO_EXTENDED
!
!-------------------------------------------------------------------------------
!
@@ -200,6 +201,102 @@
!
END SUBROUTINE UPDATE_HALO_ll
!
+! ########################################
+ SUBROUTINE UPDATE_HALO_EXTENDED_ll(TPLIST, KINFO)
+! ########################################
+!
+!!**** *UPDATE_HALO_EXTENDED_ll* - routine to update EXTENDED halo (halo + * point = HALOSIZE_EXTENDED)
+!
+!! Purpose
+!! -------
+! This routine updates the extended halo of size HALOSIZE_EXTENDED with the values computed by the
+! neighbor subdomains. The fields to be updated are in the
+! TPLIST list of fields. Before UPDATE_HALO_EXTENDED_ll is called, TPLIST
+! has been filled with the fields to be communicated
+!
+!!** Method
+!! ------
+! We treat first the zones the processor sends or received
+! from the others processors and then the zones it sents or
+! received from itself.
+!
+!! External
+!! --------
+! Module MODE_EXCHANGE_ll
+! SEND_RECV_CRSPD, COPY_CRSPD
+!
+!! Implicit Arguments
+!! ------------------
+!
+! Module MODD_ARGSLIST_ll
+! type LIST_ll
+!
+! Module MODD_VAR_ll
+! NHALO_COM - mpi communicator
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M. Moge 01/12/14 * LA - CNRS *
+! (based on UPDATE_HALO_ll)
+!
+!! Modifications
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ USE MODD_VAR_ll, ONLY : NHALO_COM, TCRRT_COMDATA
+!
+ USE MODE_MPPDB
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
+ INTEGER :: KINFO ! return status
+!
+!* 0.2 declarations of local variables
+ TYPE(LIST_ll), POINTER :: TZFIELD
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. UPDATE THE ZONES NOT SENT OR RECEIVED BY THE PROCESSOR ITSELF
+! -------------------------------------------------------------
+!
+ CALL SEND_RECV_CRSPD(TCRRT_COMDATA%TSEND_HALO_EXTENDED, TCRRT_COMDATA%TRECV_HALO_EXTENDED, &
+ TPLIST, TPLIST, NHALO_COM, KINFO)
+!
+!* 2. UPDATE THE ZONES THE PROCESSOR SENDS OR RECEIVED FROM ITSELF
+! ------------------------------------------------------------
+!
+ CALL COPY_CRSPD(TCRRT_COMDATA%TSEND_HALO_EXTENDED, TCRRT_COMDATA%TRECV_HALO_EXTENDED, &
+ TPLIST, TPLIST, KINFO)
+!
+! Warning: For now (01/12/14) the only field updated with UPDATE_HALO_EXTENDED_ll is ZZCHILDGRID_C, from SPAWN_ZS
+! and it is not a 'real' field. It is just a temporary field to update ZZS1_C.
+! Hence MPPDB_CHECK is irrelevant in this case and will always find a problem.
+! IF (MPPDB_INITIALIZED) THEN
+! TZFIELD => TPLIST
+! DO WHILE (ASSOCIATED(TZFIELD))
+! IF (TZFIELD%L2D) THEN
+!! CALL MPPDB_CHECK2D(TZFIELD%ARRAY2D,"UPDATE_HALO_EXTENDED_ll",PRECISION)
+! ELSEIF(TZFIELD%L3D) THEN
+!! CALL MPPDB_CHECK3D(TZFIELD%ARRAY3D,"UPDATE_HALO_EXTENDED_ll",PRECISION)
+! END IF
+! TZFIELD => TZFIELD%NEXT
+! END DO
+! END IF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE UPDATE_HALO_EXTENDED_ll
+!
! ##########################################
SUBROUTINE UPDATE_1DHALO_ll(TPLIST, KINFO)
! ##########################################
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index a204b894a7ca288dabd47288fb886ae486263e67..3755b40fd1f16dca305a88901f005677abc67e24 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -127,7 +127,7 @@ END IF
END SUBROUTINE FMLOOK_ll
SUBROUTINE FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR&
- & ,KRESP)
+ & ,KRESP,OPARALLELIO)
USE MODD_IO_ll, ONLY : ISP,ISTDOUT,LFIPARAM,LIOCDF4,LLFIOUT,LLFIREAD
USE MODE_FD_ll, ONLY : FD_ll,GETFD,JPFINL
USE MODE_IO_ll, ONLY : OPEN_ll,GCONFIO
@@ -149,6 +149,7 @@ INTEGER, INTENT(OUT)::KNINAR ! number of articles
! initially
! present in the file.
INTEGER, INTENT(OUT)::KRESP ! return-code if a problem
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
! araised.
!
! Local variable
@@ -167,6 +168,13 @@ INTEGER(KIND=LFI_INT) :: IMELEV,INPRAR, ININAR8
LOGICAL :: GNAMFI8,GFATER8,GSTATS8
INTEGER :: INB_PROCIO
!JUAN
+LOGICAL :: GPARALLELIO
+
+IF ( PRESENT(OPARALLELIO) ) THEN
+ GPARALLELIO = OPARALLELIO
+ELSE !par defaut on active les IO paralleles en Z si possible
+ GPARALLELIO = .TRUE.
+ENDIF
IF (.NOT. GCONFIO) THEN
PRINT *, 'FMOPEN_ll Aborting... Please, ensure to call SET_CONFIO_ll before &
@@ -207,7 +215,7 @@ ENDIF
YFNDES=ADJUSTL(TRIM(HFILEM)//'.des')
CALL OPEN_ll(UNIT=INUMBR,FILE=YFNDES,FORM='FORMATTED',ACTION=HACTION,DELIM&
- & ='QUOTE',IOSTAT=IRESP,RECL=1024*8)
+ & ='QUOTE',IOSTAT=IRESP,RECL=1024*8,OPARALLELIO=GPARALLELIO)
IF (IRESP /= 0) GOTO 1000
@@ -225,7 +233,7 @@ TZPARA%FITYP = KFTYPE
INB_PROCIO = NB_PROCIO_W
END SELECT
CALL OPEN_ll(UNIT=INUMBR,FILE=HFILEM,STATUS="UNKNOWN",MODE&
- & ='IO_ZSPLIT', LFIPAR=TZPARA, ACTION=HACTION, IOSTAT=IRESP,KNB_PROCIO=INB_PROCIO,KMELEV=IMELEV)
+ & ='IO_ZSPLIT', LFIPAR=TZPARA, ACTION=HACTION, IOSTAT=IRESP,KNB_PROCIO=INB_PROCIO,KMELEV=IMELEV,OPARALLELIO=GPARALLELIO)
IF (IRESP /= 0) GOTO 1000
@@ -321,7 +329,7 @@ KRESP=IRESP
RETURN
END SUBROUTINE FMOPEN_ll
-SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP)
+SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP,OPARALLELIO)
!
!! MODIFICATIONS
!! -------------
@@ -341,6 +349,7 @@ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
CHARACTER(LEN=*), INTENT(IN) ::HSTATU ! status for the closed file
CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
INTEGER, INTENT(OUT)::KRESP ! return-code if problems araised
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
INTEGER ::IRESP,IROWF,IFMFNL
CHARACTER(LEN=7) ::YSTATU
@@ -355,6 +364,13 @@ TYPE(FD_ll), POINTER :: TZFDLFI
!JUAN
INTEGER(KIND=LFI_INT) :: IRESP8,INUM8
!JUAN
+LOGICAL :: GPARALLELIO
+
+IF ( PRESENT(OPARALLELIO) ) THEN
+ GPARALLELIO = OPARALLELIO
+ELSE
+ GPARALLELIO = .TRUE. !par defaut on active les IO paralleles en Z si possible
+ENDIF
IRESP = 0
IROWF = 0
@@ -448,7 +464,7 @@ END IF
IF (IRESP /= 0) GOTO 1000
DEALLOCATE(TZFDLFI%PARAM)
-CALL CLOSE_ll(YFNLFI,IOSTAT=IRESP,STATUS=YSTATU)
+CALL CLOSE_ll(YFNLFI,IOSTAT=IRESP,STATUS=YSTATU,OPARALLELIO=GPARALLELIO)
1000 CONTINUE
IF (IRESP.NE.0) CALL FM_ERR('FMCLOS_ll',HFIPRI,HFILEM,IRESP)
diff --git a/src/LIB/SURCOUCHE/src/mode_gather.f90 b/src/LIB/SURCOUCHE/src/mode_gather.f90
index 8d4ecf84249d1c2abb2eb2744fe2160b327fd2ad..a60fb37ddfa7bea267fad1ca6555ad467f559b42 100644
--- a/src/LIB/SURCOUCHE/src/mode_gather.f90
+++ b/src/LIB/SURCOUCHE/src/mode_gather.f90
@@ -191,6 +191,7 @@ END SUBROUTINE GATHERALL_N2
!
SUBROUTINE GATHERXX_X1(HDIR,PSEND,PRECV,KROOT,KCOMM)
USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:),TARGET,INTENT(IN) :: PSEND
@@ -248,13 +249,13 @@ ELSE
XP=>PSEND(IXO:IXE)
NB_REQ = 1
CALL MPI_ISEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
- CALL MPI_WAITALL(NB_REQ,REQ,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
!CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE)
NB_REQ = 1
CALL MPI_ISEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
- CALL MPI_WAITALL(NB_REQ,REQ,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
!CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
@@ -711,6 +712,7 @@ END SUBROUTINE GATHERXX_N2
!
SUBROUTINE GATHERXY_X2(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT):: PRECV
@@ -755,7 +757,7 @@ ELSE
ALLOCATE(X_2DP(IXO:IXE,IYO:IYE))
X_2DP=XP
CALL MPI_ISEND(X_2DP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
- CALL MPI_WAITALL(NB_REQ,REQ,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
DEALLOCATE(X_2DP)
!CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
diff --git a/src/LIB/SURCOUCHE/src/mode_init_ll.f90 b/src/LIB/SURCOUCHE/src/mode_init_ll.f90
index c49319d0e80edc6cbb646af538d4da3f9bbf5237..21ce3980fd500dd98f4ab226a3badb22c11c3ce1 100644
--- a/src/LIB/SURCOUCHE/src/mode_init_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_init_ll.f90
@@ -61,6 +61,7 @@
!
! Original May 19, 1998
! Juan 19/08/2005: distinction Halo NORD/SUD & EST/WEST
+! M.Moge 05/02/2015: extended HALO (halo size + 1)
!
!-------------------------------------------------------------------------------
!
@@ -217,6 +218,15 @@
!
! Allocate arrays declared in MODD_DIM_ll
!
+ IF ( ALLOCATED(NDXRATIO_ALL) ) DEALLOCATE(NDXRATIO_ALL)
+ IF ( ALLOCATED(NDYRATIO_ALL) ) DEALLOCATE(NDYRATIO_ALL)
+ IF ( ALLOCATED(NXOR_ALL) ) DEALLOCATE(NXOR_ALL)
+ IF ( ALLOCATED(NYOR_ALL) ) DEALLOCATE(NYOR_ALL)
+ IF ( ALLOCATED(NXEND_ALL) ) DEALLOCATE(NXEND_ALL)
+ IF ( ALLOCATED(NYEND_ALL) ) DEALLOCATE(NYEND_ALL)
+ IF ( ALLOCATED(NDAD) ) DEALLOCATE(NDAD)
+ IF ( ALLOCATED(CLBCX) ) DEALLOCATE(CLBCX)
+ IF ( ALLOCATED(CLBCY) ) DEALLOCATE(CLBCY)
ALLOCATE(NDXRATIO_ALL(JPMODELMAX), NDYRATIO_ALL(JPMODELMAX))
ALLOCATE(NXOR_ALL(JPMODELMAX), NYOR_ALL(JPMODELMAX))
ALLOCATE(NXEND_ALL(JPMODELMAX), NYEND_ALL(JPMODELMAX))
@@ -452,7 +462,7 @@
!
! Module MODE_CONSTRUCT_ll
! INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS,
- ! CONSTRUCT_HALO1, CONSTRUCT_HALO2,
+ ! CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO2_EXTENDED,
! CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY,
! COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
!
@@ -496,7 +506,7 @@
USE MODE_SPLITTING_ll, ONLY : SPLIT2
!
USE MODE_CONSTRUCT_ll, ONLY : INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS, &
- CONSTRUCT_HALO1, CONSTRUCT_HALO2, &
+ CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED, &
CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY, &
COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
!
@@ -658,6 +668,7 @@
!
CALL CONSTRUCT_HALO1(TCRRT_COMDATA, TCRRT_PROCONF)
CALL CONSTRUCT_HALO2(TCRRT_COMDATA, TCRRT_PROCONF)
+ CALL CONSTRUCT_HALO_EXTENDED(TCRRT_COMDATA, TCRRT_PROCONF, JPHEXT+1)
!
!
!* 6.6 Construction of 1D communication data
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index b975014e9c1d8edb36bc359d1be53e1e61ffb2e1..aeddf6f1e681ecfa6329eb7c4bf1c5ad5d207eb2 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -218,7 +218,8 @@ CONTAINS
DELIM, &
PAD, &
KNB_PROCIO,&
- KMELEV)
+ KMELEV,&
+ OPARALLELIO)
#if defined(MNH_IOCDF4)
USE MODE_NETCDF
#endif
@@ -241,6 +242,7 @@ CONTAINS
!JUANZ
INTEGER, INTENT(IN), OPTIONAL :: KNB_PROCIO
INTEGER(KIND=LFI_INT), INTENT(IN), OPTIONAL :: KMELEV
+ LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
!JUANZ
!
! local var
@@ -279,6 +281,13 @@ CONTAINS
! didier
!JUAN SX5 : probleme function retournant un pointer
TYPE(FD_ll), POINTER :: TZJUAN
+ LOGICAL :: GPARALLELIO
+
+ IF ( PRESENT(OPARALLELIO) ) THEN
+ GPARALLELIO = OPARALLELIO
+ ELSE !par defaut on active les IO paralleles en Z si possible
+ GPARALLELIO = .TRUE.
+ ENDIF
#ifdef MNH_VPP
!! BUG Fuji avec RECL non fourni en argument de MYOPEN
@@ -582,6 +591,9 @@ CONTAINS
ELSE
TZFD%NB_PROCIO = 1
ENDIF
+ IF( GPARALLELIO /= .TRUE. ) THEN
+ TZFD%NB_PROCIO = 1
+ ENDIF
TZFD%COMM = NMNH_COMM_WORLD
TZFD%PARAM =>LFIPAR
#if defined(MNH_IOCDF4)
@@ -721,7 +733,7 @@ CONTAINS
END SUBROUTINE OPEN_ll
- SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS)
+ SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS,OPARALLELIO)
USE MODD_IO_ll
#if defined(MNH_IOCDF4)
USE MODE_NETCDF
@@ -729,6 +741,7 @@ CONTAINS
CHARACTER(LEN=*), INTENT(IN) :: HFILE
INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS
+ LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: OLDCOMM
@@ -743,7 +756,13 @@ CONTAINS
CHARACTER(len=128) :: YFILE_IOZ
INTEGER(KIND=LFI_INT) :: IRESP8,INUM8
CHARACTER(LEN=7) :: YSTATU
+ LOGICAL :: GPARALLELIO
+ IF ( PRESENT(OPARALLELIO) ) THEN
+ GPARALLELIO = OPARALLELIO
+ ELSE !par defaut on active les IO paralleles en Z si possible
+ GPARALLELIO = .TRUE.
+ ENDIF
!JUANZ
TZFD=>GETFD(HFILE)
@@ -778,6 +797,9 @@ CONTAINS
!
! close LFI file in the different PROC
!
+ IF( GPARALLELIO /= .TRUE. ) THEN
+ TZFD%NB_PROCIO = 1
+ ENDIF
IF (TZFD%NB_PROCIO .GT. 1 ) THEN
DO ifile=0,TZFD%NB_PROCIO-1
irank_procio = 1 + io_rank(ifile,ISNPROC,TZFD%NB_PROCIO)
diff --git a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90 b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
index 9d4b1e4a3dd9ff6d0c8f1a815139eceb96fb073e..67afce2de6abae410971f31a73a5ad5f1f012090 100644
--- a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
@@ -1656,4 +1656,219 @@
!
END SUBROUTINE INIT_LB_ll
!
+!
+!
+ SUBROUTINE SET_LB_FIELD_ll( HLBTYPE, PFIELD, PLBXFIELD, PLBYFIELD, IIB, IJB, IIE, IJE, SHIFTWEST, SHIFTEAST, SHIFTSOUTH, SHIFTNORTH )
+! #######################################################################
+!
+!!**** *SET_LB_FIELD_ll * - subroutine to copy the values associated with the
+!! Lateral Boundaries to the corresoponding LB field
+!!
+!! AUTHOR
+!! ------
+!!
+!! M. Moge * LA, CNRS *
+!!
+!! Original 28/11/14
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+ USE MODD_CONF
+! USE MODD_DIM_n
+ USE MODD_DYN_n
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+! USE MODE_ll
+ USE MODE_IO_ll
+ USE MODE_MPPDB
+ USE MODE_DISTRIB_LB
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+ !
+ IMPLICIT NONE
+ !
+ CHARACTER(LEN=*),INTENT(IN) :: HLBTYPE ! LB type : 'LB','LBU'
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! field on the whole domain (or subdomain)
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXFIELD ! LB field - X direction
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYFIELD ! LB field - Y direction
+ !beginning and end of the local physical subdomain
+ INTEGER, INTENT(IN) :: IIB ! indice I Beginning in x direction
+ INTEGER, INTENT(IN) :: IJB ! indice J Beginning in y direction
+ INTEGER, INTENT(IN) :: IIE ! indice I End in x direction
+ INTEGER, INTENT(IN) :: IJE ! indice J End in y direction
+ INTEGER, INTENT(IN) :: SHIFTWEST, SHIFTEAST, SHIFTSOUTH, SHIFTNORTH ! shifting applied to the indices copied from PFIELD in each direction
+ ! it is used for LBXUM et LBXVM
+ ! I do not know why...
+ !
+ ! LOCAL VARIABLES
+ CHARACTER(4) :: YLBTYPEX ! LB type : 'LBX','LBXU'
+ CHARACTER(4) :: YLBTYPEY ! LB type : 'LBY','LBYV'
+ ! local indices for the intersection of the local subdomain and the LB zone
+ INTEGER :: IIB_LOCLB ! indice I Beginning in x direction
+ INTEGER :: IJB_LOCLB ! indice J Beginning in y direction
+ INTEGER :: IIE_LOCLB ! indice I End in x direction
+ INTEGER :: IJE_LOCLB ! indice J End in y direction
+ ! global indices for the intersection of the local subdomain and the LB zone
+ INTEGER :: IIB_GLBLB ! indice I Beginning in x direction
+ INTEGER :: IJB_GLBLB ! indice J Beginning in y direction
+ INTEGER :: IIE_GLBLB ! indice I End in x direction
+ INTEGER :: IJE_GLBLB ! indice J End in y direction
+ INTEGER :: LOCLBSIZEE, LOCLBSIZEW, LOCLBSIZEN, LOCLBSIZES ! size of the local portion of the LB zone in each direction (East, West, North, South)
+ INTEGER :: GLBLBBEGIN,GLBLBEND
+ !
+ ! SET LB TYPE
+ IF ( HLBTYPE == 'LB' ) THEN
+ YLBTYPEX = 'LBX'
+ YLBTYPEY = 'LBY'
+ ELSE IF ( HLBTYPE == 'LBU' ) THEN
+ YLBTYPEX = 'LBXU'
+ YLBTYPEY = 'LBYV'
+ ELSE
+ WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, UNKNOWN LB TYPE", HLBTYPE
+ CALL ABORT
+ ENDIF
+!
+! get the local indices of the West-East LB arrays for the local subdomain
+ CALL GET_DISTRIB_LB(YLBTYPEX,ISP,'LOC','WRITE',NRIMX,IIB_LOCLB,IIE_LOCLB,IJB_LOCLB,IJE_LOCLB)
+! and the corresponding indices for the LB global arrays
+ CALL GET_DISTRIB_LB(YLBTYPEX,ISP,'FM','WRITE',NRIMX,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
+ IF ( IIE_LOCLB-IIB_LOCLB /= IIE_GLBLB-IIB_GLBLB ) THEN
+ WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, West-East IIE_LOCLB-IIB_LOCLB =", IIE_LOCLB-IIB_LOCLB, " /= IIE_GLBLB-IIB_GLBLB =", IIE_GLBLB-IIB_GLBLB
+ CALL ABORT
+ ENDIF
+ LOCLBSIZEW = 0
+ LOCLBSIZEE = 0
+ IF ( IIB_LOCLB /= 0 ) THEN ! if the LB zone of the local subdomain is non-empty
+ ! WARNING : The size of the local portion of the LB zone can be less than NRIMX
+ ! Example : if the size of the subdomain is 4 and NRIMX=6, the LB zone will be divided between 2 processes
+ ! and LOCLBSIZEW will be 5 on the first process, and 2 on the second process
+ IF ( IIB_GLBLB <= NRIMX+JPHEXT .AND. IIE_GLBLB >= NRIMX+JPHEXT+1 ) THEN ! the local west and east LB zones are both non empty
+ LOCLBSIZEW = NRIMX+JPHEXT-IIB_GLBLB
+ PLBXFIELD(IIB_LOCLB:IIB_LOCLB+LOCLBSIZEW,:,:) = PFIELD(IIB_GLBLB+SHIFTWEST:IIB_GLBLB+SHIFTWEST+LOCLBSIZEW,:,:)
+ PLBXFIELD(IIE_LOCLB-LOCLBSIZEW:IIE_LOCLB,:,:) = PFIELD(IIE+JPHEXT-LOCLBSIZEW+SHIFTEAST:IIE+JPHEXT+SHIFTEAST,:,:)
+ ELSE IF ( IIB_GLBLB <= NRIMX+JPHEXT ) THEN ! the local west LB zone only is non empty
+ LOCLBSIZEW = NRIMX+JPHEXT-IIB_GLBLB
+ PLBXFIELD(IIB_LOCLB:IIE_LOCLB,:,:) = PFIELD(IIB_GLBLB+SHIFTWEST:IIE_GLBLB+SHIFTWEST,:,:)
+ ELSE IF ( IIB_GLBLB >= NRIMX+JPHEXT+1 ) THEN ! the local east LB zone only is non empty
+! LOCLBSIZEE = IIE_LOCLB-IIB_LOCLB
+ GLBLBBEGIN = IIE+JPHEXT-(2*NRIMX+2*JPHEXT-IIB_GLBLB)+SHIFTEAST
+ GLBLBEND = IIE+JPHEXT-(2*NRIMX+2*JPHEXT-IIE_GLBLB)+SHIFTEAST
+ PLBXFIELD(IIB_LOCLB:IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
+! PLBXFIELD(NRIMX+1+IIB_LOCLB:NRIMX+1+IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
+ ELSE
+ WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
+ CALL ABORT
+ ENDIF
+ ENDIF !( IIB_LOCLB /= 0 )
+!
+!* 5.9.1.8 Y-direction variables
+!
+ IF( .NOT. L2D ) THEN
+ LOCLBSIZES = 0
+ LOCLBSIZEN = 0
+ ! get the local indices of the South-North LB arrays for the local subdomain
+ CALL GET_DISTRIB_LB(YLBTYPEY,ISP,'LOC','WRITE',NRIMY,IIB_LOCLB,IIE_LOCLB,IJB_LOCLB,IJE_LOCLB)
+ ! and the corresponding indices for the LB global arrays
+ CALL GET_DISTRIB_LB(YLBTYPEY,ISP,'FM','WRITE',NRIMY,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
+ IF ( IJE_LOCLB-IJB_LOCLB /= IJE_GLBLB-IJB_GLBLB ) THEN
+ WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, South-North IJE_LOCLB-IJB_LOCLB =", IJE_LOCLB-IJB_LOCLB, " /= IJE_GLBLB-IJB_GLBLB =", IJE_GLBLB-IJB_GLBLB
+ CALL ABORT
+ ENDIF
+ IF ( IJB_LOCLB /= 0 ) THEN ! if the LB zone of the local subdomain is non-empty
+ IF ( IJB_GLBLB <= NRIMY+JPHEXT .AND. IJE_GLBLB >= NRIMY+JPHEXT+1 ) THEN ! the local south and north LB zones are non empty
+ LOCLBSIZES = NRIMY+JPHEXT-IJB_GLBLB
+ PLBYFIELD(:,IJB_LOCLB:IJB_LOCLB+LOCLBSIZES,:) = PFIELD(:,IJB_GLBLB+SHIFTSOUTH:IJB_GLBLB+LOCLBSIZES+SHIFTSOUTH,:)
+ PLBYFIELD(:,IJE_LOCLB-LOCLBSIZES:IJE_LOCLB,:) = PFIELD(:,IJE+JPHEXT-LOCLBSIZES+SHIFTNORTH:IJE+JPHEXT+SHIFTNORTH,:)
+ ELSE IF ( IJB_GLBLB <= NRIMY+JPHEXT ) THEN ! the local south LB zone only is non empty
+ LOCLBSIZES = NRIMY+JPHEXT-IJB_GLBLB
+ PLBYFIELD(:,IJB_LOCLB:IJE_LOCLB,:) = PFIELD(:,IJB_GLBLB+SHIFTSOUTH:IJE_GLBLB+SHIFTSOUTH,:)
+ ELSE IF ( IJB_GLBLB >= NRIMY+JPHEXT+1 ) THEN ! the local north LB zone only is non empty
+ GLBLBBEGIN = IJE+JPHEXT-(2*NRIMY+2*JPHEXT-IJB_GLBLB)+SHIFTNORTH
+ GLBLBEND = IJE+JPHEXT-(2*NRIMY+2*JPHEXT-IJE_GLBLB)+SHIFTNORTH
+ PLBYFIELD(:,IJB_LOCLB:IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
+! PLBYFIELD(:,NRIMY+1+IJB_LOCLB:NRIMY+1+IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
+ ELSE
+ WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
+ CALL ABORT
+ ENDIF
+
+ ENDIF !( IJB_LOCLB /= 0 )
+ ENDIF !( .NOT. L2D )
+!
+ END SUBROUTINE SET_LB_FIELD_ll
+!
+!
+!
+ FUNCTION GET_LOCAL_LB_SIZE_X_ll( KRIMX ) RESULT( LBSIZEX )
+! #######################################################################
+!
+!!**** *GET_LOCAL_LB_SIZE_X_ll * - get the local LB size in X direction,
+!! i.e. the size of the array containing the local portion of the LB zone
+!!
+!! AUTHOR
+!! ------
+!!
+!! M. Moge * LA, CNRS *
+!!
+!! Original 01/12/14
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+ USE MODE_ll
+ !
+ IMPLICIT NONE
+ !
+
+ INTEGER, INTENT(IN) :: KRIMX ! global LB size in X direction (input)
+ INTEGER :: LBSIZEX ! local LB size in X direction (output)
+ ! Size of the array containing the local portion of the LB zone
+ LBSIZEX = 0
+ IF( LWEST_ll() ) THEN
+ LBSIZEX = LBSIZEX + KRIMX+1
+ ENDIF
+ IF( LEAST_ll() ) THEN
+ LBSIZEX = LBSIZEX + KRIMX+1
+ ENDIF
+!
+ END FUNCTION GET_LOCAL_LB_SIZE_X_ll
+!
+!
+!
+ FUNCTION GET_LOCAL_LB_SIZE_Y_ll( KRIMY ) RESULT( LBSIZEY )
+! #######################################################################
+!
+!!**** *GET_LOCAL_LB_SIZE_Y_ll * - get the local LB size in Y direction,
+!! i.e. the size of the array containing the local portion of the LB zone
+!!
+!! AUTHOR
+!! ------
+!!
+!! M. Moge * LA, CNRS *
+!!
+!! Original 01/12/14
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+ USE MODE_ll
+ !
+ IMPLICIT NONE
+ !
+
+ INTEGER, INTENT(IN) :: KRIMY ! global LB size in Y direction (input)
+ INTEGER :: LBSIZEY ! local LB size in Y direction (output)
+ ! Size of the array containing the local portion of the LB zone
+ LBSIZEY = 0
+ IF( LSOUTH_ll() ) THEN
+ LBSIZEY = LBSIZEY + KRIMY+1
+ ENDIF
+ IF( LNORTH_ll() ) THEN
+ LBSIZEY = LBSIZEY + KRIMY+1
+ ENDIF
+!
+ END FUNCTION GET_LOCAL_LB_SIZE_Y_ll
+!
END MODULE MODE_LB_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90 b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
index 74b3a7255fc971a04ba493fe8c027c7d2a0db7ac..0626ce6ba719541e8e7c980b69172d802ff245e8 100644
--- a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
@@ -654,7 +654,7 @@
END SUBROUTINE UNSET_LSFIELD_2WAY_ll
!
! #########################################
- SUBROUTINE LS_FORCING_ll( KCHILD, KINFO )
+ SUBROUTINE LS_FORCING_ll( KCHILD, KINFO, OEXTRAPOL, OCYCLIC_EXTRAPOL )
! #########################################
!!
!!**** *LS_FORCING_ll* - routine to do the forcing
@@ -700,6 +700,7 @@
!! Modifications
!! -------------
! Original 11 fev. 2000
+! 24/02/2015 (M.Moge) calling EXTRAPOL_ON_PSEUDO_HALO for cyclic cases where the child grid is the whole father grid
!
!-------------------------------------------------------------------------------
!
@@ -712,6 +713,9 @@
!
USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_CRSPD, COPY_CRSPD
USE MODE_NEST_ll, ONLY : GO_TOMODEL_ll
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ USE MODE_EXTRAPOL, ONLY : EXTRAPOL_ON_PSEUDO_HALO
+ USE MODE_MODELN_HANDLER, ONLY : GOTO_MODEL
!
IMPLICIT NONE
!
@@ -720,6 +724,8 @@
!
INTEGER, INTENT(IN) :: KCHILD
INTEGER, INTENT(OUT) :: KINFO
+ LOGICAL, OPTIONAL, INTENT(IN) :: OEXTRAPOL !if TRUE, call EXTRAPOL_ON_PSEUDO_HALO
+ LOGICAL, OPTIONAL, INTENT(IN) :: OCYCLIC_EXTRAPOL !pass to EXTRAPOL_ON_PSEUDO_HALO, perform a cyclic extrapolation if TRUE
!
!
!* 0.2 declarations of local variables
@@ -730,6 +736,7 @@
TYPE(PROC_COM_DATA_ll), POINTER :: TZCHILD_COMDATA ! child
TYPE(PARENT2CHILD_DATA_ll), POINTER :: TZP2C_DATA
INTEGER :: KINITIALMODEL, KINFO2
+ TYPE(LIST_ll), POINTER :: TZLISTCURRENT
!
!-------------------------------------------------------------------------------
!
@@ -802,6 +809,40 @@
!
CALL GO_TOMODEL_ll(KINITIALMODEL, KINFO2)
!
+! CALL GO_TOMODEL_ll(KCHILD, KINFO2)
+! CALL GOTO_MODEL(KCHILD)
+ IF ( PRESENT(OEXTRAPOL) ) THEN
+ IF ( OEXTRAPOL ) THEN
+ TZLISTCURRENT => TZCHILD_COMDATA%TRECV_1WAY_LS%TLIST
+ DO WHILE(ASSOCIATED(TZLISTCURRENT))
+ IF( ASSOCIATED(TZLISTCURRENT%ARRAY3D) )THEN
+ IF ( PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+ CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY3D,OCYCLIC_EXTRAPOL)
+ ELSE
+ CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY3D)
+ ENDIF
+ ENDIF
+ IF( ASSOCIATED(TZLISTCURRENT%ARRAY2D) )THEN
+ IF ( PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+ CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY2D,OCYCLIC_EXTRAPOL)
+ ELSE
+ CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY2D)
+ ENDIF
+ ENDIF
+! IF( ASSOCIATED(TZLISTCURRENT%ARRAY1D) )THEN
+! IF ( PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+! CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY1D,OCYCLIC_EXTRAPOL)
+! ELSE
+! CALL EXTRAPOL_ON_PSEUDO_HALO(TZLISTCURRENT%ARRAY1D)
+! ENDIF
+! ENDIF
+ TZLISTCURRENT => TZLISTCURRENT%NEXT
+ ENDDO
+ ENDIF
+ ENDIF
+! CALL GO_TOMODEL_ll(KINITIALMODEL, KINFO2)
+! CALL GOTO_MODEL(KINITIALMODEL)
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE LS_FORCING_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index 927d94affd05560ea2a3a4445d65eee69501a120..d7b340668f1c2acfdd24665628a5c02ad64d239a 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -6,6 +6,7 @@ MODULE MODE_MPPDB
!
! Modifs :
!! J.Escobar 23/10/2012: correct CHECK_LB & format print output
+!! M.Moge 05/02/2015: MPPDB_CHECK_SURFEX2D and MPPDB_CHECK_SURFEX3D + bug fix in MPPDB_CHECK2D and MPPDB_CHECK3D (call MPI_AllReduce at the beginning)
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!
IMPLICIT NONE
@@ -258,7 +259,7 @@ CONTAINS
USE MODD_PARAMETERS_ll, ONLY : JPHEXT
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
- USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE
+ USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM
IMPLICIT NONE
@@ -281,8 +282,11 @@ CONTAINS
INTEGER :: I_FIRST_FATHER
REAL :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
+ INTEGER :: IGLBSIZEPTAB
REAL,POINTER, DIMENSION(:,:,:) :: TAB_INTERIOR_ll ! for easy debug
+ INTEGER :: IK
+ INTEGER :: KSIZEBUF
INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll
INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
@@ -292,13 +296,16 @@ CONTAINS
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
RETURN
#else
- IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. (SIZE(PTAB) == 0 ) ) RETURN
+ IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN
+ !get the global size of PTAB
+ CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MPI_INTEGER, MPI_SUM, MPPDB_INTER_COMM, IINFO_ll)
+ IF ( IGLBSIZEPTAB == 0 ) RETURN
!
CALL MPPDB_BARRIER()
!
IF(MPPDB_FATHER_WORLD) THEN
!
- ! Reconstruct the all PTAB in TAB_ll
+ ! Reconstruct the whole PTAB in TAB_ll
!
CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
IIU_ll = IIMAX_ll+2*JPHEXT
@@ -452,7 +459,9 @@ CONTAINS
USE MODD_PARAMETERS_ll, ONLY : JPHEXT
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
- USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE
+ USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM
+
+ USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
IMPLICIT NONE
@@ -476,6 +485,7 @@ CONTAINS
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
REAL,POINTER, DIMENSION(:,:) :: TAB_INTERIOR_ll ! for easy debug
+ INTEGER :: IGLBSIZEPTAB
INTEGER :: IIU_SON_ll,IJU_SON_ll
INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
@@ -485,7 +495,9 @@ CONTAINS
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
RETURN
#else
- IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. (SIZE(PTAB) == 0 ) ) RETURN
+ IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN
+ CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MPI_INTEGER, MPI_SUM, MPPDB_INTRA_COMM, IINFO_ll)
+ IF ( IGLBSIZEPTAB == 0 ) RETURN
CALL MPPDB_BARRIER()
@@ -579,7 +591,6 @@ CONTAINS
ITAG, MPPDB_INTRA_COMM, IINFO_ll)
CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
ITAG, MPPDB_INTRA_COMM, IINFO_ll)
-
END IF
END IF
@@ -615,7 +626,7 @@ CONTAINS
!
REAL,ALLOCATABLE, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll,TAB_SAVE_ll
REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
- REAL,DIMENSION(:,:,:), POINTER :: TX3DP
+ REAL,DIMENSION(:,:,:), POINTER :: TX3DP,TAB_INTERIOR_ll
INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER :: IIU,IJU,IIU_ll,IJU_ll,IKU_ll
INTEGER :: IINFO_ll
@@ -626,8 +637,12 @@ CONTAINS
INTEGER :: I_FIRST_FATHER
REAL :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
- INTEGER :: JI
- INTEGER :: IIB,IIE,IJB,IJE
+ INTEGER :: JI
+ INTEGER :: IIB,IIE,IJB,IJE
+
+ INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll
+ INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
+ INTEGER :: IHEXT_SON_ll , IDIFF_HEXT , IRIM_ll , IRIM_SON_ll
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
@@ -645,15 +660,17 @@ CONTAINS
IIU_ll = IIMAX_ll+2*JPHEXT
IJU_ll = IJMAX_ll+2*JPHEXT
IKU_ll = SIZE(PLB,3)
+ IRIM_ll = (KRIM+JPHEXT)*2
+
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+ IIU_ll = IRIM_ll
+ ELSE
+ IJU_ll = IRIM_ll
+ END IF
IF (MPPDB_IRANK_WORLD.EQ.0) THEN
! I/O proc case
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D((KRIM+1)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- ELSE ! HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV'
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(KRIM+1)*2,SIZE(PLB,3)))
- END IF
+ ALLOCATE(Z3D(IIU_ll,IJU_ll,SIZE(PLB,3)))
DO JI = 1,ISNPROC
CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE)
IF (IIB /= 0) THEN
@@ -684,23 +701,59 @@ CONTAINS
!
! I'm the first FATHER => recieve the correct globale ARRAY from first son
!
- ALLOCATE(TAB_SON_ll(SIZE(Z3D,1),SIZE(Z3D,2),SIZE(Z3D,3)))
!
! the first son , is the next processus after this 'world' so
!
I_FIRST_SON = MPPDB_NBPROC_WORLD
!
+ ! recieve JPHEXT from son if different
+ !
+ CALL MPI_RECV(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_SON, &
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
+
+ IIU_SON_ll = IIMAX_ll+2*IHEXT_SON_ll
+ IJU_SON_ll = IJMAX_ll+2*IHEXT_SON_ll
+ IKU_SON_ll = SIZE(PLB,3)
+ IRIM_SON_ll = (KRIM+IHEXT_SON_ll)*2
+ !
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+ IIU_SON_ll = IRIM_SON_ll
+ ELSE
+ IJU_SON_ll = IRIM_SON_ll
+ END IF
+ !
+ ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll))
+ !
CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
!
-
+ IDIFF_HEXT = MIN(JPHEXT,IHEXT_SON_ll)
+ !
ALLOCATE(TAB_SAVE_ll(SIZE(Z3D,1),SIZE(Z3D,2),SIZE(Z3D,3)))
+ !
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+
+ ELSE
+ END IF
+ IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
+ IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
+
+ IIB_SON_ll = 1 + IHEXT_SON_ll ; IJB_SON_ll = 1 + IHEXT_SON_ll
+ IIE_SON_ll = IIU_SON_ll-IHEXT_SON_ll ; IJE_SON_ll = IJU_SON_ll-IHEXT_SON_ll
+ !
TAB_SAVE_ll = Z3D
- Z3D = ABS ( Z3D - TAB_SON_ll )
+ Z3D = 0.0
+ Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) &
+ = ABS ( TAB_SAVE_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) &
+ - TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT &
+ ,1:IKU_SON_ll) )
+ !
+ MAX_VAL = MAXVAL( ABS (TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,&
+ IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT,1:IKU_SON_ll) ) )
+ IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
!
- MAX_VAL = MAXVAL( ABS (TAB_SON_ll) )
- IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
- MAX_DIFF = MAXVAL( Z3D(:,:,:) / MAX_VAL )
+ MAX_DIFF=MAXVAL(Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)/MAX_VAL)
+ TAB_INTERIOR_ll=> Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)
!
IF (MAX_DIFF > PRECISION ) THEN
print*," MPPDB_CHECKLB :: PB MPPDB_CHECKLB =", MESSAGE ," ERROR=",MAX_DIFF , MAX_VAL
@@ -721,6 +774,9 @@ CONTAINS
! first son --> send the good array to the first father
!
I_FIRST_FATHER = 0
+ IHEXT_SON_ll = JPHEXT
+ CALL MPI_BSEND(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_FATHER, &
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
CALL MPI_BSEND(PLB,SIZE(PLB),MPI_PRECISION,I_FIRST_FATHER, &
ITAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
@@ -729,6 +785,245 @@ CONTAINS
CALL MPPDB_BARRIER()
#endif
END SUBROUTINE MPPDB_CHECKLB
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ SUBROUTINE MPPDB_CHECK_SURFEX2D(PTAB,MESSAGE,PRECISION,KLUOUT,HTYPE,KIU,KJU)
+
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+ USE MODI_GATHER_ll
+ USE MODD_VAR_ll , ONLY : MPI_PRECISION
+ USE MODI_GET_1D_MASK
+ USE MODI_UNPACK_SAME_RANK
+ USE MODI_GET_SURF_MASK_n
+ USE MODD_IO_SURF_MNH, ONLY : NHALO
+ USE MODD_SURF_ATM_n, ONLY : XCOVER
+
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:), INTENT(IN) :: PTAB
+ CHARACTER(len=*), INTENT(IN) :: MESSAGE
+ REAL, INTENT(IN) :: PRECISION
+ CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HTYPE ! 'WATER', 'NATURE', 'TOWN', 'SEA', 'FULL' (default is 'FULL')
+ INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+ INTEGER, INTENT(IN),OPTIONAL :: KIU ! size of local subdomain in X direction, useful in case where GET_INDICE_ll does not give the sire of the desired model (e.g. in pgd2)
+ INTEGER, INTENT(IN),OPTIONAL :: KJU ! size of local subdomain in Y direction
+ !
+ ! local var
+ !
+ REAL,ALLOCATABLE, DIMENSION(:) :: PTAB_UNPACKED
+ REAL,ALLOCATABLE, DIMENSION(:,:) :: ZFIELD2D
+ INTEGER :: IIU,IJU
+ INTEGER :: KXOR, KYOR, KXEND, KYEND ! origin and end of the local physical subdomain
+ INTEGER :: II,IJ
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: KMASK
+ INTEGER :: KSIZE
+ INTEGER :: KSIZE_FULL
+ !
+ IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN
+ !
+! IF ( SIZE(PTAB) == 0 ) THEN
+! ALLOCATE(ZFIELD2D(0,0))
+! RETURN
+ !
+ ! Get the dimensions of the subdomain
+ !
+ IF ( PRESENT(KIU) .AND. PRESENT(KJU) ) THEN
+ IIU = KIU+2*JPHEXT
+ IJU = KJU+2*JPHEXT
+ KSIZE_FULL = KIU*KJU
+ ELSE
+ CALL GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND )
+ IIU = KXEND-KXOR+1+2*JPHEXT
+ IJU = KYEND-KYOR+1+2*JPHEXT
+ KSIZE_FULL = (KXEND-KXOR+1)*(KYEND-KYOR+1)
+ IF ( PRESENT(HTYPE) .AND. KSIZE_FULL /= SIZE(XCOVER,1) .AND. NHALO /= JPHEXT ) THEN
+ IIU = KXEND-KXOR+1+2*JPHEXT+2*NHALO
+ IJU = KYEND-KYOR+1+2*JPHEXT+2*NHALO
+ KSIZE_FULL = (KXEND-KXOR+1+2*NHALO) * (KYEND-KYOR+1+2*NHALO)
+ ENDIF
+ ENDIF
+ !
+ ! Unpack PTAB
+ !
+ IF(PRESENT(HTYPE)) THEN
+ KSIZE = SIZE( PTAB, 1 )
+ ALLOCATE( KMASK(KSIZE) )
+ ALLOCATE( PTAB_UNPACKED(KSIZE_FULL) )
+ CALL GET_SURF_MASK_n(HTYPE,KSIZE,KMASK,KSIZE_FULL,KLUOUT)
+ CALL UNPACK_SAME_RANK( KMASK, PTAB, PTAB_UNPACKED )
+ ELSE
+ KSIZE = KSIZE_FULL
+ ALLOCATE( PTAB_UNPACKED(KSIZE) )
+ PTAB_UNPACKED(:) = PTAB(:)
+ ENDIF
+ !
+ ! Redimension PTAB into a 2D field
+ !
+ ALLOCATE(ZFIELD2D(IIU,IJU))
+ ZFIELD2D = 0.
+ DO IJ=1+JPHEXT,IJU-JPHEXT
+ DO II=1+JPHEXT,IIU-JPHEXT
+ ZFIELD2D(II,IJ) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT)
+ ENDDO
+ ENDDO
+ !
+ ! Call MPPDB_CHECK2D on ZFIELD3D
+ !
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ write(6,*) ' MPPDB_CHECK_SURFEX2D :'
+ ENDIF
+ CALL MPPDB_CHECK2D(ZFIELD2D,MESSAGE,PRECISION)
+
+ IF (ALLOCATED(KMASK)) DEALLOCATE( KMASK )
+ IF (ALLOCATED(PTAB_UNPACKED)) DEALLOCATE( PTAB_UNPACKED )
+ IF (ALLOCATED(ZFIELD2D)) DEALLOCATE( ZFIELD2D )
+ !
+ END SUBROUTINE MPPDB_CHECK_SURFEX2D
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ SUBROUTINE MPPDB_CHECK_SURFEX3D(PTAB,MESSAGE,PRECISION,KLUOUT,HTYPE,KZSIZE)
+
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+ USE MODI_GATHER_ll
+ USE MODD_VAR_ll , ONLY : MPI_PRECISION
+ USE MODI_GET_1D_MASK
+ USE MODI_UNPACK_SAME_RANK
+ USE MODI_GET_SURF_MASK_n
+ USE MODD_IO_SURF_MNH, ONLY : NHALO
+ USE MODD_SURF_ATM_n, ONLY : XCOVER
+ USE MODD_CONFZ , ONLY : MPI_BUFFER_SIZE
+ USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM
+!
+ IMPLICIT NONE
+!
+ REAL, DIMENSION(:,:) :: PTAB
+ CHARACTER(len=*) :: MESSAGE
+ REAL :: PRECISION
+ CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HTYPE ! 'WATER', 'NATURE', 'TOWN', 'SEA', 'FULL' (default is 'FULL')
+ INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+ INTEGER, INTENT(IN),OPTIONAL :: KZSIZE ! size of Z-dimension. Necessary if PTAB is of size 0 on one process
+ !
+ ! local var
+ !
+ REAL,ALLOCATABLE, DIMENSION(:,:) :: PTAB_UNPACKED
+ REAL,ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELD3D
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: KXOR, KYOR, KXEND, KYEND ! origin and end of the local physical subdomain
+ INTEGER :: II,IJ,IK
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: KMASK
+ INTEGER :: KSIZE
+ INTEGER :: KSIZEBUF
+ INTEGER :: KSIZE_FULL
+ INTEGER :: IGLBSIZEPTAB
+ INTEGER :: INBSLICES
+ INTEGER :: IINFO_ll
+ !
+ IF ( ( .NOT. MPPDB_INITIALIZED ) ) RETURN
+ CALL MPI_ALLREDUCE(SIZE(PTAB), IGLBSIZEPTAB, 1,MPI_INTEGER, MPI_SUM, MPPDB_INTRA_COMM, IINFO_ll)
+ IF ( IGLBSIZEPTAB == 0 ) RETURN
+ !
+ IF ( SIZE(PTAB) == 0 ) THEN !if the local size of the field is 0, we need to define ZFIELD3D filled with default value 1e20
+ CALL GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND )
+ IIU = KXEND-KXOR+1+2*JPHEXT
+ IJU = KYEND-KYOR+1+2*JPHEXT
+ IKU = KZSIZE
+ ALLOCATE(ZFIELD3D(IIU,IJU,IKU))
+ ZFIELD3D = 1.E20
+ ELSE
+ !
+ ! Get the dimensions of the subdomain
+ !
+ CALL GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND )
+ IIU = KXEND-KXOR+1+2*JPHEXT
+ IJU = KYEND-KYOR+1+2*JPHEXT
+ IKU = SIZE(PTAB,2)
+ KSIZE_FULL = (KXEND-KXOR+1)*(KYEND-KYOR+1)
+ IF ( PRESENT(HTYPE) .AND. KSIZE_FULL /= SIZE(XCOVER,1) .AND. NHALO /= JPHEXT ) THEN
+ KSIZE_FULL = (KXEND-KXOR+1+2*NHALO) * (KYEND-KYOR+1+2*NHALO)
+ ENDIF
+ !
+ ! Unpack PTAB
+ !
+ IF(PRESENT(HTYPE)) THEN
+ KSIZE = SIZE( PTAB, 1 )
+ ALLOCATE( KMASK(KSIZE) )
+ ALLOCATE( PTAB_UNPACKED(KSIZE_FULL,IKU) )
+ CALL GET_SURF_MASK_n(HTYPE,KSIZE,KMASK,KSIZE_FULL,KLUOUT)
+ DO II=1,IKU
+ CALL UNPACK_SAME_RANK( KMASK, PTAB(:,II), PTAB_UNPACKED(:,II) )
+ ENDDO
+ ELSE
+ KSIZE = KSIZE_FULL
+ ALLOCATE( PTAB_UNPACKED(KSIZE,IKU) )
+ PTAB_UNPACKED(:,:) = PTAB(:,:)
+ ENDIF
+ !
+ ! Redimension PTAB into a 2D field
+ !
+ ALLOCATE(ZFIELD3D(IIU,IJU,IKU))
+ ZFIELD3D = 0.
+ DO IJ=1+JPHEXT,IJU-JPHEXT
+ DO II=1+JPHEXT,IIU-JPHEXT
+ ZFIELD3D(II,IJ,:) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT,:)
+ ENDDO
+ ENDDO
+ ENDIF
+ !
+ ! Call MPPDB_CHECK3D on ZFIELD3D
+ !
+ ! pour eviter de communiquer des tableaux trop grands qui ne passent pas en memoire,
+ ! on "decoupe" le champ en morceaux de taille inferieure a MPI_BUFFER_SIZE*1000000/8
+ !ATTENTION : en fait ça ne suffit pas, il faut prendre une limite plus petite
+ !je choisi arbitrairement 52*102*102 comme limite a la taille globale du champ
+! IF ( SIZE(ZFIELD3D) > MPI_BUFFER_SIZE*1000000/8 ) THEN
+! KSIZEBUF = SIZE(ZFIELD3D,3)*8/MPI_BUFFER_SIZE*1000000
+! IF ( SIZE(ZFIELD3D) > 52*102*102 ) THEN
+ IF ( IGLBSIZEPTAB > MPI_BUFFER_SIZE*1000000/16 ) THEN
+ INBSLICES = IGLBSIZEPTAB/(MPI_BUFFER_SIZE*1000000/16)
+ IF (SIZE(ZFIELD3D,3) >= INBSLICES ) THEN
+ KSIZEBUF = SIZE(ZFIELD3D,3)/INBSLICES
+ ELSE
+ write(6,*) ' MPPDB_CHECK_SURFEX3D : field \"',MESSAGE,'\" is too large to be checked with MPPDB. No checking was done...'
+ ENDIF
+! IF ( IGLBSIZEPTAB > 52*102*102 ) THEN
+! INBSLICES = 52
+! IF (SIZE(ZFIELD3D,3) >=52 ) THEN
+! KSIZEBUF = SIZE(ZFIELD3D,3)/52
+! ELSE
+! KSIZEBUF=1
+! ENDIF
+ DO IK=1,INBSLICES
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ IF ( KSIZEBUF*INBSLICES==SIZE(ZFIELD3D,3) ) THEN
+ write(6,*) ' MPPDB_CHECK_SURFEX3D part ',IK,'/',INBSLICES,' :'
+ ELSE
+ write(6,*) ' MPPDB_CHECK_SURFEX3D part ',IK,'/',INBSLICES+1,' :'
+ ENDIF
+ ENDIF
+ CALL MPPDB_CHECK3D(ZFIELD3D(:,:,(IK-1)*KSIZEBUF+1:IK*KSIZEBUF),MESSAGE,PRECISION)
+ ENDDO
+ IF ( KSIZEBUF*INBSLICES==SIZE(ZFIELD3D,3) ) THEN
+ ELSE
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ write(6,*) ' MPPDB_CHECK_SURFEX3D part ',IK,'/',INBSLICES+1,' :'
+ ENDIF
+ CALL MPPDB_CHECK3D(ZFIELD3D(:,:,KSIZEBUF*INBSLICES+1:),MESSAGE,PRECISION)
+ ENDIF
+ ELSE
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ write(6,*) ' MPPDB_CHECK_SURFEX3D :'
+ ENDIF
+ CALL MPPDB_CHECK3D(ZFIELD3D,MESSAGE,PRECISION)
+ ENDIF
+ IF (ALLOCATED(KMASK)) DEALLOCATE( KMASK )
+ IF (ALLOCATED(PTAB_UNPACKED)) DEALLOCATE( PTAB_UNPACKED )
+ IF (ALLOCATED(ZFIELD3D)) DEALLOCATE( ZFIELD3D )
+ !
+ END SUBROUTINE MPPDB_CHECK_SURFEX3D
+
END MODULE MODE_MPPDB
diff --git a/src/LIB/SURCOUCHE/src/mode_nest_ll.f90 b/src/LIB/SURCOUCHE/src/mode_nest_ll.f90
index cb4c8dcae9d1d1416f9925e6d04ebdf9711c798f..74ea5bfc112c7dbf9940e36b92cfcf3b4647d090 100644
--- a/src/LIB/SURCOUCHE/src/mode_nest_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_nest_ll.f90
@@ -1119,6 +1119,7 @@
! Original 22/07/98
! 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)
!
!-------------------------------------------------------------------------------
!
@@ -1145,7 +1146,7 @@
INTERSECTION, GLOBAL2LOCAL, ADD_ZONE, EXTRACT_ZONE
!
USE MODE_CONSTRUCT_ll, ONLY : INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS, &
- CONSTRUCT_HALO1, CONSTRUCT_HALO2, &
+ CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED, &
CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY
!
USE MODE_SPLITTING_ll , ONLY : SPLIT2, def_splitting2
@@ -1601,6 +1602,7 @@
CALL CONSTRUCT_HALO1(TZCHILD_COMDATA, TZCHILD_PROCONF)
CALL CONSTRUCT_HALO2(TZCHILD_COMDATA, TZCHILD_PROCONF)
+ CALL CONSTRUCT_HALO_EXTENDED(TZCHILD_COMDATA, TZCHILD_PROCONF, JPHEXT+1)
!
CALL CONSTRUCT_TRANS(TZCHILD_COMDATA, TZCHILD_PROCONF)
!JUAN Z_SPLITTING
diff --git a/src/LIB/SURCOUCHE/src/mode_scatter.f90 b/src/LIB/SURCOUCHE/src/mode_scatter.f90
index 8de164e8640a478223e8e37e6793b6d339f562ee..cc933744a2052426508949c9405c1be67f898089 100644
--- a/src/LIB/SURCOUCHE/src/mode_scatter.f90
+++ b/src/LIB/SURCOUCHE/src/mode_scatter.f90
@@ -49,14 +49,18 @@ PUBLIC SCATTER_XXFIELD,SCATTER_XYFIELD,GET_DOMREAD_ll
CONTAINS
-SUBROUTINE SCATTERXX_X1(HDIR,PSEND,PRECV,KROOT,KCOMM)
+SUBROUTINE SCATTERXX_X1(HDIR,PSEND,PRECV,KROOT,KCOMM, TPSPLITTING)
USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_PARAMETERS_ll, ONLY : JPHEXT
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:), TARGET, INTENT(IN) :: PSEND
REAL,DIMENSION(:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
!INCLUDE 'mpif.h'
@@ -78,7 +82,14 @@ IF (ISP == KROOT) THEN
ALLOCATE(REQ_TAB(ISNPROC-1))
ALLOCATE(T_TX1DP(ISNPROC-1))
DO JI = 1,ISNPROC
- CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ IF ( PRESENT(TPSPLITTING) ) THEN
+ IXO = TPSPLITTING(JI)%NXOR - JPHEXT
+ IXE = TPSPLITTING(JI)%NXEND + JPHEXT
+ IYO = TPSPLITTING(JI)%NYOR - JPHEXT
+ IYE = TPSPLITTING(JI)%NYEND + JPHEXT
+ ELSE
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ ENDIF
IF (HDIR == 'XX') THEN
TX1DP=>PSEND(IXO:IXE)
ELSE ! HDIR ='YY'
@@ -98,7 +109,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
DO JI=1,NB_REQ ; DEALLOCATE(T_TX1DP(JI)%X) ; ENDDO
END IF
DEALLOCATE(T_TX1DP)
@@ -110,14 +121,17 @@ END IF
END SUBROUTINE SCATTERXX_X1
-SUBROUTINE SCATTERXX_X2(HDIR,PSEND,PRECV,KROOT,KCOMM)
+SUBROUTINE SCATTERXX_X2(HDIR,PSEND,PRECV,KROOT,KCOMM, TPSPLITTING)
USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_PARAMETERS_ll, ONLY : JPHEXT
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:), TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
!INCLUDE 'mpif.h'
@@ -129,7 +143,14 @@ REAL,DIMENSION(:,:), POINTER :: TX2DP
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
- CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ IF ( PRESENT(TPSPLITTING) ) THEN
+ IXO = TPSPLITTING(JI)%NXOR - JPHEXT
+ IXE = TPSPLITTING(JI)%NXEND + JPHEXT
+ IYO = TPSPLITTING(JI)%NYOR - JPHEXT
+ IYE = TPSPLITTING(JI)%NYEND + JPHEXT
+ ELSE
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ ENDIF
IF (HDIR == 'XX') THEN
TX2DP=>PSEND(IXO:IXE,:)
ELSE ! HDIR ='YY'
@@ -392,6 +413,7 @@ END SUBROUTINE SCATTERXX_N2
SUBROUTINE SCATTERXY_X2(PSEND,PRECV,KROOT,KCOMM)
USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:), INTENT(INOUT):: PRECV
@@ -433,7 +455,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MPI_STATUSES_IGNORE,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
END IF
DEALLOCATE(T_TX2DP)
diff --git a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
index 25b27a78032f8953435e72e669cc041c3280e019..d0178980828817394cb0eb9b7c215d56aa89e738 100644
--- a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
@@ -71,7 +71,7 @@ CONTAINS
!
! Module MODE_CONSTRUCT_ll
! INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS,
- ! CONSTRUCT_HALO1, CONSTRUCT_HALO2,
+ ! CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED,
! CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY,
! COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
!
@@ -103,6 +103,7 @@ CONTAINS
! R. Guivarch 01/01/98 Grid-Nesting
! 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)
!
!-------------------------------------------------------------------------------
!
@@ -116,7 +117,7 @@ CONTAINS
USE MODE_SPLITTING_ll, ONLY : SPLIT2
!
USE MODE_CONSTRUCT_ll, ONLY : INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS, &
- CONSTRUCT_HALO1, CONSTRUCT_HALO2, &
+ CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED, &
CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY, &
COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
!
@@ -196,6 +197,11 @@ CONTAINS
MPI_PRECISION = MNH_MPI_REAL
MPI_2PRECISION = MNH_MPI_2REAL
!
+ ! For bug with intelmpi+ilp64+i8 declare MNH_STATUSES_INGORE
+ !
+ ALLOCATE(MNH_STATUSES_IGNORE(MPI_STATUS_SIZE,NPROC))
+ !MNH_STATUSES_IGNORE => MPI_STATUSES_IGNORE
+ !
!-------------------------------------------------------------------------------
!
!* 2. SET OUTPUT FILE :
@@ -408,6 +414,7 @@ CONTAINS
!
CALL CONSTRUCT_HALO1(TCRRT_COMDATA, TCRRT_PROCONF)
CALL CONSTRUCT_HALO2(TCRRT_COMDATA, TCRRT_PROCONF)
+ CALL CONSTRUCT_HALO_EXTENDED(TCRRT_COMDATA, TCRRT_PROCONF, JPHEXT+1)
!
!
!* 6.6 Construction of 1D communication data
@@ -473,6 +480,421 @@ CONTAINS
!
END SUBROUTINE INI_PARAZ_ll
!
+ ! ################################
+ SUBROUTINE INI_PARAZ_CHILD_ll(KINFO_ll)
+ ! ################################
+ !
+ !!**** *INI_PARAZ_CHILD_ll* - routine to initialize the parallel variables for a child model
+ !! constructed from a father model in PREP_PGD.
+ !! Should be called after INI_PARAZ_ll on the father model
+ !! Similar to INI_PARAZ_ll and INI_CHILD
+ !!
+ !! Purpose
+ !! -------
+ ! the purpose of the routine is to fill the structured type variables
+ ! TCRRT_PROCONF and TCRRT_COMDATA
+ !
+ !!** Method
+ !! ------
+ !!
+ !! External
+ !! --------
+ ! Module MODE_SPLITTING_ll
+ ! SPLIT2
+ !
+ ! Module MODE_CONSTRUCT_ll
+ ! INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS,
+ ! CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED,
+ ! CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY,
+ ! COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
+ !
+ !! Implicit Arguments
+ !! ------------------
+ ! Module MODD_DIM_ll
+ ! JPHEXT - Horizontal External points number
+ ! NDXRATIO_ALL, NDYRATIO_ALL, NXOR_ALL, NYOR_ALL,
+ ! NXEND_ALL, NYEND_ALL,...
+ !
+ ! Module MODD_PARALLEL
+ ! TCRRT_PROCONF - Current configuration for current model
+ ! TCRRT_COMDATA - Current communication data structure for current model
+ ! and local processor
+ !
+ ! Reference
+ !! ---------
+ !
+ !! AUTHOR
+ !! ------
+ ! M. Moge
+ !
+ !! MODIFICATIONS
+ !! -------------
+ ! Original 21/07/15
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ !
+ USE MODD_DIM_ll
+ USE MODD_PARAMETERS_ll
+ USE MODD_STRUCTURE_ll
+ USE MODD_VAR_ll
+ !
+ USE MODE_SPLITTING_ll, ONLY : SPLIT2
+ !
+ USE MODE_CONSTRUCT_ll, ONLY : INI_PZ, INI_EZ, INI_BOUNDARIES, INI_TRANS, &
+ CONSTRUCT_HALO1, CONSTRUCT_HALO2, CONSTRUCT_HALO_EXTENDED, &
+ CONSTRUCT_TRANS, CONSTRUCT_1DX, CONSTRUCT_1DY, &
+ COMPUTE_HALO_MAX, COMPUTE_TRANS_MAX
+ !
+ USE MODE_TOOLSZ_ll, ONLY : SPLITZ, ini_pzz, ini_boundariesz, ini_ezz, construct_transz
+ !
+ !JUANZ
+ USE MODE_MNH_WORLD , ONLY : INIT_NMNH_COMM_WORLD
+ USE MODD_CONFZ , ONLY : NZ_VERB,NZ_PROC,MPI_BUFFER_SIZE,LMNH_MPI_ALLTOALLV_REMAP,NZ_SPLITTING
+ !JUANZ
+ IMPLICIT NONE
+ !
+ !* 0.1 declarations of arguments
+ !
+ INTEGER, INTENT(OUT) :: KINFO_ll
+ !
+ !* 0.2 declarations of local variables
+ !
+ !INTEGER ,PARAMETER :: MPI_BUFFER_SIZE = 140000000
+ CHARACTER,SAVE,ALLOCATABLE,DIMENSION(:) :: MPI_BUFFER
+ !JUAN
+ LOGICAL,SAVE :: GFIRSTCALL = .TRUE.
+ !JUAN
+
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZDZP ! intermediate zone
+ !
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT
+ TYPE(PROCONF_ll), POINTER :: TZPROCONF
+ INTEGER :: JMODEL
+ INTEGER :: IRESP
+ LOGICAL :: GISINIT
+ !
+ !JUAN
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZDZP_SXP1_YP2_Z ! intermediate Full Z = B splitting without halo zone
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZDZP_SX_YP2_ZP1 ! intermediate Full X splitting zone
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZDZP_SXP2_Y_ZP1 ! intermediate Full Y splitting zone
+ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZDZP_SXP2_YP1_Z ! intermediate Full Z = B transposed splitting without halo zone
+
+ INTEGER :: JX_DOMAINS,JY_DOMAINS
+ LOGICAL :: LPREM
+ INTEGER :: P1,P2
+ !JUANZ
+ INTEGER :: P1P2(2), P1P2COORD(2) , IROW , ICOL, NROW, NCOL
+ LOGICAL :: Lperiodic(2), remain_dims(2) , Lreorder
+ INTEGER :: JI
+ INTEGER :: IXSIZE_ll ! global sizes of son domain in father grid
+ INTEGER :: IYSIZE_ll
+ !JUANZ
+ !JUAN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 1. INITIALIZE MPI :
+ ! --------------
+ !
+ ! MPI should already be initialized
+ !
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 2. SET OUTPUT FILE :
+ ! ---------------
+
+ ! CALL OPEN_ll(UNIT=NIOUNIT,FILE=YOUTPUTFILE,ACTION='write',form&
+ ! &='FORMATTED',MODE=SPECIFIC,IOSTAT=IRESP)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 3. ALLOCATION :
+ ! ----------
+ !
+ ! buffer has already been alloacated in the call to INI_PARAZ_ll on the father model
+
+ ALLOCATE(TZDZP(NPROC))
+ !JUAN
+ ALLOCATE(TZDZP_SXP1_YP2_Z(NPROC))
+ ALLOCATE(TZDZP_SXP2_YP1_Z(NPROC))
+ ALLOCATE(TZDZP_SX_YP2_ZP1(NPROC))
+ ALLOCATE(TZDZP_SXP2_Y_ZP1(NPROC))
+ !JUAN
+ !
+ ALLOCATE(TCRRT_PROCONF)
+ CALL ALLOC(TCRRT_COMDATA)
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_B(NPROC))
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_X(NPROC))
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_Y(NPROC))
+ !JUAN
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_SXP1_YP2_Z(NPROC))
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_SXP2_YP1_Z(NPROC))
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_SX_YP2_ZP1(NPROC))
+ ALLOCATE(TCRRT_PROCONF%TSPLITS_SXP2_Y_ZP1(NPROC))
+ !JUAN
+ ALLOCATE(TCRRT_PROCONF%TBOUND(NPROC))
+ NULLIFY(TCRRT_PROCONF%TPARENT)
+ NULLIFY(TCRRT_COMDATA%TPARENT)
+ NULLIFY(TCRRT_PROCONF%TCHILDREN)
+ NULLIFY(TCRRT_COMDATA%TCHILDREN)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 4. SPLITTING OF THE DOMAIN :
+ ! -----------------------
+ !
+ IXSIZE_ll = NIMAX_ll/NDXRATIO_ALL(1)
+ IYSIZE_ll = NJMAX_ll/NDYRATIO_ALL(1)
+ DIMX = IXSIZE_ll*NDXRATIO_ALL(1) + 2*JPHEXT
+ DIMY = IYSIZE_ll*NDYRATIO_ALL(1) + 2*JPHEXT
+ DIMZ = NKMAX_ll + 2*JPVEXT
+ !
+ TCRRT_PROCONF%NUMBER = 1
+ !
+
+ !JUAN CALL SPLITZ(NIMAX_ll,NJMAX_ll,NKMAX_ll,NPROC,TZDZP_SXP2_YP1_Z,'BSPLITTING',NZ_PROC)
+!!$ CALL SPLITZ(NIMAX_ll,NJMAX_ll,NKMAX_ll,NPROC,TZDZP_SXP2_YP1_Z,'BSPLITTING',1)
+!!$ CALL SPLITZ(NIMAX_ll,NJMAX_ll,NKMAX_ll,NPROC,TZDZP_SX_YP2_ZP1,'YSPLITTING',NZ_PROC)
+!!$ CALL SPLITZ(NIMAX_ll,NJMAX_ll,NKMAX_ll,NPROC,TZDZP_SXP2_Y_ZP1,'XSPLITTING',NZ_PROC)
+ ! Add halo directly in Z direction
+
+
+
+ !
+ ! find the B spltting
+ !
+ CALL DEF_SPLITTING2(JX_DOMAINS,JY_DOMAINS,IXSIZE_ll,IYSIZE_ll,NPROC,LPREM)
+ !
+ P1 = JX_DOMAINS
+ IF (DIMZ .NE. 3 ) P1 = MIN(DIMZ,JX_DOMAINS)
+ IF (NZ_PROC .GT. 0 ) P1 = NZ_PROC
+ P2 = NPROC / P1
+ !JUAN PATCH NESTING DIFFERENT SHAPE
+ NZ_PROC = P1
+ IF (NZ_VERB .GE. 5 ) THEN
+ IF ( IP .EQ. 1 )THEN
+ print*," INI_PARAZ_ll:: NZ_PROC =",NZ_PROC
+ print*," INI_PARAZ_ll:: JX_DOMAINS=",JX_DOMAINS
+ print*," INI_PARAZ_ll:: JY_DOMAINS=",JY_DOMAINS
+ print*
+ !
+ print*," INI_PARAZ_ll:: P1=MIN(NZ_PROC,DIMZ) > 0 .OR. MIN(DIMZ,MAX(JX_DOMAINS,JY_DOMAINS))=", P1
+ !
+ print*," INI_PARAZ_ll:: P2=NPROC/P1/ =", P2
+ END IF
+ END IF
+ NP1 = P1
+ NP2 = P2
+ !
+ !JUANZ
+ P1P2(1) = NP2
+ P1P2(2) = NP1
+ Lperiodic(1) = .false.
+ Lperiodic(2) = .false.
+ Lreorder=.false.
+ ! creating cartesian processor grid
+ call MPI_Cart_create(NMNH_COMM_WORLD,2,P1P2,Lperiodic,Lreorder,NMNH_P1P2_WORLD,KINFO_ll)
+ ! Obtaining process ids with in the cartesian grid
+ call MPI_Cart_coords(NMNH_P1P2_WORLD,IP-1,2,P1P2COORD,KINFO_ll)
+
+ ! using cart comworld create east-west(row) sub comworld
+ remain_dims(1) = .false.
+ remain_dims(2) = .true.
+ call MPI_Cart_sub(NMNH_P1P2_WORLD,remain_dims,NMNH_ROW_WORLD,KINFO_ll)
+ CALL MPI_COMM_RANK(NMNH_ROW_WORLD, IROW, KINFO_ll)
+ CALL MPI_COMM_SIZE(NMNH_ROW_WORLD, NROW, KINFO_ll)
+
+ ! using cart comworld create north-south(column) sub comworld
+ remain_dims(1) = .true.
+ remain_dims(2) = .false.
+ call MPI_Cart_sub(NMNH_P1P2_WORLD,remain_dims,NMNH_COL_WORLD,KINFO_ll)
+ CALL MPI_COMM_RANK(NMNH_COL_WORLD, ICOL, KINFO_ll)
+ CALL MPI_COMM_SIZE(NMNH_COL_WORLD, NCOL, KINFO_ll)
+ !JUANZ
+
+
+ ! split the child model according to the father grid elements (coarse)
+ CALL SPLIT2(IXSIZE_ll,IYSIZE_ll,NKMAX_ll,NPROC,TZDZP,YSPLITTING,P1,P2)
+ CALL SPLITZ(IXSIZE_ll,IYSIZE_ll,DIMZ,NPROC,TZDZP_SXP1_YP2_Z,'P1P2SPLITT', 1 ,P1,P2)
+ CALL SPLITZ(IXSIZE_ll,IYSIZE_ll,DIMZ,NPROC,TZDZP_SX_YP2_ZP1,'YSPLITTING', P1,P1,P2)
+ CALL SPLITZ(IXSIZE_ll,IYSIZE_ll,DIMZ,NPROC,TZDZP_SXP2_Y_ZP1,'XSPLITTING', P1,P1,P2)
+ CALL SPLITZ(IXSIZE_ll,IYSIZE_ll,DIMZ,NPROC,TZDZP_SXP2_YP1_Z,'P2P1SPLITT', 1 ,P1,P2)
+
+ ! 'convert' the splitting from coarse (father) to fine (son) grid using NDXRATIO_ALL(1), NDYRATIO_ALL(1)
+ CALL COARSE_TO_FINE(TZDZP)
+ CALL COARSE_TO_FINE(TZDZP_SXP1_YP2_Z)
+ CALL COARSE_TO_FINE(TZDZP_SX_YP2_ZP1)
+ CALL COARSE_TO_FINE(TZDZP_SXP2_Y_ZP1)
+ CALL COARSE_TO_FINE(TZDZP_SXP2_YP1_Z)
+
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 5. INITIALIZATION OF TCRRT_PROCONF :
+ ! -------------------------------
+ !
+ CALL INI_PZ(TCRRT_PROCONF,TZDZP)
+ !JUAN
+ CALL INI_PZZ(TCRRT_PROCONF%TSPLITS_SXP1_YP2_Z,TZDZP_SXP1_YP2_Z)
+ CALL INI_PZZ(TCRRT_PROCONF%TSPLITS_SXP2_YP1_Z,TZDZP_SXP2_YP1_Z)
+ CALL INI_PZZ(TCRRT_PROCONF%TSPLITS_SX_YP2_ZP1,TZDZP_SX_YP2_ZP1)
+ CALL INI_PZZ(TCRRT_PROCONF%TSPLITS_SXP2_Y_ZP1,TZDZP_SXP2_Y_ZP1)
+ !JUAN
+ !
+ CALL INI_BOUNDARIES(TCRRT_PROCONF)
+ !JUAN
+ CALL INI_BOUNDARIESZ(TCRRT_PROCONF)
+ !JUAN
+ !
+ CALL INI_EZ(TCRRT_PROCONF)
+ !JUAN
+ CALL INI_EZZ(TCRRT_PROCONF)
+ !JUAN
+ !
+ CALL INI_TRANS(TCRRT_PROCONF)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 6. INITIALIZATION OF TCRRT_COMDATA :
+ ! -------------------------------
+ !
+ !* 6.1 Model Number
+ !
+ TCRRT_COMDATA%NUMBER = 1
+ !
+ !* 6.2 Pointer from TCRRT_COMDATA to TCRRT_PROCONF for 2Way splitting
+ !
+ TCRRT_COMDATA%TSPLIT_B => TCRRT_PROCONF%TSPLITS_B(IP)
+
+ !TZSPLIT => TCRRT_COMDATA%TSPLIT_B
+ !
+ !
+ !* 6.3 Pointer from TCRRT_COMDATA to TCRRT_PROCONF
+ ! for x-slices splitting
+
+ TCRRT_COMDATA%TSPLIT_X => TCRRT_PROCONF%TSPLITS_X(IP)
+ !
+ !TZSPLIT => TCRRT_COMDATA%TSPLIT_X
+ !
+ !
+ !* 6.4 Pointer from TCRRT_COMDATA to TCRRT_PROCONF
+ ! for y-slices splitting
+ !
+ TCRRT_COMDATA%TSPLIT_Y => TCRRT_PROCONF%TSPLITS_Y(IP)
+ !
+ !TZSPLIT => TCRRT_COMDATA%TSPLIT_Y
+ !
+ !JUAN
+ DO JI=1, NPROC
+ IF ( TCRRT_PROCONF%TSPLITS_SXP1_YP2_Z(JI)%NUMBER .EQ. IP ) THEN
+ TCRRT_COMDATA%TSPLIT_SXP1_YP2_Z => TCRRT_PROCONF%TSPLITS_SXP1_YP2_Z(JI)
+ ENDIF
+ IF ( TCRRT_PROCONF%TSPLITS_SXP2_YP1_Z(JI)%NUMBER .EQ. IP ) THEN
+ TCRRT_COMDATA%TSPLIT_SXP2_YP1_Z => TCRRT_PROCONF%TSPLITS_SXP2_YP1_Z(JI)
+ ENDIF
+ IF ( TCRRT_PROCONF%TSPLITS_SX_YP2_ZP1(JI)%NUMBER .EQ. IP ) THEN
+ TCRRT_COMDATA%TSPLIT_SX_YP2_ZP1 => TCRRT_PROCONF%TSPLITS_SX_YP2_ZP1(JI)
+ ENDIF
+ IF ( TCRRT_PROCONF%TSPLITS_SXP2_Y_ZP1(JI)%NUMBER .EQ. IP ) THEN
+ TCRRT_COMDATA%TSPLIT_SXP2_Y_ZP1 => TCRRT_PROCONF%TSPLITS_SXP2_Y_ZP1(JI)
+ END IF
+ END DO
+ !JUAN
+ !
+ !* 6.5 Construction of HALO1 communication data
+ !
+ CALL CONSTRUCT_HALO1(TCRRT_COMDATA, TCRRT_PROCONF)
+ CALL CONSTRUCT_HALO2(TCRRT_COMDATA, TCRRT_PROCONF)
+ CALL CONSTRUCT_HALO_EXTENDED(TCRRT_COMDATA, TCRRT_PROCONF, JPHEXT+1)
+ !
+ !
+ !* 6.6 Construction of 1D communication data
+ !
+ ALLOCATE(TCRRT_COMDATA%HALO1DX)
+ ALLOCATE(TCRRT_COMDATA%HALO1DX%NSEND_WEST(NPROC))
+ ALLOCATE(TCRRT_COMDATA%HALO1DX%NSEND_EAST(NPROC))
+ CALL CONSTRUCT_1DX(TCRRT_COMDATA, TCRRT_PROCONF)
+ !
+ ALLOCATE(TCRRT_COMDATA%HALO1DY)
+ ALLOCATE(TCRRT_COMDATA%HALO1DY%NSEND_SOUTH(NPROC))
+ ALLOCATE(TCRRT_COMDATA%HALO1DY%NSEND_NORTH(NPROC))
+ CALL CONSTRUCT_1DY(TCRRT_COMDATA, TCRRT_PROCONF)
+ !
+ !
+ !* 6.7 Construction of Transposition communication data
+ !
+ CALL CONSTRUCT_TRANS(TCRRT_COMDATA, TCRRT_PROCONF)
+ CALL CONSTRUCT_TRANSZ(TCRRT_COMDATA, TCRRT_PROCONF)
+ !
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 7. GRID NESTING :
+ ! ------------
+ !
+ ! No grid nesting in this case : We are initializing a child domain directly in PREP_PGD,
+ ! after having called INI_PARAZ_ll on father grid alone
+ !
+ NULLIFY(TCRRT_PROCONF%TCHILDREN)
+ NULLIFY(TCRRT_COMDATA%TCHILDREN)
+ NULLIFY(TCRRT_COMDATA%TP2C_DATA)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ TZPROCONF => TCRRT_PROCONF
+ !
+ CALL COMPUTE_TRANS_MAX(NBUFFERSIZE_3D, TCRRT_COMDATA)
+ IF (NZ_VERB .GE. 5 ) THEN
+ IF (IP.EQ.1) print*,"INI_PARAZ_ll::COMPUTE_TRANS_MAX(NBUFFERSIZE_3D, TCRRT_COMDATA)=",NBUFFERSIZE_3D
+ END IF
+ !JUAN NCOMBUFFSIZE1 = NBUFFERSIZE_3D
+ !NCOMBUFFSIZE1 = NBUFFERSIZE_3D*2
+ NCOMBUFFSIZE1 = NBUFFERSIZE_3D
+ !JUAN NCOMBUFFSIZE1 = 10000000
+ !
+ CALL COMPUTE_HALO_MAX(NMAXSIZEHALO, TCRRT_COMDATA)
+ !
+ !NAG4.0 boom avec le 50 lorsqu'on active les scalaires
+ ! NBUFFERSIZE_2D = 50*NMAXSIZEHALO
+ NBUFFERSIZE_2D = 150*NMAXSIZEHALO
+ !NAG4.0
+ NCOMBUFFSIZE2 = NBUFFERSIZE_2D
+ !
+ DEALLOCATE(TZDZP)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ CONTAINS
+ SUBROUTINE COARSE_TO_FINE(TZ)
+
+ IMPLICIT NONE
+
+ TYPE(ZONE_ll), DIMENSION(:) :: TZ ! grid splitting to transform from coarse (father) resolution/grid
+ ! to fien ( son ) resolution/grid
+
+ INTEGER :: J
+
+ DO J = 1, NPROC
+ !
+ TZ(J)%NUMBER = TZ(J)%NUMBER
+ TZ(J)%NXOR = (TZ(J)%NXOR - JPHEXT -1 ) * NDXRATIO_ALL(1) + JPHEXT +1
+ TZ(J)%NYOR = (TZ(J)%NYOR - JPHEXT -1 ) * NDYRATIO_ALL(1) + JPHEXT +1
+ TZ(J)%NXEND = (TZ(J)%NXEND - JPHEXT ) * NDXRATIO_ALL(1) + JPHEXT
+ TZ(J)%NYEND = (TZ(J)%NYEND - JPHEXT ) * NDYRATIO_ALL(1) + JPHEXT
+ !JUAN Z_SPLITTING
+ TZ(J)%NZOR = TZ(J)%NZOR
+ TZ(J)%NZEND = TZ(J)%NZEND
+ !JUAN Z_SPLITTING
+ !
+ ENDDO
+
+ END SUBROUTINE COARSE_TO_FINE
+
+ END SUBROUTINE INI_PARAZ_CHILD_ll
+ !
! #######################################
!!$ SUBROUTINE SET_NZ_PROC_ll(KZ_PROC)
!!$ ! #######################################
diff --git a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90 b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
index 441b525439963ae08a90e4ef1cc00b8ba2ae67ea..158d5313622d2681529fa70baeb453fce1d293af 100644
--- a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
@@ -34,6 +34,7 @@
! (GET_1DGLOBALSLICE_ll, GET_2DGLOBALSLICE_ll),
! GET_SLICE_ll
! (GET_1DSLICE_ll, GET_2DSLICE_ll)
+! GET_L2_NORM_ll
!
!! Reference
!! ---------
@@ -736,7 +737,7 @@
END SUBROUTINE GET_INDICE_ll
!
! ##########################################
- SUBROUTINE GET_GLOBALDIMS_ll(KIMAX, KJMAX)
+ SUBROUTINE GET_GLOBALDIMS_ll(KIMAX, KJMAX, KMODEL)
! ##########################################
!
!!**** *GET_GLOBALDIMS_ll* - returns the global horizontal dimensions
@@ -788,6 +789,7 @@
!* 0.1 declarations of arguments
!
INTEGER, INTENT(OUT) :: KIMAX, KJMAX ! current model dimensions
+ INTEGER, OPTIONAL, INTENT(IN) :: KMODEL ! number of the current model
!
!* 0.2 declarations of local variables
!
@@ -797,7 +799,11 @@
!
!* 1. Extract the number of the current model.
!
+IF ( PRESENT(KMODEL) ) THEN
+ IMODEL = KMODEL
+ELSE
IMODEL = TCRRT_PROCONF%NUMBER
+ENDIF
!
!* 2. Compute the dimensions of the model
!
@@ -2781,6 +2787,99 @@
!
END SUBROUTINE EXTRACT_ZONE
!
+! #################################################
+ SUBROUTINE EXTRACT_ZONE_EXTENDED( TPSPLITS, TPPZS, TPEZS_EXTENDED, HALOSIZE )
+! #################################################
+!
+!!**** *EXTRACT_ZONE* - routine to construct two splittings variables
+!! from a MODELSPLITTING_ll variable
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to extract two splittings TPPZS,
+! physical zone splitting and TPEZS_EXTENDED, extended zone splitting with halo of size HALOSIZE
+! from a MODELSPLITTING_ll TPSPLITS
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types MODELSPLITTING_ll, ZONE_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll, ZONE_ll
+ USE MODD_VAR_ll, ONLY : NPROC
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(MODELSPLITTING_ll), DIMENSION(:), POINTER :: TPSPLITS
+!
+ TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPPZS, TPEZS_EXTENDED
+!
+ INTEGER, INTENT(IN) :: HALOSIZE
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: J ! loop control variable
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. FILL TPPZS AND TPEZS FOR EACH J :
+! -------------------------------
+!
+ DO J = 1, NPROC
+!
+ TPPZS(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+ TPEZS_EXTENDED(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+!
+ TPPZS(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPPZS(J)%NXOR = TPSPLITS(J)%NXORP+1
+ TPPZS(J)%NYOR = TPSPLITS(J)%NYORP+1
+ TPPZS(J)%NXEND = TPSPLITS(J)%NXENDP+1
+ TPPZS(J)%NYEND = TPSPLITS(J)%NYENDP+1
+!
+ IF ( TPSPLITS(J)%NDIMXP < HALOSIZE .OR. TPSPLITS(J)%NDIMYP < HALOSIZE ) THEN
+ WRITE(*,*) "WARNING : HALOSIZE is greater than model dimension"
+ WRITE(*,*) "HALOSIZE = ", HALOSIZE
+ WRITE(*,*) "model dimensions : ", TPSPLITS(J)%NDIMXP, "x", TPSPLITS(J)%NDIMYP
+ ENDIF
+!
+ TPEZS_EXTENDED(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPEZS_EXTENDED(J)%NXOR = TPSPLITS(J)%NXORP+1-HALOSIZE
+ TPEZS_EXTENDED(J)%NYOR = TPSPLITS(J)%NYORP+1-HALOSIZE
+ TPEZS_EXTENDED(J)%NXEND = TPSPLITS(J)%NXENDP+1+HALOSIZE
+ TPEZS_EXTENDED(J)%NYEND = TPSPLITS(J)%NYENDP+1+HALOSIZE
+!
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE EXTRACT_ZONE_EXTENDED
+!
! ###########################################
SUBROUTINE GLOBAL2LOCAL(TPPROCONF, TPCRSPD)
! ###########################################
@@ -2959,6 +3058,274 @@
!
END SUBROUTINE G2LX
!
+! #################################################
+ SUBROUTINE GET_OR_SURFEX_ll( HSPLIT, KOR )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - returns the origin index of the extended
+! 2way subdomain or of the x-slices subdomain
+! or of the y-slices
+! subdomain of the local processor in a surfex field (global indices)
+!
+!! Purpose
+!! -------
+!! returns the origin index of the extended
+!! 2way subdomain or of the x-slices subdomain
+!! or of the y-slices
+!! subdomain of the local processor in a surfex field (global indices)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 16/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER*1, INTENT(IN) :: HSPLIT
+ INTEGER, INTENT(OUT) :: KOR
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_OR_ll( HSPLIT, IXOR_ll, IYOR_ll )
+ KOR = (IXOR_ll-JPHEXT)*(IYOR_ll-JPHEXT)
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_OR_SURFEX_ll
+!
+!
+! #################################################
+ SUBROUTINE GET_LOCAL_PORTION_OF_SURFEX_FIELD2D( PSURFEXFIELDGLB, POUTPUTFIELDLCL )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - extracts local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!! Purpose
+!! -------
+! extract local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 08/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PSURFEXFIELDGLB
+!
+ REAL, DIMENSION(:), INTENT(OUT) :: POUTPUTFIELDLCL
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: JI,JJ ! loop control variables
+ INTEGER :: IXOR, IYOR, IXEND, IYEND ! beginning and end of local subdomain in local coordinates
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+ INTEGER :: ICOUNT
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
+ CALL GET_OR_ll( 'B', IXOR_ll, IYOR_ll )
+!
+ ICOUNT = 1
+ DO JJ=IYOR_ll+IYOR-1-JPHEXT,IYOR_ll+IYEND-1-JPHEXT
+ DO JI=IXOR_ll+IXOR-1-JPHEXT,IXOR_ll+IXEND-1-JPHEXT
+ POUTPUTFIELDLCL(ICOUNT) = PSURFEXFIELDGLB(JI+(NIMAX_ll)*(JJ-1))
+ ICOUNT = ICOUNT+1
+ ENDDO
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_LOCAL_PORTION_OF_SURFEX_FIELD2D
+!
+!
+! #################################################
+ SUBROUTINE SET_LOCAL_PORTION_OF_SURFEX_FIELD2D( PFIELDLCL, PSURFEXFIELDGLB )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - sets values of local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!! Purpose
+!! -------
+! sets values of local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 09/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PFIELDLCL
+!
+ REAL, DIMENSION(:), INTENT(OUT) :: PSURFEXFIELDGLB
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: JI,JJ ! loop control variables
+ INTEGER :: IXOR, IYOR, IXEND, IYEND ! beginning and end of local subdomain in local coordinates
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+ INTEGER :: ICOUNT
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
+ CALL GET_OR_ll( 'B', IXOR_ll, IYOR_ll )
+!
+ ICOUNT = 1
+ DO JJ=IYOR_ll+IYOR-1-JPHEXT,IYOR_ll+IYEND-1-JPHEXT
+ DO JI=IXOR_ll+IXOR-1-JPHEXT,IXOR_ll+IXEND-1-JPHEXT
+ PSURFEXFIELDGLB(JI+(NIMAX_ll)*(JJ-1)) = PFIELDLCL(ICOUNT)
+ ICOUNT = ICOUNT+1
+ ENDDO
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE SET_LOCAL_PORTION_OF_SURFEX_FIELD2D
+!
+!
+! #################################################
+ SUBROUTINE GET_MEAN_OF_COORD_SQRT_ll(PARRAY,KSIZELOC,KSIZEGLB,PMEANSQRT)
+! #################################################
+!
+!!**** *GET_L2_NORM_ll* - computes the L2 norm of 1D array PARRAY accross all processes
+!
+!! Purpose
+!! -------
+! computes the L2 norm of 1D array PARRAY accross all processes
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 10/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : MPI_PRECISION
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PARRAY
+ INTEGER, INTENT(IN) :: KSIZELOC
+ INTEGER, INTENT(IN) :: KSIZEGLB
+!
+ REAL, INTENT(OUT) :: PMEANSQRT
+!
+!* 0.2 declarations of local variables
+!
+ REAL :: IMEANSQRTLOC
+ INTEGER :: IINFO
+!
+!-------------------------------------------------------------------------------
+!
+IMEANSQRTLOC = SUM(SQRT(PARRAY))
+CALL MPI_ALLREDUCE(IMEANSQRTLOC, PMEANSQRT, 1, MPI_PRECISION, MPI_SUM, NMNH_COMM_WORLD,IINFO)
+PMEANSQRT = PMEANSQRT / KSIZEGLB
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_MEAN_OF_COORD_SQRT_ll
+!
! ##########################################################################
FUNCTION SPREAD_X_ll(HSPLIT, PSOURCE, KDIM, KX, KCOPIES) RESULT(PSPREAD_X)
! ##########################################################################
diff --git a/src/LIB/SURCOUCHE/src/modi_fm.f90 b/src/LIB/SURCOUCHE/src/modi_fm.f90
index f7d81b6f335e22643d82018d540a9a7f4ee775cc..cbcbd10a35342107fd0da5473c45fc509af9174d 100644
--- a/src/LIB/SURCOUCHE/src/modi_fm.f90
+++ b/src/LIB/SURCOUCHE/src/modi_fm.f90
@@ -35,7 +35,7 @@ INTEGER, INTENT(OUT) :: KRESP
END SUBROUTINE FMLOOK_ll
SUBROUTINE FMOPEN_ll(HFILEM,HACTION,HFIPRI,KNPRAR,KFTYPE,KVERB,KNINAR&
- & ,KRESP)
+ & ,KRESP,OPARALLELIO)
CHARACTER(LEN=*),INTENT(IN) ::HFILEM ! name of the file.
CHARACTER(LEN=*),INTENT(IN) ::HACTION ! Action upon the file
! 'READ' or 'WRITE'
@@ -46,13 +46,15 @@ INTEGER, INTENT(IN) ::KFTYPE ! type of FM-file.
INTEGER, INTENT(IN) ::KVERB ! level of verbose.
INTEGER, INTENT(OUT)::KNINAR ! number of articles initially present in the file.
INTEGER, INTENT(OUT)::KRESP ! return-code if a problem araised.
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
END SUBROUTINE FMOPEN_ll
-SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP)
+SUBROUTINE FMCLOS_ll(HFILEM,HSTATU,HFIPRI,KRESP,OPARALLELIO)
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
CHARACTER(LEN=*), INTENT(IN) ::HSTATU ! status for the closed file
CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
INTEGER, INTENT(OUT)::KRESP ! return-code if problems araised
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
END SUBROUTINE FMCLOS_ll
!
END INTERFACE
diff --git a/src/LIB/SURCOUCHE/src/modi_fmread.f90 b/src/LIB/SURCOUCHE/src/modi_fmread.f90
index 509eaae3e7c4d96363575503bd4a7e35908b765d..c1d6968ec519149b3b46221c92009a9391f15194 100644
--- a/src/LIB/SURCOUCHE/src/modi_fmread.f90
+++ b/src/LIB/SURCOUCHE/src/modi_fmread.f90
@@ -29,7 +29,7 @@ INTERFACE FMREAD
END SUBROUTINE FMREADX0_ll
SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
@@ -39,10 +39,12 @@ INTERFACE FMREAD
INTEGER, INTENT(OUT)::KLENCH ! length of comment string
CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
INTEGER, INTENT(OUT)::KRESP ! return-code
+ INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+ INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
END SUBROUTINE FMREADX1_ll
SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
@@ -52,6 +54,8 @@ INTERFACE FMREAD
INTEGER, INTENT(OUT)::KLENCH ! length of comment string
CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
INTEGER, INTENT(OUT)::KRESP ! return-code
+ INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+ INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
END SUBROUTINE FMREADX2_ll
SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
diff --git a/src/LIB/SURCOUCHE/src/modi_io.f90 b/src/LIB/SURCOUCHE/src/modi_io.f90
index 3413cddb536d6086b7cb988cd2c7f1df06919421..1fd0747e877f8634e72fc89a7e418024b015675c 100644
--- a/src/LIB/SURCOUCHE/src/modi_io.f90
+++ b/src/LIB/SURCOUCHE/src/modi_io.f90
@@ -19,7 +19,7 @@ INTERFACE
END SUBROUTINE INITIO_ll
SUBROUTINE OPEN_ll(UNIT,FILE,MODE,LFIPAR,COMM,STATUS,ACCESS, &
- IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD)
+ IOSTAT,FORM,RECL,BLANK,POSITION,ACTION,DELIM,PAD,OPARALLELIO)
USE MODD_IO_ll, ONLY : LFIPARAM
INTEGER, INTENT(OUT) :: UNIT !! Different from
!! fortran OPEN
@@ -37,12 +37,14 @@ INTERFACE
CHARACTER(len=*),INTENT(IN), OPTIONAL :: DELIM
CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD
INTEGER, INTENT(IN), OPTIONAL :: COMM
+ LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
END SUBROUTINE OPEN_ll
- SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS)
+ SUBROUTINE CLOSE_ll(HFILE,IOSTAT,STATUS,OPARALLELIO)
CHARACTER(LEN=*), INTENT(IN) :: HFILE
INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS
+ LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
END SUBROUTINE CLOSE_ll
SUBROUTINE FLUSH_ll(HFILE,IRESP)
diff --git a/src/LIB/SURCOUCHE/src/modi_nest_ll.f90 b/src/LIB/SURCOUCHE/src/modi_nest_ll.f90
index ba3fa864ece5cdeff2b9626fddd513243c5fe893..d4fc1b5f7af4e1d7f03128429c9e057974206a11 100644
--- a/src/LIB/SURCOUCHE/src/modi_nest_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modi_nest_ll.f90
@@ -63,11 +63,13 @@ INTERFACE
END SUBROUTINE UNSET_LSFIELD_2WAY_ll
!
! #########################################
- SUBROUTINE LS_FORCING_ll( KCHILD, KINFO )
+ SUBROUTINE LS_FORCING_ll( KCHILD, KINFO, OEXTRAPOL, OCYCLIC_EXTRAPOL )
! #########################################
!
INTEGER, INTENT(IN) :: KCHILD
INTEGER, INTENT(OUT) :: KINFO
+ LOGICAL, OPTIONAL, INTENT(IN) :: OEXTRAPOL
+ LOGICAL, OPTIONAL, INTENT(IN) :: OCYCLIC_EXTRAPOL
!
END SUBROUTINE LS_FORCING_ll
!
diff --git a/src/MNH/anel_balancen.f90 b/src/MNH/anel_balancen.f90
index 8f5101d82c4279af2ce646255254864c9b64125d..f986c94a339617d4fb5fa5b8c71ecc138aa918ac 100644
--- a/src/MNH/anel_balancen.f90
+++ b/src/MNH/anel_balancen.f90
@@ -106,6 +106,8 @@ END MODULE MODI_ANEL_BALANCE_n
!! J.Stein and J.P. lafore 17/04/96 new version including the way to choose
!! the model number and the instant where the projection is performed
!! Stein,Lafore 14/01/97 new anelastic equations
+!! M.Faivre 2014
+!! M.Moge 08/2015 removing UPDATE_HALO_ll(XRHODJ) + EXTRAPOL on ZRU and ZRV in part 3.1
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -135,13 +137,16 @@ USE MODI_PRESSUREZ
USE MODE_SPLITTINGZ_ll
USE MODI_SHUMAN
!
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_MPPDB
+USE MODE_EXTRAPOL
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments :
!
REAL, OPTIONAL :: PRESIDUAL
!
-!
!* 0.2 Declarations of local variables :
!
INTEGER :: ILUOUT,IRESP ! Logical unit number for output listing and
@@ -185,6 +190,9 @@ INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IK
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZBFB,ZBF_SXP2_YP1_Z
!JUAN
!
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+!
!-------------------------------------------------------------------------------
!
!* 1. PROLOGUE :
@@ -207,17 +215,19 @@ ALLOCATE(ZBFB(IIU_B,IJU_B,IKU))
CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)
ALLOCATE(ZBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll))
!JUAN Z_SPLITING
+CALL MPPDB_CHECK3D(XRHODJ,"anel_balancen1-::XRHODJ",PRECISION)
+CALL MPPDB_CHECK3D(XUT,"anel_balancen1-::XUT",PRECISION)
!
!-------------------------------------------------------------------------------
!
!* 2. PRESSURE SOLVER INITIALIZATION :
! -------------------------------
!
-
!
CALL TRIDZ(CLUOUT0,CLBCX,CLBCY,XMAP,XDXHAT,XDYHAT,ZDXHATM,ZDYHATM,ZRHOM, &
ZAF,ZCF,ZTRIGSX,ZTRIGSY,IIFAXX,IIFAXY,XRHODJ,XTHVREF,XZZ,ZBFY,&
ZBFB,ZBF_SXP2_YP1_Z)
+CALL MPPDB_CHECK3D(XRHODJ,"anel_balancen1-after TRIDZ::XRHODJ",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -227,12 +237,35 @@ CALL TRIDZ(CLUOUT0,CLBCX,CLBCY,XMAP,XDXHAT,XDYHAT,ZDXHATM,ZDYHATM,ZRHOM, &
!
!* 3.1 multiplication by RHODJ
!
+!$20140710 UPHALO on XRHODJ
+!CALL ADD3DFIELD_ll(TZFIELDS_ll,XRHODJ)
+!CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK3D(XRHODJ,"anel_balancen3.1-after update halo::XRHODJ",PRECISION)
+CALL MPPDB_CHECK3D(XUT,"anel_balancen3.1-after update halo::XUT",PRECISION)
+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(:,:,:)
ZTH(:,:,:) = XTHT(:,:,:)
ALLOCATE(ZRR(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),SIZE(XRT,4)))
ZRR(:,:,:,:) = XRT(:,:,:,:)
+!20131112 appli update_halo_ll
+CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRU)
+CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRV)
+CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRW)
+CALL ADD3DFIELD_ll(TZFIELDS_ll, ZTH)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK3D(ZRU,"anel_balancen3.1-after1stupdhalo::ZRU",PRECISION)
+!$20131125 add extrapol on ZRU to have correct boundaries
+!CALL EXTRAPOL('W',ZRU) ! ZRU boundaries now correct
+CALL MPPDB_CHECK3D(ZRU,"anel_balancen3.1-afterextrapol W::ZRU",PRECISION)
+!20131126 add extrapol on ZRV to have correct boundaries
+!CALL EXTRAPOL('S',ZRV) ! ZRV boundaries now correct
+CALL MPPDB_CHECK3D(ZRV,"anel_balancen3.1-afterextrapol S::ZRV",PRECISION)
+CALL MPPDB_CHECK3D(ZRW,"anel_balancen3.1-afterextrapol S::ZRW",PRECISION)
!
!
!
@@ -260,12 +293,30 @@ CALL PRESSUREZ(CLUOUT, &
ZRU,ZRV,ZRW,ZPABST, &
ZBFB,ZBF_SXP2_YP1_Z,PRESIDUAL )
!
+CALL MPPDB_CHECK3D(XRHODJ,"anel_balancen3.2-after pressurez halo::XRHODJ",PRECISION)
+CALL MPPDB_CHECK3D(ZRU,"anel_balancen3.2-after pressurez::ZRU",PRECISION)
+CALL MPPDB_CHECK3D(ZRV,"anel_balancen3.2-after pressurez::ZRV",PRECISION)
+!
DEALLOCATE(ZBFY,ZTRIGSX,ZTRIGSY,ZRR,ZBF_SXP2_YP1_Z)
!* 3.2 return to the historical variables
!
+!20131112 appli update_halo_ll and associated operations
XUT(:,:,:) = ZRU(:,:,:) / MXM(XRHODJ)
XVT(:,:,:) = ZRV(:,:,:) / MYM(XRHODJ)
XWT(:,:,:) = ZRW(:,:,:) / MZM(1,IKU,1,XRHODJ)
+!20131112 appli update_halo_ll to XUT,XVT,XWT
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XUT)
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XVT)
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XWT)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK3D(XUT,"anel_balancen3.2-afterupdhalo::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"anel_balancen3.2-afterupdhalo::XVT",PRECISION)
+!20131125 apply extrapol to fix boundary issue in //
+CALL EXTRAPOL('W',XUT)
+CALL EXTRAPOL('S',XVT)
+CALL MPPDB_CHECK3D(XUT,"anel_balancen3.2-after extrapolW::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"anel_balancen3.2-after extrapolS::XVT",PRECISION)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/define_maskn.f90 b/src/MNH/define_maskn.f90
index d234f754339b88bdd3a3e23c9959c7f77acb803d..4e1e3a8139ccc8ea4bc77ede5a51817d4e147f62 100644
--- a/src/MNH/define_maskn.f90
+++ b/src/MNH/define_maskn.f90
@@ -69,6 +69,11 @@ USE MODE_FM
USE MODE_IO_ll
USE MODE_MODELN_HANDLER
!
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODE_TOOLS_ll, ONLY : INTERSECTION
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -81,6 +86,13 @@ INTEGER :: IRESP
INTEGER :: ISON
INTEGER :: JLOOP
INTEGER :: IMI
+INTEGER :: IXOR_F, IYOR_F ! origin of local father subdomain (global coord)
+INTEGER :: IXEND_F, IYEND_F ! end of local father subdomain (global coord)
+INTEGER :: IXOR_C, IYOR_C ! origin of intersection between son model and local father subdomain (global coord)
+INTEGER :: IXEND_C, IYEND_C ! end of intersection between son model and local father subdomain (global coord)
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+TYPE(ZONE_ll) :: TZCOARSESONGLB ! global son domain in father grid
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZCOARSESONLCL ! intersection of global son domain and local father subdomain
!-------------------------------------------------------------------------------
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
@@ -89,6 +101,20 @@ IMI=GET_CURRENT_MODEL_INDEX()
ALLOCATE ( NNESTMASK (NIMAX+2*JPHEXT,NJMAX+2*JPHEXT,1+COUNT(NDAD(:)==IMI)))
ALLOCATE ( NSON ( 1+COUNT(NDAD(:)==IMI)))
!
+! get splitting of father model
+ALLOCATE(TZSPLITTING(NPROC))
+ALLOCATE(TZCOARSESONLCL(NPROC))
+CALL SPLIT2 ( NIMAX_ll, NJMAX_ll, 1, NPROC, TZSPLITTING, YSPLITTING )
+! get coords of local father subdomain
+IXOR_F = TZSPLITTING(IP)%NXOR-JPHEXT
+IYOR_F = TZSPLITTING(IP)%NYOR-JPHEXT
+IXEND_F = TZSPLITTING(IP)%NXEND-JPHEXT
+IYEND_F = TZSPLITTING(IP)%NYEND-JPHEXT
+!
+TZCOARSESONGLB%NZOR = TZSPLITTING(IP)%NZOR ! there is no splitting in Z direction
+TZCOARSESONGLB%NZEND = TZSPLITTING(IP)%NZEND ! there is no splitting in Z direction
+TZCOARSESONGLB%NUMBER = TZSPLITTING(IP)%NUMBER
+!
NNESTMASK(:,:,:) = 0
NSON(1) = IMI
!
@@ -97,8 +123,35 @@ DO JLOOP=1,NMODEL
IF (NDAD(JLOOP)/=IMI) CYCLE
ISON=ISON+1
NSON(ISON)=JLOOP
- NNESTMASK(NXOR_ALL(JLOOP)+JPHEXT:NXEND_ALL(JLOOP)-JPHEXT, &
- NYOR_ALL(JLOOP)+JPHEXT:NYEND_ALL(JLOOP)-JPHEXT, ISON) = 1
+ !
+ !JUAN A REVOIR TODO_JPHEXT !!!
+ ! <<<<<<< define_maskn.f90
+ ! init global son zone in father grid coords
+ !
+ ! TZCOARSESONGLB%NXOR = NXOR_ALL(JLOOP)+1
+ ! TZCOARSESONGLB%NYOR = NYOR_ALL(JLOOP)+1
+ ! TZCOARSESONGLB%NXEND = NXEND_ALL(JLOOP)-1
+ ! TZCOARSESONGLB%NYEND = NYEND_ALL(JLOOP)-1
+ TZCOARSESONGLB%NXOR = NXOR_ALL(JLOOP)+JPHEXT
+ TZCOARSESONGLB%NYOR = NYOR_ALL(JLOOP)+JPHEXT
+ TZCOARSESONGLB%NXEND = NXEND_ALL(JLOOP)-JPHEXT
+ TZCOARSESONGLB%NYEND = NYEND_ALL(JLOOP)-JPHEXT
+ ! get the intersection with local father subdomain -> TZCOARSESONLCL
+ CALL INTERSECTION( TZSPLITTING, NPROC, TZCOARSESONGLB, TZCOARSESONLCL)
+ IXOR_C = TZCOARSESONLCL(IP)%NXOR
+ IXEND_C = TZCOARSESONLCL(IP)%NXEND
+ IYOR_C = TZCOARSESONLCL(IP)%NYOR
+ IYEND_C = TZCOARSESONLCL(IP)%NYEND
+ IF ( IXEND_C/=0 .AND. IYEND_C/=0 ) THEN
+ ! the intersection is non empty
+ NNESTMASK( (IXOR_C-IXOR_F+1):(IXEND_C-IXOR_F+1), (IYOR_C-IYOR_F+1):(IYEND_C-IYOR_F+1), ISON) = 1
+ ENDIF
+! NNESTMASK(NXOR_ALL(JLOOP)+1:NXEND_ALL(JLOOP)-1, &
+! NYOR_ALL(JLOOP)+1:NYEND_ALL(JLOOP)-1, ISON) = 1
+! =======
+! NNESTMASK(NXOR_ALL(JLOOP)+JPHEXT:NXEND_ALL(JLOOP)-JPHEXT, &
+! NYOR_ALL(JLOOP)+JPHEXT:NYEND_ALL(JLOOP)-JPHEXT, ISON) = 1
+! >>>>>>> 1.2.4.2.18.2.2.1
END DO
!
IF (ANY (SUM(NNESTMASK(:,:,:),DIM=3)>1) ) THEN
diff --git a/src/MNH/fill_sonfieldn.f90 b/src/MNH/fill_sonfieldn.f90
index 4e6f7c01e014d9f90e6042ec3cb04a81075bcec8..aba16ef34b1c084b113f76d8ba9bd7335f0c97e8 100644
--- a/src/MNH/fill_sonfieldn.f90
+++ b/src/MNH/fill_sonfieldn.f90
@@ -66,9 +66,17 @@ END MODULE MODI_FILL_SONFIELD_n
USE MODD_GRID_n
USE MODD_NESTING
USE MODD_PARAMETERS
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
!
USE MODE_MODELN_HANDLER
!
+!USE MODE_TOOLS_ll, ONLY : GET_OR_ll
+!USE MODE_LS_ll
+!USE MODD_LSFIELD_n, ONLY : SET_LSFIELD_1WAY_ll
+USE MODE_ll
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -88,20 +96,59 @@ INTEGER :: JI2INF, JI2SUP ! limits of a grid mesh of domain of KDAD model
INTEGER :: JJ2INF,JJ2SUP ! relatively to son domain
INTEGER :: IMI ! current model index
INTEGER :: JLAYER ! loop counter
+INTEGER :: IINFO_ll
+INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+INTEGER :: IXOR, IYOR ! origin of local subdomain
+INTEGER :: IXOR_C, IYOR_C, IXEND_C, IYEND_C ! origin and end of local physical son subdomain in father grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_C
+INTEGER :: IDIMX_C, IDIMY_C ! size of extended local son subdomain in father grid obtained with GET_CHILD_DIM_ll
!-------------------------------------------------------------------------------
!
!* 1. initializations
! ---------------
!
IMI = GET_CURRENT_MODEL_INDEX()
+CALL GET_OR_ll( YSPLITTING, IXOR, IYOR )
CALL GOTO_MODEL(KMI)
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+!
+IF (KLSON/=1) THEN
+ ! get sizes of global son domain in father grid
+ IXSIZE = NXEND_ALL(KMI) - NXOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
+ IYSIZE = NYEND_ALL(KMI) - NYOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
+ ! get splitting of current model KMI in father grid
+ ALLOCATE(TZSPLITTING(NPROC))
+ CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING )
+! IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT - IXOR + 1
+! IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT - IXOR + 1
+! IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT - IYOR + 1
+! IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT - IYOR + 1
+ IIB1 = JPHEXT + 1
+ IIE1 = TZSPLITTING(IP)%NXEND - TZSPLITTING(IP)%NXOR + JPHEXT + 1
+ IJB1 = JPHEXT + 1
+ IJE1 = TZSPLITTING(IP)%NYEND - TZSPLITTING(IP)%NYOR + JPHEXT + 1
+! IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT
+! IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT
+! IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT
+! IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT
+ENDIF
!
!* correct only if JPHEXT = 1
!
-IIB1 = NXOR_ALL (KMI)+JPHEXT
-IIE1 = NXEND_ALL(KMI)-JPHEXT
-IJB1 = NYOR_ALL (KMI)+JPHEXT
-IJE1 = NYEND_ALL(KMI)-JPHEXT
+!JUAN A REVOIR TODO_JPHEXT !!!
+! <<<<<<< fill_sonfieldn.f90
+!IIB1 = NXOR_ALL (KMI)+1
+!IIE1 = NXEND_ALL(KMI)-1
+!IJB1 = NYOR_ALL (KMI)+1
+!IJE1 = NYEND_ALL(KMI)-1
+! =======
+!IIB1 = NXOR_ALL (KMI)+JPHEXT
+!IIE1 = NXEND_ALL(KMI)-JPHEXT
+!IJB1 = NYOR_ALL (KMI)+JPHEXT
+!IJE1 = NYEND_ALL(KMI)-JPHEXT
+! >>>>>>> 1.2.4.1.18.2.2.1
!
DO JLAYER=1,SIZE(PNESTFIELD,4)
PNESTFIELD(:,:,KLSON,JLAYER) = XUNDEF
@@ -119,7 +166,8 @@ IF (KLSON==1) THEN
CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
PNESTFIELD(:,:,KLSON,1) = XZSMT(:,:)
CASE DEFAULT
- GOTO 9999 ! end of subroutine
+ CALL GOTO_MODEL(IMI)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
END SELECT
!
!-------------------------------------------------------------------------------
@@ -128,6 +176,16 @@ ELSE
!* 3. case KLSON>1 : one son
! ----------------------
!
+! ALLOCATE( ZSUM(SIZE(PNESTFIELD,1), SIZE(PNESTFIELD,2)) )
+ ALLOCATE( ZSUM(SIZE(XZS,1), SIZE(XZS,2)) )
+ !
+ CALL GOTO_MODEL( NDAD(KMI) )
+ CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )
+ CALL GET_CHILD_DIM_ll(KMI, IDIMX_C, IDIMY_C, IINFO_ll)
+ CALL GOTO_MODEL( KMI )
+ CALL GO_TOMODEL_ll( KMI, IINFO_ll )
+ ALLOCATE( ZSUM_C(IDIMX_C, IDIMY_C) )
+ !
DO JI1 = IIB1,IIE1
DO JJ1 = IJB1,IJE1
JI2INF= (JI1-IIB1) *NDXRATIO_ALL(KMI)+1+JPHEXT
@@ -137,22 +195,48 @@ ELSE
SELECT CASE(YFIELD)
CASE ('ZS ')
- PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
- / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! ZSUM(JI1,JJ1) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! ZSUM(JI2INF:JI2SUP,JJ2INF:JJ2SUP) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+ ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+ / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
- PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
- / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! ZSUM(JI1,JJ1) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! ZSUM(JI2INF,JJ2INF) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+ ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+ / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+! PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
CASE DEFAULT
- GOTO 9999 ! end of subroutine
+ CALL GOTO_MODEL(IMI)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ RETURN
END SELECT
END DO
END DO
+ !switch to father model to set the LSFIELD and do the communications with LS_FEEDBACK_ll
+! CALL GOTO_MODEL( NDAD(KMI) )
+! CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )
+! CALL SET_LSFIELD_1WAY_ll(PNESTFIELD(:,:,KLSON,1), ZSUM, KMI)
+CALL GET_FEEDBACK_COORD_ll(IXOR_C,IYOR_C,IXEND_C,IYEND_C,IINFO_ll) ! physical domain's origin and end
+ CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(IXOR_C:IXEND_C,IYOR_C:IYEND_C,KLSON,1), ZSUM_C)
+! CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(:,:,KLSON,1), ZSUM)
+! CALL GOTO_MODEL( KMI )
+! CALL GO_TOMODEL_ll( KMI, IINFO_ll )
+ CALL LS_FEEDBACK_ll(IINFO_ll)
+ CALL UNSET_LSFIELD_1WAY_ll()
!
!-------------------------------------------------------------------------------
END IF
!
-9999 CALL GOTO_MODEL(IMI)
+CALL GOTO_MODEL(IMI)
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
!-------------------------------------------------------------------------------
!
END SUBROUTINE FILL_SONFIELD_n
diff --git a/src/MNH/fill_zsmtn.f90 b/src/MNH/fill_zsmtn.f90
index 3f196383588ea8d75c0a47c5721fed2405ebd81c..fadde4e1bdb783d2ac07ec383c5e255d5a27c908 100644
--- a/src/MNH/fill_zsmtn.f90
+++ b/src/MNH/fill_zsmtn.f90
@@ -74,6 +74,10 @@ USE MODI_INI_BIKHARDT_n
USE MODI_SPAWN_ZS
USE MODE_MODELN_HANDLER
!
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -89,14 +93,37 @@ INTEGER :: IMI ! current model index (DAD index)
! Dummy pointers needed to correct an ifort Bug
CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
REAL, DIMENSION(:,:), POINTER :: DPTR_XZSMT
+INTEGER :: IINFO_ll
+INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+INTEGER :: IXOR,IXEND,IYOR,IYEND ! limits of extended domain of KSON model in its father's grid
+INTEGER :: IDIMX, IDIMY ! dimensions of extended son subdomain in father's grid + one point in each direction
!
!* 1. initializations
! ---------------
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(KSON)
-!
-CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),2)
+CALL GO_TOMODEL_ll(KSON, IINFO_ll)
+!
+! get sizes of global son domain in father grid
+IXSIZE = NXEND_ALL(KSON) - NXOR_ALL (KSON) + 1 - 2*JPHEXT
+IYSIZE = NYEND_ALL(KSON) - NYOR_ALL (KSON) + 1 - 2*JPHEXT
+! get splitting of current model KMI in father grid
+ALLOCATE(TZSPLITTING(NPROC))
+CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING )
+! get coords of extended domain of KSON in its father's grid
+IXOR = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXOR -1 - JPHEXT
+IXEND = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXEND -1 + JPHEXT
+IYOR = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYOR -1 - JPHEXT
+IYEND = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYEND -1 + JPHEXT
+!
+!IDIMX = IXEND - IXOR - 1
+!IDIMY = IYEND - IYOR - 1
+IDIMX = IXEND - IXOR + 1 +2*1 ! + 2*JPHEXT
+IDIMY = IYEND - IYOR + 1 +2*1 ! + 2*JPHEXT
+!
+CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),KSON)
!
!-------------------------------------------------------------------------------
!
@@ -106,11 +133,15 @@ CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),2)
DPTR_CLBCX=>CLBCX
DPTR_CLBCY=>CLBCY
DPTR_XZSMT=>XZSMT
+!CALL SPAWN_ZS(IXOR,IXEND,IYOR,IYEND, &
+! NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),DPTR_CLBCX,DPTR_CLBCY, &
+! CLUOUT,PFIELD,DPTR_XZSMT,HFIELD )
CALL SPAWN_ZS(NXOR_ALL(KSON),NXEND_ALL(KSON),NYOR_ALL(KSON),NYEND_ALL(KSON), &
- NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),DPTR_CLBCX,DPTR_CLBCY, &
+ NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),IDIMX,IDIMY,DPTR_CLBCX,DPTR_CLBCY, &
CLUOUT,PFIELD,DPTR_XZSMT,HFIELD )
!-------------------------------------------------------------------------------
!
CALL GOTO_MODEL(IMI)
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
!
END SUBROUTINE FILL_ZSMT_n
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index 69fe137aac80d8fd3decf0691af0c92a3697a56b..24127f9a2d4e5713dadf2280a481e659ce050d4a 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -12,6 +12,7 @@
!! -------------
!! 06/12 (Tomasini) Grid-nesting of ADVFRC and EDDY_FLUX
!! 07/13 (Bosseur & Filippi) adds Forefire
+!! 2014 (Faivre)
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -46,7 +47,13 @@ USE MODD_PAST_FIELD_n
USE MODD_GET_n
USE MODD_GR_FIELD_n
USE MODD_GRID_n
+!$20140403
+!USE MODD_GRID_CONF_PROJ
+!$
USE MODD_HURR_FIELD_n
+!$20140403 add modd_io_surf_mnh
+USE MODD_IO_SURF_MNH
+!$
USE MODD_LBC_n
USE MODD_LES_n
USE MODD_LSFIELD_n
@@ -123,8 +130,14 @@ CALL FIELD_GOTO_MODEL(KFROM, KTO)
CALL PAST_FIELD_GOTO_MODEL(KFROM, KTO)
CALL GET_GOTO_MODEL(KFROM, KTO)
CALL GR_FIELD_GOTO_MODEL(KFROM, KTO)
+!$20140403 add grid_conf_proj_goto_model
+!CALL GRID_CONF_PROJ_GOTO_MODEL(KFROM,KTO)
+!$
CALL GRID_GOTO_MODEL(KFROM, KTO)
CALL HURR_FIELD_GOTO_MODEL(KFROM, KTO)
+!$20140403 add io_surf_mnh_goto_model!!
+CALL IO_SURF_MNH_GOTO_MODEL(KFROM, KTO)
+!$
CALL LBC_GOTO_MODEL(KFROM, KTO)
CALL LES_GOTO_MODEL(KFROM, KTO)
CALL LSFIELD_GOTO_MODEL(KFROM, KTO)
diff --git a/src/MNH/ice_adjust_bis.f90 b/src/MNH/ice_adjust_bis.f90
index 6944b17e45c4b5dc103e6a1dc132f00517144706..6f8415685505458a5450498cd1b7591d90989c63 100644
--- a/src/MNH/ice_adjust_bis.f90
+++ b/src/MNH/ice_adjust_bis.f90
@@ -56,6 +56,7 @@ END MODULE MODI_ICE_ADJUST_BIS
!! MODIFICATIONS
!! -------------
!! Original 09/2012
+!! M.Moge 08/2015 UPDATE_HALO_ll on PTH, ZRV, ZRC, ZRI
!!
!! --------------------------------------------------------------------------
!
@@ -68,6 +69,8 @@ USE MODI_COMPUTE_FUNCTION_THERMO
USE MODI_TH_R_FROM_THL_RT_3D
USE MODI_THLRT_FROM_THRVRCRI
!
+USE MODE_ll
+!
IMPLICIT NONE
!
!
@@ -86,6 +89,9 @@ REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZFRAC_ICE, ZRSATW, ZRSAT
REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZT, ZEXN, ZLVOCPEXN,ZLSOCPEXN
INTEGER :: IRR
CHARACTER(LEN=1) :: YFRAC_ICE
+!
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
!----------------------------------------------------------------------------
!
!* 1 Initialisation
@@ -123,6 +129,18 @@ CALL TH_R_FROM_THL_RT_3D(YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
ZRSATW(:,:,:), ZRSATI(:,:,:) )
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PTH)
+IF (IRR>=1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRV)
+ENDIF
+IF (IRR>=2) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRC)
+ENDIF
+IF (IRR>=4) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRI)
+ENDIF
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
!
IF (IRR>=1) &
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index fa4cdb14067023ee3dd1edfcc5ce5ea71669675c..e931f1404b078690ab5aca7f34fe969a78675b88 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -406,6 +406,8 @@ USE MODD_ADVFRC_n
USE MODD_RELFRC_n
USE MODD_2D_FRC
!
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -1515,6 +1517,7 @@ END IF
!* 8. INITIALIZE THE PROGNOSTIC FIELDS
! --------------------------------
!
+CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT, &
CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
@@ -1557,9 +1560,11 @@ CALL SET_REF(KMI,HINIFILE,HLUOUT, &
! -----------------------------------
!
IF ((CTURB == 'TKEL').AND.(CCONF=='START')) THEN
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_tke_eps::XUT",PRECISION)
CALL INI_TKE_EPS(CGETTKET,XTHVREF,XZZ, &
XUT,XVT,XTHT, &
XTKET,TZINITHALO3D_ll )
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_tke_eps::XUT",PRECISION)
END IF
!
!
@@ -1617,6 +1622,7 @@ END IF
! ----------------------------------
!
IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_cpl::XUT",PRECISION)
CALL INI_CPL(HLUOUT,NSTOP,XTSTEP,LSTEADYLS,CCONF, &
CGETTKET, &
CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
@@ -1631,6 +1637,7 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XDRYMASSS, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
END IF
!
IF ( KMI > 1) THEN
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index 38743f514bed7f7cc1688bb22b60557e19a905a0..69418af98e8d564ac7714784e0faa5416bf481c5 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -160,6 +160,7 @@ END MODULE MODI_INI_SEG_n
!! 02/2012 add GFOREFIRE (Pialat/Tulet)
!! 05/2014 missing reading of IMASDEV before COUPLING
!! test (Escobar)
+!! 10/02/15 remove ABORT in parallel case for SPAWNING
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -280,18 +281,6 @@ ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL '.OR. CPROGRAM=='SPEC ') THEN
YEXSEG=TRIM(ADJUSTL(CINIFILE_n))//'.des'
CALL FMOPEN_ll(CINIFILE_n,'READ',HLUOUT,0,2,NVERB,ININAR,IRESP)
CALL FMLOOK_ll(YEXSEG,CLUOUT0,ILUSEG,IRESP)
-!
- IF (CPROGRAM=='SPAWN ') THEN
- IF (.NOT.GSMONOPROC) THEN
- WRITE(ILUOUT,FMT=*) 'SPAWNING : THIS PROGRAM HAS TO BE &
- & PERFORMED WITH MONOPROCESSOR MODE'
- WRITE(ILUOUT,FMT=*) '-> JOB ABORTED'
-!callabortstop
- CALL CLOSE_ll(HLUOUT,IOSTAT=IRESP)
- CALL ABORT
- STOP
- ENDIF
- ENDIF
!
!* 1.3bis DIAG program case
!
diff --git a/src/MNH/ini_size_spawn.f90 b/src/MNH/ini_size_spawn.f90
index 0d936849458d94bf0e02189129b32fd181f6734f..78be2fd6464feea52319d3e1a426b2df46960ced 100644
--- a/src/MNH/ini_size_spawn.f90
+++ b/src/MNH/ini_size_spawn.f90
@@ -64,6 +64,9 @@ END MODULE MODI_INI_SIZE_SPAWN
!! -------------
!!
!! Original 13/07/99
+!! M.Faivre 2014
+!! M.Moge 07/2015 bug fix : files opened multiple times
+!! M.Moge 08/2015 bug fix : turning the special case for // case into general case in part 1.4
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -96,7 +99,16 @@ USE MODI_RETRIEVE1_NEST_INFO_n
USE MODI_COMPARE_DAD
USE MODE_MODELN_HANDLER
!
+!$20140602 for NPROC
+!USE MODD_VAR_ll
+USE MODD_IO_ll, ONLY : ISNPROC, ISP
+!20140602 for INI_PARAZ_ll
+USE MODE_SPLITTINGZ_ll
!
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+USE MODD_VAR_ll, ONLY : YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!$
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -124,10 +136,23 @@ INTEGER :: ILENCH, IGRID
CHARACTER (LEN=100):: YCOMMENT
INTEGER :: IMI
!
+!$20140602
+INTEGER :: IIU, IJU
+INTEGER :: IINFO_ll ! return code of // routines
+INTEGER :: NIMAX, NJMAX
+CHARACTER(LEN=28), DIMENSION(JPMODELMAX) :: CPGD ! name of input pgd files
+LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL ! Flag for 1D conf. for each PGD
+LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL ! Flag for 2D conf. for each PGD
+LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
+INTEGER :: IDIMX, IDIMY, IIB, IJB, IIE, IJE
+!$
!-------------------------------------------------------------------------------
REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
+INTEGER :: IIMAX_ll,IJMAX_ll
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
!-------------------------------------------------------------------------------
!
+!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(2)
!
@@ -235,14 +260,68 @@ IF (LEN_TRIM(CDOMAIN)>0) THEN
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
!
- ALLOCATE(XPGDXHAT(DIM_MODEL(1)%NIMAX_ll+2*JPHEXT))
+ !$20140602 INSERT BIG MODIF JUAN May27
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!* 1.4 read grid in file CDOMAIN if available :
+! initialize grid2 dims, xor, xend and ratio so to initialize in INI_CHILD
+! structures TCRRT_COMDATA%T_CHILDREN%T_SPLITB and TCRRT_PROCONF%T_CHILDREN
+!$20140602 add condition on npproc
+ CALL FMOPEN_ll(CDOMAIN,'READ',CLUOUT,0,2,NVERB,ININAR,IRESP)
+ !
+ YDIR='--'
+ CALL FMREAD(CDOMAIN,'DXRATIO',CLUOUT,YDIR,NDXRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CDOMAIN,'DYRATIO',CLUOUT,YDIR,NDYRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CDOMAIN,'XOR',CLUOUT,YDIR,NXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CDOMAIN,'YOR',CLUOUT,YDIR,NYOR,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CDOMAIN,'IMAX',CLUOUT,YDIR,IIMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CDOMAIN,'JMAX',CLUOUT,YDIR,IJMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMCLOS_ll(CDOMAIN,'KEEP',CLUOUT,IRESP)
+ NXEND=NXOR+IIMAX_ll/NDXRATIO+2*JPHEXT-1
+ NYEND=NYOR+IJMAX_ll/NDYRATIO+2*JPHEXT-1
+ !
+ !* 1.5 CALL OF INITIALIZATION PARALLEL ROUTINES
+ !
+ CALL SET_LBX_ll(CLBCX(1), 2)
+ CALL SET_LBY_ll(CLBCY(1), 2)
+ CALL SET_XRATIO_ll(NDXRATIO, 2)
+ CALL SET_YRATIO_ll(NDYRATIO, 2)
+ CALL SET_XOR_ll(NXOR, 2)
+ CALL SET_XEND_ll(NXEND, 2)
+ CALL SET_YOR_ll(NYOR, 2)
+ CALL SET_YEND_ll(NYEND, 2)
+ CALL SET_DAD_ll(1, 2)
+ !
+ CALL INI_PARAZ_ll(IINFO_ll)
+ ! get dimensions of father model
+ CALL GET_DIM_PHYS_ll( YSPLITTING, DIM_MODEL(1)%NIMAX, DIM_MODEL(1)%NJMAX )
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !$
+ ALLOCATE(XPGDXHAT(DIM_MODEL(1)%NIMAX+2*JPHEXT))
+ !ALLOCATE(XPGDXHAT(15+2*JPHEXT))
YRECFM='XHAT'
- YDIR='XX'
+ !$20140505 test '--'
+ !YDIR='XX'
+ !YDIR='--'
+ !$20140520 retour a 'XX'
+ !$then np1 works, but np4 stops here
+ !$20140602 use NPROC
+ IF (ISNPROC.EQ.1) YDIR='XX'
+ IF (ISNPROC.GT.1) YDIR='XX'!'--'
+ !$
CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
!
- ALLOCATE(XPGDYHAT(DIM_MODEL(1)%NJMAX_ll+2*JPHEXT))
+ ALLOCATE(XPGDYHAT(DIM_MODEL(1)%NJMAX+2*JPHEXT))
YRECFM='YHAT'
- YDIR='YY'
+ !$20140506 test '--'
+ !YDIR='YY'
+ !YDIR='--'
+ !$20140520 retour a 'YY'
+ !$20140602 use NPROC
+ IF (ISNPROC.EQ.1) YDIR='YY'
+ IF (ISNPROC.GT.1) YDIR='YY'!'--'
CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
!
YRECFM='MASDEV'
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 22ab0e6300fbabd398c325690fc55828bec8baad..f6f079048dc268e34a1967a1ff48face5e9a37b6 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -188,6 +188,7 @@ END DO
IF (CPROGRAM=='SPAWN ') THEN
DPTR_CLBCX=>CLBCX
DPTR_CLBCY=>CLBCY
+ CALL INI_PARAZ_ll(IINFO_ll)
CALL INI_SIZE_SPAWN(DPTR_CLBCX,DPTR_CLBCY,CPRESOPT,NITR,YINIFILE(1))
END IF
!
diff --git a/src/MNH/mass_leak.f90 b/src/MNH/mass_leak.f90
index c72f3a837e001c8915860e7a78bda30376951cca..c5dc3e31e31f062be44979df10e5bc756e15877f 100644
--- a/src/MNH/mass_leak.f90
+++ b/src/MNH/mass_leak.f90
@@ -217,7 +217,7 @@ IF( HLBCY(1) /= 'CYCL' ) THEN
!
END IF
!
-!CALL REDUCESUM_ll(ZLEAK,IINFO_ll)
+!CALL REDUCESUM_ll(ZLEAK,IINFO_ll) ! we do the reducesum_ll in SUM_DD_R2_ll so we do not do it here
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/metrics.f90 b/src/MNH/metrics.f90
index 3fe2d443466c30b11d1b71811d2157f109e11cc2..6d292f948693ed1cdceb775cefb07e519eefd63a 100644
--- a/src/MNH/metrics.f90
+++ b/src/MNH/metrics.f90
@@ -85,6 +85,8 @@ END MODULE MODI_METRICS
!! 14/02/01 (V. Masson and J. Stein) PDZZ initialized below the surface
!! (influences the 3D turbulence of W) and PDXX,PDYY,PDZZ at the top
!! 19/03/2008 (J.Escobar) remove spread !!!
+!! 2014 (M.Faivre)
+!! 25/02/2015 (M.Moge) minor bug fix with MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -94,6 +96,9 @@ USE MODD_CST
!
USE MODI_SHUMAN
!
+!20131024
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!
@@ -119,6 +124,10 @@ REAL :: ZD1 ! DELTA1 (switch 0/1) for thinshell
! approximation
INTEGER :: JI,JJ,JK
REAL, DIMENSION(SIZE(PDXHAT),SIZE(PDYHAT),SIZE(PZZ,3)) :: ZDZZ
+!20131024
+REAL, DIMENSION(SIZE(PDXHAT),SIZE(PDYHAT)) :: TEMP2D_PDXHAT
+REAL, DIMENSION(SIZE(PDXHAT),SIZE(PDYHAT)) :: TEMP2D_PDYHAT
+!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS :
@@ -131,7 +140,22 @@ IKU = SIZE(PZZ,3)
!
!* 2. COMPUTE PDXX and PDYY :
! --------------------
-!
+!
+!20131024
+CALL MPPDB_CHECK3D(PZZ,"METRICS::PZZ",PRECISION)
+IF (.NOT.LCARTESIAN) THEN
+ CALL MPPDB_CHECK2D(PMAP,"METRICS::PMAP",PRECISION)
+ENDIF
+!20131024
+DO JI=1,IIU
+TEMP2D_PDXHAT(JI,:) = PDXHAT(JI)
+END DO
+DO JJ=1,IJU
+TEMP2D_PDYHAT(:,JJ) = PDYHAT(JJ)
+END DO
+CALL MPPDB_CHECK2D(TEMP2D_PDXHAT,"METRICS::PDXHAT",PRECISION)
+CALL MPPDB_CHECK2D(TEMP2D_PDYHAT,"METRICS::PDYHAT",PRECISION)
+!
IF (LTHINSHELL) THEN
ZD1=0.
ELSE
@@ -143,6 +167,9 @@ IF (.NOT.LCARTESIAN) THEN
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)
ENDDO ; ENDDO ; ENDDO
+ !20140710
+ CALL MPPDB_CHECK3D(PDXX,"METRICSbefMXM::PDXX",PRECISION)
+ CALL MPPDB_CHECK3D(PDYY,"METRICSbefMYM::PDYY",PRECISION)
PDXX(:,:,:)=MXM(PDXX(:,:,:))
PDXX(:,:,IKU)=PDXX(:,:,IKU-1)
PDYY(:,:,:)=MYM(PDYY(:,:,:))
@@ -156,6 +183,10 @@ ELSE
PDYY(:,:,:)=MYM(PDYY(:,:,:))
END IF
!
+!20131024
+CALL MPPDB_CHECK3D(PDXX,"METRICSaftMXM::PDXX",PRECISION)
+CALL MPPDB_CHECK3D(PDYY,"METRICSaftMYM::PDYY",PRECISION)
+!
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE PDZX AND PDZY :
@@ -173,6 +204,8 @@ PDZY(:,:,:) = DYM(PZZ(:,:,:))
PDZZ(:,:,:) = DZM(1,IKU,1,MZF(1,IKU,1,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
+CALL MPPDB_CHECK3D(PDZZ,"METRICS::PDZZ",PRECISION)
!-----------------------------------------------------------------------------
!
END SUBROUTINE METRICS
diff --git a/src/MNH/mnhget_size_fulln.f90 b/src/MNH/mnhget_size_fulln.f90
index 132de546311fe4b4166e86bacfe62944cc96e687..2b09a15740d42f1a3e283be18b46671e72e141e4 100644
--- a/src/MNH/mnhget_size_fulln.f90
+++ b/src/MNH/mnhget_size_fulln.f90
@@ -54,6 +54,7 @@ END MODULE MODI_MNHGET_SIZE_FULL_n
!! MODIFICATIONS
!! -------------
!! Original 09/2003
+!! 02/2015 (M.Moge) case('PGD') to compute KSIZE_FULL
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -93,7 +94,12 @@ SELECT CASE(CPROGRAM)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
END SELECT
!
-KSIZE_FULL = (IIE-IIB+1+2*NHALO)*(IJE-IJB+1+2*NHALO)
+SELECT CASE(CPROGRAM)
+ CASE ('PGD')
+ KSIZE_FULL = (IIE-IIB+1)*(IJE-IJB+1)
+ CASE DEFAULT
+ KSIZE_FULL = (IIE-IIB+1+2*NHALO)*(IJE-IJB+1+2*NHALO)
+END SELECT
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/mnhinit_io_surfn.f90 b/src/MNH/mnhinit_io_surfn.f90
index fa859ac00cc7addcdecc77014b2c052b8e42ca4d..29347f45547f13c3677763760840d74bf7c53617 100644
--- a/src/MNH/mnhinit_io_surfn.f90
+++ b/src/MNH/mnhinit_io_surfn.f90
@@ -139,31 +139,15 @@ END IF
!
!* 3. initialisation of 2D arrays
!
-SELECT CASE(CPROGRAM)
- CASE('NESPGD')
- NIB = 1 + JPHEXT
- NIE = NIMAX + JPHEXT
- NJB = 1 + JPHEXT
- NJE = NJMAX + JPHEXT
- NIU = NIMAX + 2* JPHEXT
- NJU = NJMAX + 2* JPHEXT
- NIB_ALL = NIB
- NJB_ALL = NJB
- NIE_ALL = NIE
- NJE_ALL = NJE
- NIU_ALL = NIU
- NJU_ALL = NJU
- CASE DEFAULT
- CALL GET_DIM_EXT_ll('B',NIU,NJU)
- CALL GET_INDICE_ll (NIB,NJB,NIE,NJE)
- CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
- NIB_ALL = 1 + JPHEXT
- NIE_ALL = NIMAX_ll + JPHEXT
- NJB_ALL = 1 + JPHEXT
- NJE_ALL = NJMAX_ll + JPHEXT
- NIU_ALL = NIMAX_ll + 2* JPHEXT
- NJU_ALL = NJMAX_ll + 2* JPHEXT
-END SELECT
+CALL GET_DIM_EXT_ll('B',NIU,NJU)
+CALL GET_INDICE_ll (NIB,NJB,NIE,NJE)
+CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
+NIB_ALL = 1 + JPHEXT
+NIE_ALL = NIMAX_ll + JPHEXT
+NJB_ALL = 1 + JPHEXT
+NJE_ALL = NJMAX_ll + JPHEXT
+NIU_ALL = NIMAX_ll + 2* JPHEXT
+NJU_ALL = NJMAX_ll + 2* JPHEXT
!
!
!* 4. initialisation 1D physical dimension and mask
diff --git a/src/MNH/mnhopen_aux_io_surf.f90 b/src/MNH/mnhopen_aux_io_surf.f90
index 3743e523f0b33f491826edf470a24a88b252361f..1ecf5dcccce236a4d08eafd1882a2009bf519750 100644
--- a/src/MNH/mnhopen_aux_io_surf.f90
+++ b/src/MNH/mnhopen_aux_io_surf.f90
@@ -47,6 +47,7 @@ END MODULE MODI_MNHOPEN_AUX_IO_SURF
!! MODIFICATIONS
!! -------------
!! Original 09/2003
+!! M.Moge 04/2015 parallelization og PREP_PGD on son model
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -67,6 +68,7 @@ USE MODE_FMREAD
USE MODE_IO_ll
!
USE MODI_GET_1D_MASK
+USE MODI_MNH_SURF_GRID_IO_INIT
!
IMPLICIT NONE
!
@@ -131,6 +133,7 @@ COUTFILE = HFILE
!
CALL FMREAD(HFILE,'IMAX',COUT,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFILE,'JMAX',COUT,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL MNH_SURF_GRID_IO_INIT(IIMAX,IJMAX)
CALL FMREAD(HFILE,'JPHEXT',COUT,'--',IJPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
IF ( IJPHEXT .NE. JPHEXT ) THEN
WRITE(NLUOUT,FMT=*) ' MNHOPEN_AUX_IO : JPHEXT in PRE_PGD1.nam/NAM_CONF_PGD ( or default value )&
@@ -167,19 +170,9 @@ CMASK=HMASK
!
!
!* 5. initialisation of 2D arrays for current processor
-!
-IF (CPROGRAM=='PGD ' .AND. HFILE/=COUTFMFILE) THEN
- ! this is the case when one defines the grid from another MesoNH file.
- NIU = (IIMAX+2*JPHEXT)
- NJU = (IJMAX+2*JPHEXT)
- NIB = 1 + JPHEXT
- NJB = 1 + JPHEXT
- NIE = IIMAX + JPHEXT
- NJE = IJMAX + JPHEXT
-ELSE
+!
CALL GET_DIM_EXT_ll('B',NIU,NJU)
CALL GET_INDICE_ll (NIB,NJB,NIE,NJE)
-END IF
!
!
!* 6. initialisation 1D physical dimension and mask for current processor
diff --git a/src/MNH/mnhput_zsn.f90 b/src/MNH/mnhput_zsn.f90
index 133c69538e7871a8b941cf01acfae2fea086adfb..5abb95ed543031b63f990d7ee1876fa39da7b930 100644
--- a/src/MNH/mnhput_zsn.f90
+++ b/src/MNH/mnhput_zsn.f90
@@ -65,6 +65,10 @@ USE MODD_GRID_n, ONLY : XZS
!
USE MODI_PUT_ZS_N
!
+USE MODI_GET_LUOUT
+!
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -78,8 +82,10 @@ IMPLICIT NONE
INTEGER :: IIB, IIE, IJB, IJE
INTEGER :: IL
REAL, DIMENSION(:), ALLOCATABLE :: ZZS
+INTEGER :: ILUOUT
!-------------------------------------------------------------------------------
!
+CALL GET_LUOUT(CPROGRAM,ILUOUT)
SELECT CASE(CPROGRAM)
CASE ('NESPGD')
IIB = JPHEXT + 1
@@ -96,6 +102,8 @@ ALLOCATE(ZZS(IL))
ZZS(:) = RESHAPE (XZS(IIB:IIE,IJB:IJE), (/ IL /) )
!
CALL PUT_ZS_n('MESONH',IL,ZZS(:))
+CALL MPPDB_CHECK_SURFEX2D(ZZS,"mnhput_zs_n:ZZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK2D(XZS,"mnhput_zs_n:MODD_GRID_n::XZS",PRECISION)
!
DEALLOCATE(ZZS)
!
diff --git a/src/MNH/modd_io_surf_mnh.f90 b/src/MNH/modd_io_surf_mnh.f90
index 2c2263eee68fd5b336d1e0b01a346778bcff7ddc..98f4ac86cf41fb36f019f3912727dab6794120e2 100644
--- a/src/MNH/modd_io_surf_mnh.f90
+++ b/src/MNH/modd_io_surf_mnh.f90
@@ -32,20 +32,36 @@
!! MODIFICATIONS
!! -------------
!!
+!! M.Faivre 2014
!
!* 0. DECLARATIONS
!
+!$20140403
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+
IMPLICIT NONE
-CHARACTER(LEN=28),SAVE :: CFILE ! Name of the input FM-file
-CHARACTER(LEN=28),SAVE :: COUTFILE ! Name of the output FM-file
-CHARACTER(LEN=28),SAVE :: COUT ! Name of output_listing file
-INTEGER :: NLUOUT ! output listing logical unit
-CHARACTER(LEN=6),SAVE :: CMASK
+
+INTEGER :: NHALO = 0
+
+TYPE IO_SURF_MNH_t
+!$20140403 JUAN upgraded this modd to have // and mutlimodels use
+!$20140403 cancel the SAVE in structure def as made in already // modd in MNH
+!$
+!CHARACTER(LEN=28),SAVE :: CFILE ! Name of the input FM-file
+!CHARACTER(LEN=28),SAVE :: COUTFILE ! Name of the output FM-file
+!CHARACTER(LEN=28),SAVE :: COUT ! Name of output_listing file
+!INTEGER :: NLUOUT ! output listing logical unit
+!CHARACTER(LEN=6),SAVE :: CMASK
+CHARACTER(LEN=28) :: CFILE ! Name of the input FM-file
+CHARACTER(LEN=28) :: COUTFILE ! Name of the output FM-file
+CHARACTER(LEN=28) :: COUT ! Name of output_listing file
+INTEGER :: NLUOUT ! output listing logical unit
+CHARACTER(LEN=6) :: CMASK
INTEGER, DIMENSION(:), POINTER :: NMASK=>NULL() ! 1D mask to read only interesting surface
! ! points on current processor
INTEGER, DIMENSION(:), POINTER :: NMASK_ALL=>NULL() ! 1D mask to read all surface points all processors
!
-CHARACTER(LEN=5),SAVE :: CACTION = ' '! action being done ('READ ','WRITE')
+CHARACTER(LEN=5) :: CACTION = ' '! action being done ('READ ','WRITE')
!
! number of points in each direction on current processor
INTEGER :: NIU,NJU
@@ -56,10 +72,73 @@ INTEGER :: NIU_ALL,NJU_ALL
! indices of physical points in each direction on all processors
INTEGER :: NIB_ALL,NJB_ALL,NIE_ALL,NJE_ALL
!
-INTEGER :: NHALO = 0
+!!INTEGER :: NHALO = 0
! number of points added on each side (N,E,S,W) to the fields
! the HALO is added when the field is read (works only for grid coordinates)
! note that at reading, this also modifies the numbers of points (IMAX, JMAX)
! the HALO is removed when the field is written (works for all fields)
!
+END type IO_SURF_MNH_t
+!
+TYPE(IO_SURF_MNH_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: IO_SURF_MNH_MODEL
+!
+!!!!!!!!!!!!!!!!!!!! LOCAL VARIABLE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+CHARACTER(LEN=28) ,POINTER :: CFILE =>NULL() ! Name of the input FM-file
+CHARACTER(LEN=28) ,POINTER :: COUTFILE =>NULL() ! Name of the output FM-file
+CHARACTER(LEN=28) ,POINTER :: COUT =>NULL() ! Name of output_listing file
+INTEGER ,POINTER :: NLUOUT =>NULL() ! output listing logical unit
+CHARACTER(LEN=6) ,POINTER :: CMASK =>NULL()
+INTEGER, DIMENSION(:), POINTER :: NMASK=>NULL() ! 1D mask to read only interesting surface
+! ! points on current processor
+INTEGER, DIMENSION(:), POINTER :: NMASK_ALL=>NULL() ! 1D mask to read all surface points all processors
+!
+CHARACTER(LEN=5) ,POINTER :: CACTION => NULL() ! action being done ('READ ','WRITE')
+!
+! number of points in each direction on current processor
+INTEGER , POINTER :: NIU=>NULL(),NJU=>NULL()
+! indices of physical points in each direction on current processor
+INTEGER , POINTER :: NIB=>NULL(),NJB=>NULL(),NIE=>NULL(),NJE=>NULL()
+! number of points in each direction on all processors
+INTEGER , POINTER :: NIU_ALL=>NULL(),NJU_ALL=>NULL()
+! indices of physical points in each direction on all processors
+INTEGER , POINTER :: NIB_ALL=>NULL(),NJB_ALL=>NULL(),NIE_ALL=>NULL(),NJE_ALL=>NULL()
+!
+!$20140403 you hardly want to set the NHALO inside the structure since it
+!$connects with NAMELIST PGDFILE makign things difficult
+!$NHALO IS =1 whatever the model is !!
+!!INTEGER , POINTER :: NHALO=>NULL()
+
+CONTAINS
+
+SUBROUTINE IO_SURF_MNH_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+! save curretnt state for allocated arrays
+IO_SURF_MNH_MODEL(KFROM)%NMASK=>NMASK
+IO_SURF_MNH_MODEL(KFROM)%NMASK_ALL=>NMASK_ALL
+
+! current model is set for model KTO
+CFILE=>IO_SURF_MNH_MODEL(KTO)%CFILE
+COUTFILE=>IO_SURF_MNH_MODEL(KTO)%COUTFILE
+COUT=>IO_SURF_MNH_MODEL(KTO)%COUT
+NLUOUT=>IO_SURF_MNH_MODEL(KTO)%NLUOUT
+CMASK=>IO_SURF_MNH_MODEL(KTO)%CMASK
+NMASK=>IO_SURF_MNH_MODEL(KTO)%NMASK
+NMASK_ALL=>IO_SURF_MNH_MODEL(KTO)%NMASK_ALL
+CACTION=>IO_SURF_MNH_MODEL(KTO)%CACTION
+NIU=>IO_SURF_MNH_MODEL(KTO)%NIU
+NJU=>IO_SURF_MNH_MODEL(KTO)%NJU
+NIB=>IO_SURF_MNH_MODEL(KTO)%NIB
+NJB=>IO_SURF_MNH_MODEL(KTO)%NJB
+NIE=>IO_SURF_MNH_MODEL(KTO)%NIE
+NJE=>IO_SURF_MNH_MODEL(KTO)%NJE
+NIU_ALL=>IO_SURF_MNH_MODEL(KTO)%NIU_ALL
+NJU_ALL=>IO_SURF_MNH_MODEL(KTO)%NJU_ALL
+NIB_ALL=>IO_SURF_MNH_MODEL(KTO)%NIB_ALL
+NJB_ALL=>IO_SURF_MNH_MODEL(KTO)%NJB_ALL
+NIE_ALL=>IO_SURF_MNH_MODEL(KTO)%NIE_ALL
+NJE_ALL=>IO_SURF_MNH_MODEL(KTO)%NJE_ALL
+!!NHALO=>IO_SURF_MNH_MODEL(KTO)%NHALO
+END SUBROUTINE IO_SURF_MNH_GOTO_MODEL
+
END MODULE MODD_IO_SURF_MNH
diff --git a/src/MNH/modd_nesting.f90 b/src/MNH/modd_nesting.f90
index fad495711ca284dc74d7818444cecfd03c4c3193..edb8b45ed0b4c06eed8c5ce2b4f58bbdaf3ac8ef 100644
--- a/src/MNH/modd_nesting.f90
+++ b/src/MNH/modd_nesting.f90
@@ -77,4 +77,29 @@ CHARACTER(LEN=28),SAVE, DIMENSION(JPMODELMAX) :: CMY_NAME,CDAD_NAME
INTEGER,SAVE, DIMENSION(JPMODELMAX) :: NDT_2_WAY ! number of times the time step
! of model n used for the relaxation time of the 2_WAY grid-nesting
! interaction i.e. Tau = NDT_2_WAY * XTSTEP
+
+
+INTEGER,SAVE, DIMENSION(JPMODELMAX) :: NIMAX_NEST, NJMAX_NEST ! local sizes of model m
+INTEGER,SAVE, DIMENSION(JPMODELMAX) :: NIMAX_NEST_ll, NJMAX_NEST_ll ! globcal sizes of model m
+LOGICAL,SAVE, DIMENSION(JPMODELMAX) :: L1D_NEST ! Logical for 1D model version of model m
+LOGICAL,SAVE, DIMENSION(JPMODELMAX) :: L2D_NEST ! Logical for 2D model version of model m
+LOGICAL,SAVE, DIMENSION(JPMODELMAX) :: LPACK_NEST ! Logical to compress 1D or 2D FM files of model m
+!
+TYPE REAL_FIELD2D_ALL
+ REAL, DIMENSION(:,:), POINTER :: XFIELD2D
+END TYPE REAL_FIELD2D_ALL
+
+TYPE REAL_FIELD1D_ALL
+ REAL, DIMENSION(:), POINTER :: XFIELD1D
+END TYPE REAL_FIELD1D_ALL
+!
+TYPE(REAL_FIELD2D_ALL), DIMENSION(JPMODELMAX), TARGET :: TXZS ! orography of model m
+TYPE(REAL_FIELD2D_ALL), DIMENSION(JPMODELMAX), TARGET :: TXZSMT ! smooth orography for SLEVE coordinate of model m
+TYPE(REAL_FIELD1D_ALL), DIMENSION(JPMODELMAX), TARGET :: TXXHAT ! Position x in the
+ ! conformal or cartesian plane of model m
+TYPE(REAL_FIELD1D_ALL), DIMENSION(JPMODELMAX), TARGET :: TXYHAT ! Position y in the
+ ! conformal or cartesian plane of model m
+
+
+
END MODULE MODD_NESTING
diff --git a/src/MNH/mode_extrapol.f90 b/src/MNH/mode_extrapol.f90
index 2acd7925ee2d18475f0bc08dea1e9110f34855e7..1a474e60a39ef45624173fb020ae08a3577c2116 100644
--- a/src/MNH/mode_extrapol.f90
+++ b/src/MNH/mode_extrapol.f90
@@ -9,6 +9,12 @@ MODULE MODE_EXTRAPOL
MODULE PROCEDURE EXTRAPOL3D,EXTRAPOL3DN,EXTRAPOL2D,EXTRAPOL2DN
END INTERFACE
+
+ INTERFACE EXTRAPOL_ON_PSEUDO_HALO
+
+ MODULE PROCEDURE EXTRAPOL_ON_PSEUDO_HALO3D,EXTRAPOL_ON_PSEUDO_HALO2D
+
+ END INTERFACE
CONTAINS
@@ -128,4 +134,269 @@ CONTAINS
END SUBROUTINE EXTRAPOL2DN
+! #######################################################################
+ SUBROUTINE EXTRAPOL_ON_PSEUDO_HALO3D(PTAB,OCYCLIC_EXTRAPOL)
+! #######################################################################
+!
+!!**** *EXTRAPOL_ON_PSEUDO_HALO3D * - when using LS_FORCING_ll with a
+!! child domain defined on the whole father domain (possibly minus 1 point)
+!! we need to extrapolate the field on the child model before doing the interpolation
+!! from the father grid to the child grid
+!!
+!! AUTHOR
+!! ------
+!!
+!! M.Moge * LA - CNRS *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 18/02/2015
+!-------------------------------------------------------------------------------
+ USE MODD_LBC_n
+ USE MODE_MODELN_HANDLER
+ USE MODE_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+ USE MODE_EXCHANGE_ll, ONLY : UPDATE_HALO_EXTENDED_ll
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTAB
+ LOGICAL, OPTIONAL, INTENT(IN) :: OCYCLIC_EXTRAPOL !if true, we consider the cyclic case if necessary, if false, we do the extrapolation even in the cyclic case
+
+ !
+ !* 0.2 Declarations of local variables
+ !
+ 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 :: IDIMX_C,IDIMY_C ! size of the child domain (in the father grid)
+ INTEGER :: IINFO_ll
+ INTEGER :: II
+ TYPE(LIST_ll), POINTER :: TZZSFIELD_ll ! list of fields to exchange
+ LOGICAL :: GCYCLIC_EXTRAPOL
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 1. EXTRAPOLATE LATERAL BOUNDARY CONDITIONS :
+ ! ---------------------------------------
+ !
+ IF ( PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+ GCYCLIC_EXTRAPOL = OCYCLIC_EXTRAPOL
+ ELSE
+ GCYCLIC_EXTRAPOL = .TRUE.
+ ENDIF
+ !
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ ! if the child domain has the same size as the father domain in X or Y
+ ! AND the boundary conditions are CYCLIC in the corresponding direction
+ ! we perform an UPDATE_HALO_ll instead of an extrapolation
+ IF ( GCYCLIC_EXTRAPOL .AND. ( ((IDIMX_C > IIE - IIB + 1 + 2*JPHEXT) .AND. CLBCX(1)=='CYCL' ) .OR. ((IDIMY_C > IJE - IJB + 1 + 2*JPHEXT) .AND. CLBCY(1)=='CYCL') ) ) THEN
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ DO II=1,SIZE(PTAB,3)
+ NULLIFY(TZZSFIELD_ll)
+ CALL ADD2DFIELD_ll(TZZSFIELD_ll, PTAB(:,:,II))
+ CALL UPDATE_HALO_EXTENDED_ll(TZZSFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZZSFIELD_ll)
+ ENDDO
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ ENDIF
+!
+!we take into account the case of a child domain of the size of the father domain minus 1
+ IF ( IDIMX_C > IIE - IIB + 1 + 2*JPHEXT ) THEN
+ IF ( IDIMX_C == IIE - IIB + 3 + 2*JPHEXT ) THEN !the child domain has the same size as the father domain
+ IF ( LWEST_ll() .AND. (CLBCX(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(1,:,:) = 2. * PTAB(2,:,:) - PTAB(3,:,:)
+ ENDIF
+ IF ( LEAST_ll() .AND. (CLBCX(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(IDIMX_C,:,:) = 2. * PTAB(IDIMX_C-1,:,:) - PTAB(IDIMX_C-2,:,:)
+ ENDIF
+ ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : the child grid has to be one point larger or one point smaller in X dim"
+ CALL ABORT
+! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(1,:,:) = 2. * PTAB(2,:,:) - PTAB(3,:,:)
+! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
+! PTAB(1,:,:) = PTAB(IDIMX_C-1,:,:)
+! ENDIF
+! IF ( IIB==1 .AND. LEAST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(IDIMX_C,:,:) = 2. * PTAB(IDIMX_C-1,:,:) - PTAB(IDIMX_C-2,:,:)
+! ELSEIF ( IIB==1 .AND. LEAST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
+! PTAB(IDIMX_C,:,:) = PTAB(2,:,:)
+! ENDIF
+ ELSE !Error, this should not happen
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMX_C = ", IDIMX_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
+ CALL ABORT
+ ENDIF
+ ENDIF
+ IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
+ IF ( IDIMY_C == IJE - IJB + 3 + 2*JPHEXT ) THEN !the child domain has the same size as the father domain
+ IF ( LNORTH_ll() .AND. (CLBCY(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(:,1,:) = 2. * PTAB(:,2,:) - PTAB(:,3,:)
+ ENDIF
+ IF ( LSOUTH_ll() .AND. (CLBCY(1)/='CYCL' ) .OR. .NOT. GCYCLIC_EXTRAPOL) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(:,IDIMY_C,:) = 2. * PTAB(:,IDIMY_C-1,:) - PTAB(:,IDIMY_C-2,:)
+ ENDIF
+ ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : the child grid has to be one point larger or one point smaller in Y dim"
+ CALL ABORT
+! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(:,1,:) = 2. * PTAB(:,2,:) - PTAB(:,3,:)
+! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,1,:) = PTAB(:,IDIMY_C-1,:)
+! ENDIF
+! IF ( IJB==1 .AND. LSOUTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(:,IDIMY_C,:) = 2. * PTAB(:,IDIMY_C-1,:) - PTAB(:,IDIMY_C-2,:)
+! ELSEIF ( IJB==1 .AND. LSOUTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,IDIMY_C,:) = PTAB(:,2,:)
+! ENDIF
+ ELSE !Error, this should not happen
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMY_C = ", IDIMY_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
+ CALL ABORT
+ ENDIF
+ ENDIF
+!
+ END SUBROUTINE EXTRAPOL_ON_PSEUDO_HALO3D
+
+! #######################################################################
+ SUBROUTINE EXTRAPOL_ON_PSEUDO_HALO2D(PTAB,OCYCLIC_EXTRAPOL)
+! #######################################################################
+!
+!!**** *EXTRAPOL_ON_PSEUDO_HALO2D * - when using LS_FORCING_ll with a
+!! child domain defined on the whole father domain (possibly minus 1 point)
+!! we need to extrapolate the field on the child model before doing the interpolation
+!! from the father grid to the child grid
+!!
+!! AUTHOR
+!! ------
+!!
+!! M.Moge * LA - CNRS *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 18/02/2015
+!-------------------------------------------------------------------------------
+ USE MODD_LBC_n
+ USE MODE_MODELN_HANDLER
+ USE MODE_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+ USE MODE_EXCHANGE_ll, ONLY : UPDATE_HALO_EXTENDED_ll
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PTAB
+ LOGICAL, OPTIONAL, INTENT(IN) :: OCYCLIC_EXTRAPOL !if true, we consider the cyclic case if necessary, if false, we do the extrapolation even in the cyclic case
+
+ !
+ !* 0.2 Declarations of local variables
+ !
+ 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 :: IDIMX_C,IDIMY_C ! size of the child domain (in the father grid)
+ INTEGER :: IINFO_ll
+ TYPE(LIST_ll), POINTER :: TZZSFIELD_ll ! list of fields to exchange
+ LOGICAL :: GCYCLIC_EXTRAPOL
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 1. EXTRAPOLATE LATERAL BOUNDARY CONDITIONS :
+ ! ---------------------------------------
+ !
+ IF ( PRESENT(OCYCLIC_EXTRAPOL) ) THEN
+ GCYCLIC_EXTRAPOL = OCYCLIC_EXTRAPOL
+ ELSE
+ GCYCLIC_EXTRAPOL = .TRUE.
+ ENDIF
+ !
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ ! if the child domain has the same size as the father domain in X or Y
+ ! AND the boundary conditions are CYCLIC in the corresponding direction
+ ! we perform an UPDATE_HALO_ll instead of an extrapolation
+ IF ( GCYCLIC_EXTRAPOL .AND. ( ((IDIMX_C > IIE - IIB + 1 + 2*JPHEXT) .AND. CLBCX(1)=='CYCL' ) .OR. ((IDIMY_C > IJE - IJB + 1 + 2*JPHEXT) .AND. CLBCY(1)=='CYCL') ) ) THEN
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ NULLIFY(TZZSFIELD_ll)
+ CALL ADD2DFIELD_ll(TZZSFIELD_ll, PTAB)
+ CALL UPDATE_HALO_EXTENDED_ll(TZZSFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZZSFIELD_ll)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ ENDIF
+!
+!we take into account the case of a child domain of the size of the father domain minus 1
+ IF ( IDIMX_C > IIE - IIB + 1 + 2*JPHEXT ) THEN
+ IF ( IDIMX_C == IIE - IIB + 3 + 2*JPHEXT ) THEN !the child domain has the same size as the father domain
+ IF ( LWEST_ll() .AND. (CLBCX(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(1,:) = 2. * PTAB(2,:) - PTAB(3,:)
+ ENDIF
+ IF ( LEAST_ll() .AND. (CLBCX(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(IDIMX_C,:) = 2. * PTAB(IDIMX_C-1,:) - PTAB(IDIMX_C-2,:)
+ ENDIF
+ ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : the child grid has to be one point larger or one point smaller in X dim"
+ CALL ABORT
+! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(1,:) = 2. * PTAB(2,:) - PTAB(3,:)
+! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
+! PTAB(1,:) = PTAB(IDIMX_C-1,:)
+! ENDIF
+! IF ( IIB==1 .AND. LEAST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(IDIMX_C,:) = 2. * PTAB(IDIMX_C-1,:) - PTAB(IDIMX_C-2,:)
+! ELSEIF ( IIB==1 .AND. LEAST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
+! PTAB(IDIMX_C,:) = PTAB(2,:)
+! ENDIF
+ ELSE !Error, this should not happen
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMX_C = ", IDIMX_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
+ CALL ABORT
+ ENDIF
+ ENDIF
+ IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
+ IF ( IDIMY_C == IJE - IJB + 3 + 2*JPHEXT ) THEN !the child domain has the same size as the father domain
+ IF ( LNORTH_ll() .AND. (CLBCY(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(:,1) = 2. * PTAB(:,2) - PTAB(:,3)
+! ELSEIF ( LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,1) = PTAB(:,IDIMY_C-1)
+ ENDIF
+ IF ( LSOUTH_ll() .AND. (CLBCY(1)/='CYCL' .OR. .NOT. GCYCLIC_EXTRAPOL) ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+ PTAB(:,IDIMY_C) = 2. * PTAB(:,IDIMY_C-1) - PTAB(:,IDIMY_C-2)
+! ELSEIF ( LSOUTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,IDIMY_C) = PTAB(:,2)
+ ENDIF
+ ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : the child grid has to be one point larger or one point smaller in Y dim"
+ CALL ABORT
+! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(:,1) = 2. * PTAB(:,2) - PTAB(:,3)
+! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,1) = PTAB(:,IDIMY_C-1)
+! ENDIF
+! IF ( IJB==1 .AND. LSOUTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote est, on a un point dans le 'pseudo halo' a extrapoler
+! PTAB(:,IDIMY_C) = 2. * PTAB(:,IDIMY_C-1) - PTAB(:,IDIMY_C-2)
+! ELSEIF ( IJB==1 .AND. LSOUTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
+! PTAB(:,IDIMY_C) = PTAB(:,2)
+! ENDIF
+ ELSE !Error, this should not happen
+ WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMY_C = ", IDIMY_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
+ CALL ABORT
+ ENDIF
+ ENDIF
+!
+ END SUBROUTINE EXTRAPOL_ON_PSEUDO_HALO2D
+
END MODULE MODE_EXTRAPOL
diff --git a/src/MNH/mode_gridproj.f90 b/src/MNH/mode_gridproj.f90
index 3034d43d95ef535a2d1097fec3df4dbd5e829af9..ac5c13f1c53b2e85dbe200699121747a732c1656 100644
--- a/src/MNH/mode_gridproj.f90
+++ b/src/MNH/mode_gridproj.f90
@@ -40,13 +40,16 @@
!! MODIFICATION
!! ------------
!! Original 24/05/94
+!! 05/02/15 M.Moge (LA-CNRS)
!!
!!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
USE MODE_FM
-! ------------
+USE MODE_MPPDB
+USE MODD_CONF
+!------------
!------------------------------------------------------------------------------
!
INTERFACE SM_LATLON
@@ -168,6 +171,7 @@ CONTAINS
!! 14/03/96 (Masson) enforce -180<LONOR<+180
!! 01/11/96 (Mallet) bug for the MAP FACTOR computation
!! Sleve coordinate G. Zangler *LA* nov 2005
+!! MPPDB_CHECK 05/02/15 M.Moge (LA-CNRS)
!!
!-------------------------------------------------------------------------------
!
@@ -281,6 +285,9 @@ IF(NVERB >= 10) THEN !Value control
WRITE(ILUOUT,*) PZZ(1,1,JKLOOP),PZZ(IIU/2,IJU/2,JKLOOP), &
PZZ(IIU,IJU,JKLOOP)
END DO
+ ! cancel MPPDB_CHECK if cprog=='SPAWN '
+ IF(CPROGRAM/='SPAWN ')&
+ CALL MPPDB_CHECK3D(PZZ,"GRIDPROJ:PZZ",PRECISION)
END IF
!
!-------------------------------------------------------------------------------
@@ -325,11 +332,17 @@ ZYHATM(:,:) = 0.
ZXHATM(1:IIU-1,1) = .5*(PXHAT(1:IIU-1)+PXHAT(2:IIU))
ZXHATM(IIU,1) = 2.*PXHAT(IIU)-ZXHATM(IIU-1,1)
ZXHATM(:,2:IJU) = SPREAD(ZXHATM(:,1),2,IJU-1)
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+IF(CPROGRAM/='SPAWN ')&
+CALL MPPDB_CHECK2D(ZXHATM,"GRIDPROJ:ZXHATM",PRECISION)
!
ZYHATM(1,1:IJU-1) = .5*(PYHAT(1:IJU-1)+PYHAT(2:IJU))
ZYHATM(1,IJU) = 2.*PYHAT(IJU)-ZYHATM(1,IJU-1)
ZYHATM(2:IIU,:) = SPREAD(ZYHATM(1,:),1,IIU-1)
-! ZXHATM and ZXHATM have to be updated
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+IF(CPROGRAM/='SPAWN ')&
+CALL MPPDB_CHECK2D(ZYHATM,"GRIDPROJ:ZYHATM",PRECISION)
+! ZXHATM and ZXHATM have to be updated
CALL ADD2DFIELD_ll(TZHALO_ll,ZXHATM)
CALL ADD2DFIELD_ll(TZHALO_ll,ZYHATM)
CALL UPDATE_HALO_ll(TZHALO_ll,IINFO_ll)
@@ -353,6 +366,7 @@ CALL ADD1DFIELD_ll("X",TZHALO1_ll,PDXHAT)
CALL ADD1DFIELD_ll("Y",TZHALO1_ll,PDYHAT)
CALL UPDATE_1DHALO_ll(TZHALO1_ll,IINFO_ll)
DEALLOCATE(TZHALO1_ll)
+CALL MPPDB_CHECK3D(ZDZ,"GRIDPROJ:ZDZ",PRECISION)
!
!-----------------------------------------------------------------------------
!
@@ -399,6 +413,8 @@ ELSE
ENDWHERE
END IF
!
+CALL MPPDB_CHECK2D(PMAP,"GRIDPROJ:PMAP",PRECISION)
+!
IF(NVERB >= 10) THEN !Value control
WRITE(ILUOUT,*) 'Some PMAP values:'
WRITE(ILUOUT,*) PMAP(1,1),PMAP(IIU/2,IJU/2),PMAP(IIU,IJU)
@@ -414,6 +430,9 @@ DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PJ(JI,JJ,JK) = ZAPZOA2(JI,JJ,JK) * (1.0/PMAP(JI,JJ)**2) &
* PDXHAT(JI) * PDYHAT(JJ) * ZDZ(JI,JJ,JK)
ENDDO ; ENDDO ; ENDDO
+!
+ CALL MPPDB_CHECK3D(PJ,"GRIDPROJ:PJ",PRECISION)
+!
RETURN
!-----------------------------------------------------------------------------
END SUBROUTINE SM_GRIDPROJ
@@ -742,6 +761,7 @@ END SUBROUTINE SM_LATLON_S
!! Updated VM 24/10/95 projection from north pole (XRPK<0) and
!! longitudes set between XLON0-180. and XLON0+180.
!! Updated VM 01/04 LONOR,LATOR refer to the x=0,y=0 point
+!! MPPDB_CHECK 05/02/15 M.Moge (LA-CNRS)
!!
!-------------------------------------------------------------------------------
!
@@ -838,11 +858,19 @@ IF(XRPK /= 0.) THEN
ZATA(:,:) = ATAN2(-(ZXP-PXHATM(:,:)),(ZYP-ZYHATM(:,:)))/ZRDSDG
END WHERE
!
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+ IF(CPROGRAM/='SPAWN ')&
+ CALL MPPDB_CHECK2D(ZATA,"GRIDPROJ:ZATA",PRECISION)
+!
PLON(:,:) = (ZBETA+ZATA(:,:))/ZRPK+ZLON0
!
!* 2.3 Latitude
!
ZRO2(:,:) = (PXHATM(:,:)-ZXP)**2+(ZYHATM(:,:)-ZYP)**2
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+ IF(CPROGRAM/='SPAWN ')&
+ CALL MPPDB_CHECK2D(ZRO2,"GRIDPROJ:ZRO2",PRECISION)
+!
ZT1 = (XRADIUS*(ABS(ZCLAT0))**(1.-ZRPK))**(2./ZRPK) &
* (1+ZSLAT0)**2
ZT2(:,:) = (ZRPK**2*ZRO2(:,:))**(1./ZRPK)
@@ -871,7 +899,14 @@ ELSE
!* 3.2 Longitude
!
ZXMI0(:,:) = PXHATM(:,:)-ZXBM0
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+ IF(CPROGRAM/='SPAWN ')&
+ CALL MPPDB_CHECK2D(ZXMI0,"GRIDPROJ:ZXMI0",PRECISION)
+ !
ZYMI0(:,:) = PYHATM(:,:)-ZYBM0
+! cancel MPPDB_CHECK if cprog=='SPAWN '
+ IF(CPROGRAM/='SPAWN ')&
+ CALL MPPDB_CHECK2D(ZYMI0,"GRIDPROJ:ZYMI0",PRECISION)
!
PLON(:,:) = (ZXMI0(:,:)*ZCGAM+ZYMI0(:,:)*ZSGAM) &
/ (ZRACLAT0*ZRDSDG)+PLONOR
diff --git a/src/MNH/nest_zsmtn.f90 b/src/MNH/nest_zsmtn.f90
index 977331f798a004d5c9b3e0b9480dd14f0b90157e..7a25108322acdccb905d0edc5dd2c5246c2d35a3 100644
--- a/src/MNH/nest_zsmtn.f90
+++ b/src/MNH/nest_zsmtn.f90
@@ -60,13 +60,15 @@ END MODULE MODI_NEST_ZSMT_n
!
!* 0. DECLARATIONS
!
-USE MODD_CONF, ONLY: NMODEL
+USE MODD_CONF, ONLY: NMODEL, CPROGRAM
USE MODD_NESTING, ONLY: NDAD
-USE MODD_GRID_n, ONLY: XZSMT
+USE MODD_GRID_n, ONLY: XZSMT, XZS
!
USE MODI_FILL_ZSMTn
USE MODE_MODELN_HANDLER
!
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -91,6 +93,8 @@ DO JMI=1,NMODEL
DPTR_XZSMT=>XZSMT
CALL FILL_ZSMT_n(YFIELD,DPTR_XZSMT,JMI)
END DO
+CALL MPPDB_CHECK2D(XZS,"nest_zsmt_n:XZS",PRECISION)
+CALL MPPDB_CHECK2D(XZSMT,"nest_zsmt_n:XZSMT",PRECISION)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/open_nestpgd_files.f90 b/src/MNH/open_nestpgd_files.f90
index 8feb06558da6c24a13244196827b795ca359fde3..f369febac1216029f5c0eb0e2ec98162eed7f92e 100644
--- a/src/MNH/open_nestpgd_files.f90
+++ b/src/MNH/open_nestpgd_files.f90
@@ -64,6 +64,8 @@ END MODULE MODI_OPEN_NESTPGD_FILES
!! 07/06/2010 (J.escobar from Ivan Ristic) bug PGI
!! 30/12/2012 (S.Bielli) Add NAM_NCOUT for netcdf output
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 11/2015 (M.Moge) disable the creation of files on multiple
+!! Z-levels when using parallel IO for PREP_PGD
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -90,6 +92,8 @@ USE MODN_CONFIO
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
!
+USE MODN_CONFZ
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -122,6 +126,8 @@ LOGICAL :: GADD !
CHARACTER(LEN=21), DIMENSION(JPMODELMAX) :: YSHORTPGD
INTEGER :: NHALO_MNH
!
+INTEGER :: ILUNAM,ILUOUT ! Logical unit number for the EXSPA file
+!
!* 0.3 Declaration of namelists
! ------------------------
!
@@ -163,6 +169,10 @@ CALL OPEN_ll(UNIT=ILUOUT0,FILE=CLUOUT0,IOSTAT=IRESP,FORM='FORMATTED',ACTION='WRI
!
CALL OPEN_ll(UNIT=IPRE_NEST_PGD,FILE=HPRE_NEST_PGD,IOSTAT=IRESP,FORM='FORMATTED',ACTION='READ', &
MODE=GLOBAL)
+!reading of NAM_CONFZ
+CALL FMLOOK_ll(HPRE_NEST_PGD,HPRE_NEST_PGD,ILUOUT,IRESP)
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFZ',GFOUND)
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFZ)
!
!JUAN
CALL POSNAM(IPRE_NEST_PGD,'NAM_CONF_NEST',GFOUND)
@@ -302,8 +312,8 @@ CALL CLOSE_ll(HPRE_NEST_PGD)
! -------------------------------------
!
DO JPGD=1,NMODEL
- CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP)
- CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP)
+ CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
+ CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/pgd_grid_io_init_mnh.f90 b/src/MNH/pgd_grid_io_init_mnh.f90
index 6ddd54aa092674209f2f89cd6d2b98dc78195053..8884f11451298ff55ec9b65a06c5106c795b7c3f 100644
--- a/src/MNH/pgd_grid_io_init_mnh.f90
+++ b/src/MNH/pgd_grid_io_init_mnh.f90
@@ -8,8 +8,98 @@
! $Source$ $Revision$
! masdev4_7 BUG1 2007/06/15 17:47:18
!-----------------------------------------------------------------
+!#######################
+MODULE MODI_PGD_GRID_IO_INIT_MNH
+ !#######################
+ !
+ INTERFACE
+ ! ###############################
+#ifdef MNH_PARALLEL
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+#else
+ SUBROUTINE PGD_GRID_IO_INIT_MNH
+#endif
+ ! ###############################
+ !!
+ !! PURPOSE
+ !! -------
+ !!
+ !! Initializes parallel routines for further I/O
+ !!
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! V. Masson Meteo-France
+ !!
+ !! MODIFICATION
+ !! ------------
+ !!
+ !! Original 01/2004
+ !! 10/10/2011 J.Escobar call INI_PARAZ_ll
+ !! 2014 M.Faivre
+ !! 07/2015 M.Moge when initializing a child model from a father model (with PREP_PGD),
+ !! we need to initialize the parallel data structures using a modified version
+ !! of INI_PARAZ_ll/INI_CHILD : INI_PARAZ_CHILD_ll
+ !! In this case, when entering PGD_GRID_IO_INIT_MNH we have only one model : the father
+ !! When exiting, we have only one model : the child
+ !----------------------------------------------------------------------------
+ !
+ !* 0. DECLARATION
+ ! -----------
+ !
+ USE MODE_ll
+ USE MODE_FM
+ USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
+ USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
+ !
+ !JUANZ
+ USE MODE_SPLITTINGZ_ll
+ !JUANZ
+ !
+ USE MODI_GET_SURF_GRID_DIM_N
+ USE MODI_GET_LUOUT
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declaration of dummy arguments
+ ! ------------------------------
+ !
+#ifdef MNH_PARALLEL
+ INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+ REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+ CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
+ LOGICAL, INTENT(IN), OPTIONAL :: ORECT
+ ! if KIMAX,KJMAX,KDXRATIO,KDYRATIO present, this means we are in PREP_PGD, and we only initialise the child model,
+ ! using a father model read from a file and previously initialized with INI_PARAZ_ll
+ INTEGER, INTENT(IN), OPTIONAL :: KIMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KJMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KDXRATIO ! ratio in X direction
+ INTEGER, INTENT(IN), OPTIONAL :: KDYRATIO ! ratio in Y direction
+#endif
+ END SUBROUTINE PGD_GRID_IO_INIT_MNH
+ !
+ END INTERFACE
+END MODULE MODI_PGD_GRID_IO_INIT_MNH
! ###############################
+#ifdef MNH_PARALLEL
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+#else
SUBROUTINE PGD_GRID_IO_INIT_MNH
+#endif
! ###############################
!!
!! PURPOSE
@@ -41,6 +131,7 @@
!!
!! Original 01/2004
!! 10/10/2011 J.Escobar call INI_PARAZ_ll
+!! 2014 M.Faivre
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -63,6 +154,18 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
+LOGICAL, INTENT(IN), OPTIONAL :: ORECT
+! if KIMAX,KJMAX,KDXRATIO,KDYRATIO present, this means we are in PREP_PGD, and we only initialise the child model,
+! using a father model read from a file and previously initialized with INI_PARAZ_ll
+INTEGER, INTENT(IN), OPTIONAL :: KIMAX
+INTEGER, INTENT(IN), OPTIONAL :: KJMAX
+INTEGER, INTENT(IN), OPTIONAL :: KDXRATIO ! ratio in X direction
+INTEGER, INTENT(IN), OPTIONAL :: KDYRATIO ! ratio in Y direction
+#endif
!
!
!* 0.2 Declaration of local variables
@@ -71,6 +174,8 @@ IMPLICIT NONE
INTEGER :: IINFO_ll ! return code of // routines
INTEGER :: IIMAX ! number of points in X direction
INTEGER :: IJMAX ! number of points in Y direction
+INTEGER :: IDXRATIO ! ratio in X direction
+INTEGER :: IDYRATIO ! ratio in Y direction
INTEGER :: ILUOUT ! output listing logical unit
!
LOGICAL :: GRECT ! true when grid is rectangular
@@ -78,7 +183,28 @@ CHARACTER(LEN=10) :: YGRID ! grid type
!
!------------------------------------------------------------------------------
!
-CALL GET_SURF_GRID_DIM_n(YGRID,GRECT,IIMAX,IJMAX)
+IF (CPROGRAM=='IDEAL ' .OR. CPROGRAM=='SPAWN ') RETURN
+!
+!
+#ifdef MNH_PARALLEL
+IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(ORECT) \
+ .AND. PRESENT(KDXRATIO) .AND. PRESENT(KDYRATIO) ) THEN
+ YGRID = HGRID
+ GRECT = ORECT
+ IIMAX = KIMAX
+ IJMAX = KJMAX
+ IDXRATIO = KDXRATIO
+ IDYRATIO = KDYRATIO
+ELSE
+ CALL GET_SURF_GRID_DIM_n(YGRID,GRECT,IIMAX,IJMAX,KGRID_PAR,PGRID_PAR)
+ IDXRATIO = 1
+ IDYRATIO = 1
+ENDIF
+#else
+ CALL GET_SURF_GRID_DIM_n(YGRID,GRECT,IIMAX,IJMAX)
+ IDXRATIO = 1
+ IDYRATIO = 1
+#endif
!
!
IF (YGRID/='CONF PROJ ' .AND. YGRID/='CARTESIAN') THEN
@@ -88,7 +214,6 @@ IF (YGRID/='CONF PROJ ' .AND. YGRID/='CARTESIAN') THEN
END IF
!------------------------------------------------------------------------------
!
-IF (CPROGRAM=='IDEAL ' .OR. CPROGRAM=='SPAWN ') RETURN
!
L1D=(IIMAX==1).AND.(IJMAX==1)
L2D=(IIMAX/=1).AND.(IJMAX==1)
@@ -99,15 +224,34 @@ CALL SET_DAD0_ll()
CALL SET_DIM_ll(IIMAX, IJMAX, 1)
CALL SET_LBX_ll('OPEN',1)
CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
+CALL SET_XRATIO_ll(IDXRATIO, 1)
+CALL SET_YRATIO_ll(IDYRATIO, 1)
CALL SET_XOR_ll(1, 1)
CALL SET_XEND_ll(IIMAX+2*JPHEXT, 1)
CALL SET_YOR_ll(1, 1)
CALL SET_YEND_ll(IJMAX+2*JPHEXT, 1)
CALL SET_DAD_ll(0, 1)
!JUANZ CALL INI_PARA_ll(IINFO_ll)
+! for PREP_PGD, when constructing a son grid from a father grid,
+! we DON'T want to call INI_PARAZ_ll for the child domain if it has already been called on the father domain :
+! INI_PARAZ_ll would split the global son grid without taking into account the RATIO, so it will SPLIT in the middle
+! of the cells of the father.
+! To avoid this, we call a modified INI_PARAZ_CHILD_ll, that will split the father domain and the use the ratio to
+! get the son splitting.
+
+#ifdef MNH_PARALLEL
+IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(ORECT) \
+ .AND. PRESENT(KDXRATIO) .AND. PRESENT(KDYRATIO) ) THEN
+ CALL INI_PARAZ_CHILD_ll(IINFO_ll)
+ CALL SET_XRATIO_ll(1, 1) ! il faut faire ça dans le cas PREP_PGD sur le modele fils car dans ce cas on ne
+ CALL SET_YRATIO_ll(1, 1) ! voit en fait plus qu'un seul modele, le modele pere n'existe plus vraiment dans la suite
+ ! donc le ratio n'a plus de sens, et doit etre a 1
+ELSE
+ CALL INI_PARAZ_ll(IINFO_ll)
+ENDIF
+#else
CALL INI_PARAZ_ll(IINFO_ll)
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 85877225729cd42c389a7cf2eae84cab7cd823a7..3fa665e73124ded4b748afb3f1eac31c5edbb6d1 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -214,12 +214,13 @@ END MODULE MODI_PHYS_PARAM_n
!! 06/2010 (P.Peyrille) add Call to aerozon.f90 if LAERO_FT=T
!! to update
!! aerosols and ozone climatology at each call to
-!! phys_param otherwise it is constant to monthly average
+!! phys_param otherwise it is constant to monthly average
!! 03/2013 (C.Lac) FIT temporal scheme
!! 01/2014 (C.Lac) correction for the nesting of 2D surface
!! fields if the number of the son model does not
!! follow the number of the dad model
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! 2014 (M.Faivre)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -323,6 +324,9 @@ USE MODD_LATZ_EDFLX
USE MODI_GOTO_SURFEX
USE MODI_SWITCH_SBG_LES_N
!
+!20130918
+USE MODE_MPPDB
+
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -394,7 +398,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC, ZRI, ZWT ! additional dummies
REAL, DIMENSION(:,:), ALLOCATABLE :: ZDXDY ! grid area
! for rc, ri, w required if main variables not allocated
!
-INTEGER :: IIU, IJU, IKU ! dimensional indexes
+INTEGER :: IIU, IJU, IKU, II ! dimensional indexes
!
INTEGER :: JSV ! Loop index for Scalar Variables
INTEGER :: JSWB ! loop on SW spectral bands
@@ -1259,7 +1263,9 @@ IF ( CTURB == 'TKEL' ) THEN
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!!$ END IF
-!
+ !20130918 use MPPDB for simultaneous runs np4 and np1
+ CALL MPPDB_CHECK2D(ZSFU,"phys_param::ZSFU",PRECISION)
+ !
IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
ZSFTH(IIB-1,:)=ZSFTH(IIB,:)
ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
@@ -1364,6 +1370,14 @@ IF (CSCONV == 'EDKF') THEN
ALLOCATE(ZSIGMF (IIU,IJU,IKU))
ZSIGMF(:,:,:)=0.
ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)
+ !$20131113 check3d on ZEXN
+ CALL MPPDB_CHECK3D(ZEXN,"physparan.7::ZEXN",PRECISION)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZEXN)
+ !$20131113 add update_halo_ll
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
+ !
CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
OCLOSE_OUT,LMF_FLX,HFMFILE,CLUOUT,ZTIME_LES_MF, &
XIMPL_MF, XTSTEP, &
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index c1e066e422c1a7eac6e5e005179d804f9b617c37..b104fec432552bd7070ada8e7c954c60089ecf6e 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -897,6 +897,7 @@ CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
CALL SET_YOR_ll(1, 1)
CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
CALL SET_DAD_ll(0, 1)
+! CALL INI_PARA_ll(IINFO_ll)
CALL INI_PARAZ_ll(IINFO_ll)
!
! sizes of arrays of the extended sub-domain
@@ -1001,6 +1002,9 @@ IF ( L1D) THEN ! 1D case
!
ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
!
+ CALL GET_SIZEX_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
NSIZELBY_ll=0
NSIZELBYV_ll=0
NSIZELBYTKE_ll=0
@@ -1015,12 +1019,22 @@ ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
ALLOCATE(XLBYSVM(0,0,0,0))
!
IF ( LHORELAX_UVWTH ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBX_ll=2*NRIMX+2
+ ! NSIZELBXU_ll=2*NRIMX+2
+ ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU))
+ ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU))
+! =======
NSIZELBX_ll=2*NRIMX+2*JPHEXT
NSIZELBXU_ll=2*NRIMX+2*JPHEXT
- ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
ELSE
NSIZELBX_ll= 2*JPHEXT ! 2
NSIZELBXU_ll=2*(JPHEXT+1) ! 4
@@ -1034,8 +1048,14 @@ ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
.OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXR_ll=2* NRIMX+2
+ ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR))
+! =======
NSIZELBXR_ll=2*NRIMX+2*JPHEXT
- ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
+ ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
ELSE
NSIZELBXR_ll=2*JPHEXT ! 2
ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR))
@@ -1047,8 +1067,14 @@ ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
!
IF ( NSV > 0 ) THEN
IF ( ANY( LHORELAX_SV(:)) ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXSV_ll=2* NRIMX+2
+ ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV))
+! =======
NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
- ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
+ ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
ELSE
NSIZELBXSV_ll=2*JPHEXT ! 2
ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV))
@@ -1753,7 +1779,7 @@ IF (CSURF =='EXTE') THEN
IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
CPGDFILE = CINIFILE
CALL PGD_GRID_SURF_ATM('MESONH',CINIFILE,'MESONH',.TRUE.)
- CALL SPLIT_GRID('MESONH')
+! CALL SPLIT_GRID('MESONH')
CALL PGD_SURF_ATM ('MESONH',CINIFILE,'MESONH',.TRUE.)
CPGDFILE = CINIFILEPGD
ELSE
diff --git a/src/MNH/prep_nest_pgd.f90 b/src/MNH/prep_nest_pgd.f90
index 6338c9077af9865f5d4743d51270317d40e7d2f9..a4192527a769849f9cee0f2d9df7e75cc7150748 100644
--- a/src/MNH/prep_nest_pgd.f90
+++ b/src/MNH/prep_nest_pgd.f90
@@ -88,6 +88,8 @@
!! -------------
!! Original 26/09/95
!! 30/07/97 (Masson) split of mode_lfifm_pgd
+!! 2014 (M.Faivre)
+!! 06/2015 (M.Moge) parallelization
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -133,6 +135,8 @@ USE MODE_UTIL
#endif
!
USE MODE_SPLITTINGZ_ll, ONLY : INI_PARAZ_ll
+USE MODD_VAR_ll, ONLY : NPROC, IP, NMNH_COMM_WORLD
+USE MODE_MNH_WORLD, ONLY : INIT_NMNH_COMM_WORLD
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -160,11 +164,18 @@ LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
!
INTEGER :: JTIME,ITIME
+INTEGER :: IIMAX,IJMAX,IKMAX
+INTEGER :: IDXRATIO,IDYRATIO
+INTEGER :: IDAD
+INTEGER :: II
+LOGICAL :: GISINIT
!
!-------------------------------------------------------------------------------
!
CALL MPPDB_INIT()
!
+CALL MPPDB_INIT()
+!
CALL VERSION
CPROGRAM='NESPGD'
!
@@ -196,8 +207,60 @@ CALL READ_ALL_NAMELISTS('MESONH','PRE',.FALSE.)
!* 3. READING OF THE GRIDS
! --------------------
!
+! INITIALIZE MPI :
+IINFO_ll = 0
+CALL MPI_INITIALIZED(GISINIT, IINFO_ll)
+IF (.NOT. GISINIT) THEN
+ CALL INIT_NMNH_COMM_WORLD(IINFO_ll)
+END IF
+CALL MPI_COMM_RANK(NMNH_COMM_WORLD, IP, IINFO_ll)
+IP = IP+1
+CALL MPI_COMM_SIZE(NMNH_COMM_WORLD, NPROC, IINFO_ll)
+!
+CALL SET_DAD0_ll()
+DO JPGD=1,NMODEL
+ ! read and set dimensions and ratios of model JPGD
+ CALL FMREAD(CPGD(JPGD),'IMAX',CLUOUT0,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'JMAX',CLUOUT0,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'DXRATIO',CLUOUT0,'--',NDXRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'DYRATIO',CLUOUT0,'--',NDYRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'XSIZE',CLUOUT0,'--',NXSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'YSIZE',CLUOUT0,'--',NYSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'XOR',CLUOUT0,'--',NXOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(CPGD(JPGD),'YOR',CLUOUT0,'--',NYOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL SET_DIM_ll(IIMAX, IJMAX, 1)
+ ! compute origin and end of local subdomain of model JPGD
+ ! initialize variables from MODD_NESTING, origin and end of global model JPGD in coordinates of its father
+ IF ( NDAD(JPGD) > 0 ) THEN
+ NXEND_ALL(JPGD) = NXOR_ALL(JPGD) + NXSIZE(JPGD) - 1 + 2*JPHEXT
+ NYEND_ALL(JPGD) = NYOR_ALL(JPGD) + NYSIZE(JPGD) - 1 + 2*JPHEXT
+ ELSE ! this is not a son model
+ NXOR_ALL(JPGD) = 1
+ NXEND_ALL(JPGD) = IIMAX+2*JPHEXT
+ NYOR_ALL(JPGD) = 1
+ NYEND_ALL(JPGD) = IJMAX+2*JPHEXT
+ ENDIF
+ ! initialize variables from MODD_DIM_ll, origin and end of global model JPGD in coordinates of its father
+ CALL SET_XOR_ll(NXOR_ALL(JPGD), JPGD)
+ CALL SET_XEND_ll(NXEND_ALL(JPGD), JPGD)
+ CALL SET_YOR_ll(NYOR_ALL(JPGD), JPGD)
+ CALL SET_YEND_ll(NYEND_ALL(JPGD), JPGD)
+ ! set the father model of model JPGD
+! set MODD_NESTING::NDAD using MODD_DIM_ll::NDAD
+! MODD_DIM_ll::NDAD was filled in OPEN_NESTPGD_FILES
+ CALL SET_DAD_ll(NDAD(JPGD), JPGD)
+ ! set the ratio of model JPGD in MODD_DIM_ll
+ CALL SET_XRATIO_ll(NDXRATIO_ALL(JPGD), JPGD)
+ CALL SET_YRATIO_ll(NDYRATIO_ALL(JPGD), JPGD)
+END DO
+!
+! reading of the grids
+!
+ CALL SET_DIM_ll(NXEND_ALL(1)-NXOR_ALL(1)+1-2*JPHEXT, NYEND_ALL(1)-NYOR_ALL(1)+1-2*JPHEXT, 1)
+ CALL INI_PARAZ_ll(IINFO_ll)
DO JPGD=1,NMODEL
CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD,.TRUE.)
CALL FMREAD(CPGD(JPGD),'L1D ',CLUOUT0,'--',L1D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(CPGD(JPGD),'L2D ',CLUOUT0,'--',L2D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
@@ -206,71 +269,18 @@ DO JPGD=1,NMODEL
CALL READ_HGRID(JPGD,CPGD(JPGD),YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
CSTORAGE_TYPE='PG'
END DO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. TESTS ON THE GRIDS
-! ------------------
-!
-NXOR_ALL(:)=0
-NYOR_ALL(:)=0
-NXEND_ALL(:)=0
-NYEND_ALL(:)=0
-NXSIZE(:)=0
-NYSIZE(:)=0
-NDXRATIO_ALL(:)=0
-NDYRATIO_ALL(:)=0
-!
-!MODEL1
- ! read the grid in the PGD file
-CALL FMREAD(CPGD(1),'IMAX',CLUOUT0,'--',NXSIZE(1),IGRID,ILENCH,YCOMMENT,IRESP)
-CALL FMREAD(CPGD(1),'JMAX',CLUOUT0,'--',NYSIZE(1),IGRID,ILENCH,YCOMMENT,IRESP)
-!
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NXSIZE(1),NYSIZE(1),1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NXSIZE(1)+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NYSIZE(1)+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!
-!* loop in this order, to make coherent all the coordinate arrays with model 1
-!
-DO JPGD=2,NMODEL
- CALL RETRIEVE1_NEST_INFO_n(NDAD(JPGD),JPGD, &
- NXOR_ALL(JPGD),NYOR_ALL(JPGD), &
- NXSIZE(JPGD),NYSIZE(JPGD), &
- NDXRATIO_ALL(JPGD),NDYRATIO_ALL(JPGD))
-
- NXEND_ALL(JPGD)=NXOR_ALL(JPGD)+NXSIZE(JPGD)+2*JPHEXT -1
- NYEND_ALL(JPGD)=NYOR_ALL(JPGD)+NYSIZE(JPGD)+2*JPHEXT -1
-
-!!$ CALL SET_LBX_ll(CLBCX(1), JPGD)
-!!$ CALL SET_LBY_ll(CLBCY(1), JPGD)
- CALL SET_XRATIO_ll(NDXRATIO_ALL(JPGD), JPGD)
- CALL SET_YRATIO_ll(NDYRATIO_ALL(JPGD), JPGD)
- CALL SET_XOR_ll(NXOR_ALL(JPGD), JPGD)
- CALL SET_XEND_ll(NXEND_ALL(JPGD), JPGD)
- CALL SET_YOR_ll(NYOR_ALL(JPGD), JPGD)
- CALL SET_YEND_ll(NYEND_ALL(JPGD), JPGD)
- CALL SET_DAD_ll(NDAD(JPGD), JPGD )
-
-!!$CALL SET_DIM_ll(NXSIZE(JPGD),NYSIZE(JPGD),1)
-
-END DO
-CALL INI_PARAZ_ll(IINFO_ll)
+ CALL INI_PARAZ_ll(IINFO_ll)
!
!-------------------------------------------------------------------------------
!
!* 5. MASKS DEFINITIONS
! -----------------
!
+
DO JPGD=1,NMODEL
CALL GOTO_SURFEX(JPGD,.TRUE.)
CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
!!$ CALL INIT_HORGRID_ll_n()
CALL DEFINE_MASK_n()
END DO
@@ -284,7 +294,7 @@ WRITE(ILUOUT0,FMT=*)
WRITE(ILUOUT0,FMT=*) 'field ZS of all models'
DO JPGD=NMODEL,1,-1
CALL GOTO_MODEL(JPGD)
-!!$ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD,.TRUE.)
CALL NEST_FIELD_n('ZS ')
END DO
@@ -295,7 +305,7 @@ WRITE(ILUOUT0,FMT=*)
WRITE(ILUOUT0,FMT=*) 'field ZSMT of all models'
DO JPGD=1,NMODEL
CALL GOTO_MODEL(JPGD)
-!!$ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD,.TRUE.)
CALL NEST_ZSMT_n('ZSMT ')
END DO
@@ -324,8 +334,8 @@ END DO
! -------------------------
!
DO JPGD=1,NMODEL
-!!$ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD,.TRUE.)
CALL MNHPUT_ZS_n
END DO
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index c8f76c7c691cb870a5798b537799021ae62ef2d8..bbd07ad71c54e07584933baafabe3da61278892b 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -60,8 +60,13 @@
!! Modification 30/03/2012 Add NAM_NCOUT for netcdf output (S.Bielli)
!! S.Bielli 23/04/2014 supress writing of LAt and LON in NETCDF case
!! S.Bielli 20/11/2014 add writing of LAt and LON in NETCDF case
+!! M.Moge 01/03/2015 use MPPDB + SPLIT_GRID is now called in PGD_GRID. Here we extend
+!! the new grid on the halo with EXTEND_GRID_ON_HALO (M.Moge)
+!! M.Moge 06/2015 write NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR in .lfi output file
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 05/10/2015 : missing JPHEXT for LAT/LON/ZS/ZSMT writing
+!! M.Moge 11/2015 disable the creation of files on multiple
+!! Z-levels when using parallel IO for PREP_PGD
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -74,10 +79,12 @@ USE MODD_LUNIT, ONLY : CLUOUT0, COUTFMFILE
USE MODD_PARAMETERS, ONLY : XUNDEF
USE MODD_IO_ll, ONLY : GSMONOPROC
USE MODD_IO_SURF_MNH, ONLY : NHALO
+USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
!
USE MODE_POS
USE MODE_FMWRIT
USE MODE_IO_ll
+USE MODE_FM
USE MODE_MODELN_HANDLER
!
USE MODI_ZSMT_PGD
@@ -105,8 +112,9 @@ USE MODN_NCOUT
USE MODE_UTIL
USE MODE_FMREAD
#endif
-
+USE MODD_SURF_ATM_GRID_n, ONLY : NGRID_PAR, XGRID_PAR
USE MODE_MPPDB
+USE MODI_EXTEND_GRID_ON_HALO
!
IMPLICIT NONE
!
@@ -149,6 +157,7 @@ CALL MPPDB_INIT()
CPROGRAM='PGD '
!
!
+CALL MPPDB_INIT()
!* 1. Set default names and parallelized I/O
! --------------------------------------
!
@@ -221,7 +230,7 @@ CALL INI_CST
!
CALL PGD_GRID_SURF_ATM('MESONH',' ',' ',.FALSE.)
!
-CALL SPLIT_GRID('MESONH')
+CALL EXTEND_GRID_ON_HALO('MESONH',NGRID_PAR, XGRID_PAR)
!
!
!* Initializes all physiographic fields
@@ -234,7 +243,7 @@ CALL PGD_SURF_ATM('MESONH',' ',' ',.FALSE.)
! -------------------------------
!
COUTFMFILE = CPGDFILE
-CALL FMOPEN_ll(COUTFMFILE,'WRITE',CLUOUT0,1,1,5,ININAR,IRESP)
+CALL FMOPEN_ll(COUTFMFILE,'WRITE',CLUOUT0,1,1,5,ININAR,IRESP,OPARALLELIO=.FALSE.)
!
CALL FMWRIT(COUTFMFILE,'MASDEV ',CLUOUT0,'--',NMASDEV,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'BUGFIX ',CLUOUT0,'--',NBUGFIX,0,1,' ',IRESP)
@@ -247,6 +256,24 @@ CALL FMWRIT(COUTFMFILE,'SURF ',CLUOUT0,'--','EXTE',0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'L1D ',CLUOUT0,'--',L1D,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'L2D ',CLUOUT0,'--',L2D,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'PACK ',CLUOUT0,'--',LPACK,0,1,' ',IRESP)
+IF ( NDXRATIO <= 0 .AND. NDYRATIO <= 0 ) THEN
+ NDXRATIO = 1
+ NDYRATIO = 1
+ENDIF
+IF ( NXSIZE < 0 .AND. NYSIZE < 0 ) THEN
+ NXSIZE = 0
+ NYSIZE = 0
+ENDIF
+IF ( NXOR <= 0 .AND. NYOR <= 0 ) THEN
+ NXOR = 1
+ NYOR = 1
+ENDIF
+CALL FMWRIT(COUTFMFILE,'DXRATIO ',CLUOUT0,'--',NDXRATIO,0,1,' ',IRESP)
+CALL FMWRIT(COUTFMFILE,'DYRATIO ',CLUOUT0,'--',NDYRATIO,0,1,' ',IRESP)
+CALL FMWRIT(COUTFMFILE,'XSIZE ',CLUOUT0,'--',NXSIZE,0,1,' ',IRESP)
+CALL FMWRIT(COUTFMFILE,'YSIZE ',CLUOUT0,'--',NYSIZE,0,1,' ',IRESP)
+CALL FMWRIT(COUTFMFILE,'XOR ',CLUOUT0,'--',NXOR,0,1,' ',IRESP)
+CALL FMWRIT(COUTFMFILE,'YOR ',CLUOUT0,'--',NYOR,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'JPHEXT ',CLUOUT0,'--',JPHEXT,0,1,' ',IRESP)
!
#ifdef MNH_NCWRIT
@@ -331,8 +358,8 @@ WRITE(ILUOUT0,*) '***************************'
!* 6. Close parallelized I/O
! ----------------------
!
-CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
-CALL FMCLOS_ll(COUTFMFILE,'KEEP',CLUOUT0,IRESP)
+CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP,OPARALLELIO=.FALSE.)
+CALL FMCLOS_ll(COUTFMFILE,'KEEP',CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
!
CALL END_PARA_ll(IINFO_ll)
!
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index f629664e6a49f0ab045e206708acba72fde11f82..8133e5fa73ef925efc446ca5038737a5c07e595c 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -374,6 +374,9 @@
!! July 2013 (Bosseur & Filippi) Adds Forefire
!! Mars 2014 (J.Escobar) Missing 'full' UPDATE_METRICS for arp2lfi // run
!! April 2014 (G.TANGUY) Add LCOUPLING
+!! 2014 (M.Faivre)
+!! Fevr 2015 (M.Moge) Cleaning up
+!! Aug 2015 (M.Moge) removing EXTRAPOL on XDXX and XDYY in part 8
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -400,6 +403,7 @@ USE MODI_READ_ALL_DATA_MESONH_CASE
USE MODI_READ_ALL_DATA_GRIB_CASE
USE MODI_METRICS
USE MODI_UPDATE_METRICS
+USE MODI_SET_REF
USE MODI_VER_PREP_GRIBEX_CASE
USE MODI_VER_PREP_MESONH_CASE
USE MODI_VER_THERMO
@@ -587,19 +591,6 @@ END IF
LCPL_AROME=.FALSE.
LCOUPLING=.FALSE.
!
-! GSMONOPROC set by INITIO_ll
-! NPROC not yet set (done by INI_PARA_ll later)
-IF ( (.NOT.GSMONOPROC) .AND. (YATMFILETYPE=='MESONH') ) THEN
- WRITE(ILUOUT0,FMT=*) 'PREP_REAL_CASE : THIS PROGRAM HAS TO BE &
- & PERFORMED WITH MONOPROCESSOR MODE &
- & FOR MESONH INPUT FILE FOR THE MOMENT '
- WRITE(ILUOUT0,FMT=*) '-> JOB ABORTED'
- !callabortstop
- CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
- CALL ABORT
- STOP
-ENDIF
-!
!-------------------------------------------------------------------------------
!
!* 3. INITIALIZATION OF PHYSICAL CONSTANTS
@@ -640,7 +631,9 @@ NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
!
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, 128)
+!JUAN 4/04/2014 correction for PREP_REAL_CASE on Gribex files
+!CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, 128)
+CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
CALL SET_LBX_ll('OPEN',1)
CALL SET_LBY_ll('OPEN', 1)
CALL SET_XRATIO_ll(1, 1)
@@ -798,49 +791,6 @@ END IF
!
!
CSTORAGE_TYPE='TT'
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. INITIALIZE parallel variables
-! -------------------------------
-!
-!!$NIMAX_ll=NIMAX !! coding for one processor
-!!$NJMAX_ll=NJMAX
-!
-IF (YATMFILETYPE=='MESONH') THEN
-! CALL DEALLOC_PARA_ll
-!
-!JUAN REALZ : TEMPOARRY CODING , ONLY FOR PREP_REAL FATER SPAWNING
-! IN MONO-PROCESSOR
-NIMAX_ll=NIMAX !! coding for one processor
-NJMAX_ll=NJMAX
-!
-END IF
-!
-!JUAN REALZ , already done ?!
- CALL DEALLOC_PARA_ll
-CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL SET_LBX_ll(CLBCX(1), 1)
-CALL SET_LBY_ll(CLBCY(1), 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ
-!CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!JUANZ
-!JUAN REALZ
-!
-!
-CALL SECOND_MNH(ZTIME2)
-
-ZMISC = ZMISC + ZTIME2 - ZTIME1
!-------------------------------------------------------------------------------
!
!* 8. COMPUTATION OF GEOMETRIC VARIABLES
@@ -865,6 +815,12 @@ ELSE
XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ )
END IF
!
+CALL MPPDB_CHECK2D(XZS,"prep_real_case8:XZS",PRECISION)
+CALL MPPDB_CHECK2D(XMAP,"prep_real_case8:XMAP",PRECISION)
+CALL MPPDB_CHECK2D(XLAT,"prep_real_case8:XLAT",PRECISION)
+CALL MPPDB_CHECK2D(XLON,"prep_real_case8:XLON",PRECISION)
+CALL MPPDB_CHECK3D(XZZ,"prep_real_case8:XZZ",PRECISION)
+CALL MPPDB_CHECK3D(ZJ,"prep_real_case8:ZJ",PRECISION)
!
ALLOCATE(XDXX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
ALLOCATE(XDYY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
@@ -872,13 +828,31 @@ ALLOCATE(XDZX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
ALLOCATE(XDZY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
ALLOCATE(XDZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
!
+!20131024 add update halo
+!=> corrects on PDXX calculation in metrics and XDXX !!
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XZZ)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
!
CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
!
+CALL MPPDB_CHECK3D(XDXX,"prc8-beforeupdate_metrics:PDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"prc8-beforeupdate_metrics:PDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"prc8-beforeupdate_metrics:PDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"prc8-beforeupdate_metrics:PDZY",PRECISION)
+!
CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!20131112 add update_halo for XDYY and XDZY!!
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XDXX)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XDZX)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XDYY)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XDZY)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
-!!$CALL EXTRAPOL('W',XDXX,XDZX)
-!!$CALL EXTRAPOL('S',XDYY,XDZY)
+!CALL EXTRAPOL('W',XDXX,XDZX)
+!CALL EXTRAPOL('S',XDYY,XDZY)
CALL SECOND_MNH(ZTIME2)
@@ -1193,9 +1167,6 @@ END IF
CALL CLOSE_ll(CLUOUT0, IOSTAT=IRESP)
CALL FMCLOS_ll(CINIFILE,'KEEP',CLUOUT0,IRESP)
!
- CALL MPPDB_BARRIER()
- CALL MPPDB_BARRIER()
-
!
CALL END_PARA_ll(IINFO_ll)
!-------------------------------------------------------------------------------
diff --git a/src/MNH/pressure_in_prep.f90 b/src/MNH/pressure_in_prep.f90
index 4f5ecf00c124ce485d3fd7c5d5530f2a1bbb55a0..f82bc45c3631bfc218a953b0ff5cd12930152083 100644
--- a/src/MNH/pressure_in_prep.f90
+++ b/src/MNH/pressure_in_prep.f90
@@ -65,6 +65,8 @@ END MODULE MODI_PRESSURE_IN_PREP
!! -------------
!! Original 22/12/98
!! parallelization 18/06/00 (Jabouille)
+!! 2014 M.Faivre
+!! 08/2015 M.Moge removing UPDATE_HALO_ll on XUT, XVT, XRHODJ in part 4
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -91,6 +93,7 @@ USE MODD_DYN_n
USE MODD_REF_n
USE MODD_CST
USE MODE_MPPDB
+USE MODE_EXTRAPOL
!
IMPLICIT NONE
!
@@ -180,6 +183,15 @@ DO
!
!* 4. compute the residual divergence
! -------------------------------
+!20140225 forgot this update_halo
+!20131112 check 1st XUT
+CALL MPPDB_CHECK3D(XUT,"PressInP4-beforeupdhalo::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"PressInP4-beforeupdhalo::XVT",PRECISION)
+!CALL ADD3DFIELD_ll(TZFIELDS_ll, XUT)
+!CALL ADD3DFIELD_ll(TZFIELDS_ll, XVT)
+!CALL ADD3DFIELD_ll(TZFIELDS_ll, XRHODJ)
+! CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+! CALL CLEANLIST_ll(TZFIELDS_ll)
!
ZRU(:,:,:) = XUT(:,:,:) * MXM(XRHODJ)
ZRV(:,:,:) = XVT(:,:,:) * MYM(XRHODJ)
@@ -191,6 +203,15 @@ DO
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
CALL GDIV(CLBCX,CLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZRU,ZRV,ZRW,ZDIV)
+CALL MPPDB_CHECK3D(XUT,"PressInP4-afterupdhalo::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"PressInP4-afterupdhalo::XVT",PRECISION)
+!
+!20131125 add extrapol on ZRU
+CALL EXTRAPOL('W',ZRU)
+CALL MPPDB_CHECK3D(ZRU,"PressInP4-afterextrapol W::ZRU",PRECISION)
+!
+!20131126 add extrapol on ZRV
+CALL EXTRAPOL('S',ZRV)
!
IF ( CEQNSYS=='DUR' ) THEN
IF ( SIZE(XRVREF,1) == 0 ) THEN
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 03e2935dcebc3fb2b1342c16dd6c765be9309f41..bc0de8e2c423bc2d10ccca68155272c08b99103e 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -424,12 +424,18 @@ END IF
! --------------------------------------------------
!
!
+CALL MPPDB_CHECK3D(PRUS,"pressurez 4-before update_halo_ll::PRUS",PRECISION)
+CALL MPPDB_CHECK3D(PRVS,"pressurez 4-before update_halo_ll::PRVS",PRECISION)
+CALL MPPDB_CHECK3D(PRWS,"pressurez 4-before update_halo_ll::PRWS",PRECISION)
NULLIFY(TZFIELDS_ll)
CALL ADD3DFIELD_ll(TZFIELDS_ll, PRUS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, PRVS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, PRWS)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK3D(PRUS,"pressurez 4-after update_halo_ll::PRUS",PRECISION)
+CALL MPPDB_CHECK3D(PRVS,"pressurez 4-after update_halo_ll::PRVS",PRECISION)
+CALL MPPDB_CHECK3D(PRWS,"pressurez 4-after update_halo_ll::PRWS",PRECISION)
!
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
diff --git a/src/MNH/read_all_data_mesonh_case.f90 b/src/MNH/read_all_data_mesonh_case.f90
index fbb2feb75116697165bded5b8269c7e0c6989db7..d0bbed68fff173d677b115739150a4ab0450d7a6 100644
--- a/src/MNH/read_all_data_mesonh_case.f90
+++ b/src/MNH/read_all_data_mesonh_case.f90
@@ -109,6 +109,7 @@ END MODULE MODI_READ_ALL_DATA_MESONH_CASE
!! 01/06/02 (O.Nuissier) bogussing of tropical cyclone
!! Aou 09, 2005 (D.Barbary) call to compare_dad
!! 19/03/2008 (J.Escobar) rename INIT to INIT_MNH --> grib problem
+!! 2014 (M.Faivre)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -149,6 +150,11 @@ USE MODD_PREP_REAL
!
USE MODI_INIT_MNH
!
+!20131113 add modules for update_halo and check
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -193,7 +199,12 @@ CHARACTER(LEN=5) :: YPRESOPT ! PRESsure OPTion
LOGICAL :: GRES
REAL :: ZRES
INTEGER :: IPRE_REAL1
-!-------------------------------------------------------------------------------
+!
+!20131113 add vars related to ADD3DFIELD and UPDATE_HALO
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
+!------------------------------------------------------------------------------
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
!
@@ -336,12 +347,20 @@ XPS_LS(:,:) = XP00* ( &
) &
)**(XCPD/XRD)
!
+!20131113 add update_halo
+CALL ADD2DFIELD_ll(TZFIELDS_ll,XPS_LS )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK2D(XPS_LS,"PGDFILTER9:XPS_LS",PRECISION)
+!
!
!* 10. Check coherence between the 2 orographies
! -----------------------------------------
!
-IF (LEN_TRIM(HDAD_NAME)>0) CALL CHECK_ZS(HFMFILE,HDAD_NAME,IIINF_LS,IJINF_LS)
-IF (LEN_TRIM(HDAD_NAME)>0) CALL CHECK_ZHAT(HFMFILE,HDAD_NAME)
+!20131023 mise en commentaire du check_zs et zhat
+!
+!IF (LEN_TRIM(HDAD_NAME)>0) CALL CHECK_ZS(HFMFILE,HDAD_NAME,IIINF_LS,IJINF_LS)
+!IF (LEN_TRIM(HDAD_NAME)>0) CALL CHECK_ZHAT(HFMFILE,HDAD_NAME)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/read_hgrid.f90 b/src/MNH/read_hgrid.f90
index c9aeca7e067d92cd8ca40ea5d6641b758314866d..aff3b67d5b0573701cb641a6084654c157a40c39 100644
--- a/src/MNH/read_hgrid.f90
+++ b/src/MNH/read_hgrid.f90
@@ -78,6 +78,7 @@ END MODULE MODI_READ_HGRID
!! MODIFICATIONS
!! -------------
!! Original 26/09/96
+!! M.Faivre 2014
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -94,6 +95,7 @@ USE MODD_LUNIT
USE MODE_FMREAD
USE MODE_GRIDPROJ
USE MODE_IO_ll
+USE MODD_CONF, ONLY : CPROGRAM
!
IMPLICIT NONE
!
@@ -114,6 +116,7 @@ CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IMASDEV
INTEGER :: IMI
LOGICAL :: G1D,G2D,GPACK
+INTEGER :: IINFO_ll
!-------------------------------------------------------------------------------
REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
!-------------------------------------------------------------------------------
@@ -131,7 +134,9 @@ ENDIF
IF (KMI/=0) THEN
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(KMI)
+ CALL GO_TOMODEL_ll(KMI, IINFO_ll)
CALL READ_HGRID_n(HFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
CALL GOTO_MODEL(IMI)
RETURN
END IF
@@ -167,6 +172,10 @@ CALL FMREAD(HFMFILE,YRECFM,CLUOUT0,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
!* 2.2 Grid information :
! ----------------
!
+!20131010 recompute properly NPGDIMAX NPGDJMAX
+!GET_DIM_PHYS_ll impact => 1st one no visible impact
+CALL GET_DIM_PHYS_ll ( 'B',NPGDIMAX,NPGDJMAX)
+!
CALL FMREAD(HFMFILE,'LAT0',CLUOUT0,'--',XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'LON0',CLUOUT0,'--',XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'RPK',CLUOUT0,'--',XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -176,10 +185,15 @@ CALL FMREAD(HFMFILE,'LONORI',CLUOUT0,'--',XPGDLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'IMAX',CLUOUT0,'--',NPGDIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'JMAX',CLUOUT0,'--',NPGDJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
!
+!20131010 recompute properly NPGDIMAX NPGDJMAX
+!GET_DIM_PHYS_ll impact 2nd one => prevent run failures
+CALL GET_DIM_PHYS_ll ( 'B',NPGDIMAX,NPGDJMAX)
+!
IF (.NOT.(ALLOCATED(XPGDXHAT))) ALLOCATE(XPGDXHAT(NPGDIMAX+2*JPHEXT))
IF (.NOT.(ALLOCATED(XPGDYHAT))) ALLOCATE(XPGDYHAT(NPGDJMAX+2*JPHEXT))
-CALL FMREAD(HFMFILE,'XHAT',CLUOUT0,'--',XPGDXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
-CALL FMREAD(HFMFILE,'YHAT',CLUOUT0,'--',XPGDYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!20131023 change FMREAD option '--' -> 'XX' ou 'YY' for // reading
+CALL FMREAD(HFMFILE,'XHAT',CLUOUT0,'XX',XPGDXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HFMFILE,'YHAT',CLUOUT0,'YY',XPGDYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
!
!* 3. Read the configuration (MODD_CONF)
!
diff --git a/src/MNH/read_hgridn.f90 b/src/MNH/read_hgridn.f90
index 0473264cfe3d3ce2eb69e994a880546f61b62a21..592ea7bc4bdcfa47ecaf4bbf4eaf3cf234a374ed 100644
--- a/src/MNH/read_hgridn.f90
+++ b/src/MNH/read_hgridn.f90
@@ -72,6 +72,8 @@ END MODULE MODI_READ_HGRID_n
!! MODIFICATIONS
!! -------------
!! Original 26/09/96
+!! M.Faivre 2014
+!! M.Moge 06/2015 case ( CPROGRAM .EQ. "NESPGD" .OR. CPROGRAM .EQ. "SPAWN ")
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -110,6 +112,9 @@ REAL :: ZLAT0,ZLON0,ZRPK,ZBETA
REAL :: ZEPS = 1.E-10
INTEGER :: IMASDEV
INTEGER :: IMI
+!$20140506 add YDIR for FMREAD
+CHARACTER(LEN=2) :: YDIR
+
!
!-------------------------------------------------------------------------------
REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
@@ -118,6 +123,7 @@ REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
INTEGER :: IIU,IJU
INTEGER :: NIMAX2,NJMAX2
!JUAN REALZ
+INTEGER :: IXOR, IYOR, IXEND, IYEND
INTEGER :: IJPHEXT
!
CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
@@ -203,6 +209,7 @@ IF (CPROGRAM/='IDEAL ') THEN
! correctly initialized in later routines (e.g. spawn_model2.f90)
! b) and arrays XXHAT, XYHAT, XZS, XZSMT are deallocated after this
! routine (as in ini_size_spawn.f90)
+ !$20140506 try 'XX','YY' it is FMREADN0_LL scalar reading so leave '--'
CALL FMREAD(HFMFILE,'IMAX',CLUOUT,'--',NIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'JMAX',CLUOUT,'--',NJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HFMFILE,'JPHEXT',CLUOUT,'--',IJPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -247,18 +254,32 @@ END IF
! ----------------
!JUAN REALZ
IF ( CPROGRAM .EQ. "REAL " ) THEN
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(IIU))
-IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(IJU))
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
+ IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(IIU))
+ IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(IJU))
+ELSE IF ( CPROGRAM .EQ. "NESPGD" .OR. CPROGRAM .EQ. "SPAWN ") THEN
+ NIMAX_ll = NIMAX
+ NJMAX_ll = NJMAX
+ CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
+ NIMAX = IXEND - IXOR + 1
+ NJMAX = IYEND - IYOR + 1
+ IIU = NIMAX+2*JPHEXT
+ IJU = NJMAX+2*JPHEXT
+ IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(IIU))
+ IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(IJU))
ELSE
-IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(NIMAX+2*JPHEXT))
-IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(NJMAX+2*JPHEXT))
+ IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(NIMAX+2*JPHEXT))
+ IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(NJMAX+2*JPHEXT))
ENDIF
!JUAN REALZ
-CALL FMREAD(HFMFILE,'XHAT',CLUOUT,'XX',XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
-CALL FMREAD(HFMFILE,'YHAT',CLUOUT,'YY',XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+YDIR='XX'
+CALL FMREAD(HFMFILE,'XHAT',CLUOUT,YDIR,XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YDIR='YY'
+CALL FMREAD(HFMFILE,'YHAT',CLUOUT,YDIR,XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
!JUAN REALZ
IF ( CPROGRAM .EQ. "REAL " ) THEN
IF (.NOT. (ASSOCIATED(XZS))) ALLOCATE(XZS(IIU,IJU))
@@ -267,8 +288,10 @@ IF (.NOT. (ASSOCIATED(XZS))) ALLOCATE(XZS(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
ENDIF
!JUAN REALZ
-CALL FMREAD(HFMFILE,'ZS',CLUOUT,'XY',XZS,IGRID,ILENCH,YCOMMENT,IRESP)
-
+!$20140506 replace 'XY' by YDIR !!
+YDIR='XY'
+CALL FMREAD(HFMFILE,'ZS',CLUOUT,YDIR,XZS,IGRID,ILENCH,YCOMMENT,IRESP)
+!
!JUAN REALZ
IF ( CPROGRAM .EQ. "REAL " ) THEN
IF (.NOT. (ASSOCIATED(XZSMT))) ALLOCATE(XZSMT(IIU,IJU))
@@ -280,7 +303,10 @@ ENDIF
IF (IMASDEV<=46) THEN
XZSMT = XZS
ELSE
- CALL FMREAD(HFMFILE,'ZSMT',CLUOUT,'XY',XZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
+!$20140506 replace 'XY' by YDIR !!
+YDIR='XY'
+ CALL FMREAD(HFMFILE,'ZSMT',CLUOUT,YDIR,XZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/read_prc_fmfile.f90 b/src/MNH/read_prc_fmfile.f90
index 47c4a4e7f07727cf254dfd20d1bcb1e45bb1c1ee..0248ac6471d39d9b0c90c445c83a36ce36f7861a 100644
--- a/src/MNH/read_prc_fmfile.f90
+++ b/src/MNH/read_prc_fmfile.f90
@@ -95,6 +95,7 @@ END MODULE MODI_READ_PRC_FMFILE
!! 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4
!! 01/2004 (V. Masson) removes surface (externalization)
!! 05/2006 Remove EPS
+!! 2014 (M.Faivre)
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -127,6 +128,15 @@ USE MODI_DEALLOCATE_MODEL1
USE MODE_THERMO
USE MODE_MODELN_HANDLER
!
+!20131105 use of ADD3DFIELD& UPDATE_HALO
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+!20131105 add MODE_ll
+USE MODE_ll
+!
+!20131104 add MPPDB
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -161,6 +171,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT
REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT
REAL, DIMENSION(:), ALLOCATABLE :: ZZHAT
INTEGER :: IMI
+!
+!20131105 add vars related to ADD3DFIELD and UPDATE_HALO
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
INTEGER :: IIB, IIE, IJB, IJE
!-------------------------------------------------------------------------------
!
@@ -178,6 +193,9 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
!
+!20131105 nullify tzfield
+NULLIFY(TZFIELDS_ll)
+!
!-------------------------------------------------------------------------------
!
!* 2. WATER VAPOR MUST EXIST IN PREP_REAL_CASE
@@ -331,6 +349,11 @@ IF (ALLOCATED(ZINPRR_LS)) THEN
DEALLOCATE(ZINPRR3D_LS)
DEALLOCATE(ZEVAP3D_LS)
DEALLOCATE(ZACPRR_LS)
+ !
+ !20131112 check 3D vars
+ CALL MPPDB_CHECK3D(XINPRR3D,"read_prc_fmfile6::XINPRR3D",PRECISION)
+ CALL MPPDB_CHECK3D(XEVAP3D,"read_prc_fmfile6::XEVAP3D",PRECISION)
+ !
END IF
!
IF (ALLOCATED(ZINPRS_LS)) THEN
@@ -375,42 +398,93 @@ END IF
!* 7.1 left boundary I=1+JPHEXT for U
! ------------------------------
!
-IF (IIU>3) XU_LS(IIB ,:,:)=2.*XU_LS( IIB+1 ,:,:)-XU_LS( IIB+2 ,:,:)
+!20131104
+CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile7.1::XU_LS",PRECISION) !ok calculated in 3. using trunc_field
+!
+!20131105 use ADD3DFIELD and UPDATE_HALO
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XU_LS)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!20131112 add cleanlist
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!20131105 use LWEST_ll() as in pressurez or phys_paramn
+IF (IIU>3 .AND. LWEST_ll()) XU_LS(IIB ,:,:)=2.*XU_LS( IIB+1 ,:,:)-XU_LS( IIB+2 ,:,:)
+!then XU_LS is
+!correct all along with update_halo_ll
+!20131105 use UPDATE_HALO
+!20131112 disable update_halo here
+!CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!
+!20131104
+CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile7.1::XU_LS",PRECISION)
+!
!
!* 7.2 bottom boundary J=1+JPHEXT for V
! --------------------------------
!
-IF (IJU>3) XV_LS(:, IJB,:)=2.*XV_LS(:, IJB+1 ,:)-XV_LS(:, IJB+2 ,:)
+!20131112 update_halo_ll for XV_LS
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XV_LS)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!20131112 add cleanlist
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!20131105 use LSOUTH_ll() as in pressurez or phys_paramn
+!IF (IJU>3) XV_LS(:, 2,:)=2.*XV_LS(:, 3 ,:)-XV_LS(:, 4 ,:)
+IF (IJU>3 .AND. LSOUTH_ll()) XV_LS(:, IJB,:)=2.*XV_LS(:, IJB+1 ,:)-XV_LS(:, IJB+2 ,:)
+!20131105
+CALL MPPDB_CHECK3D(XV_LS,"read_prc_fmfile7.2::XV_LS",PRECISION)
!
!* 7.3 all boundaries for all fields except vapor
! ------------------------------------------
!
-XU_LS(IIB-1 ,:,:)=2.*XU_LS( IIB ,:,:)-XU_LS( IIB+1 ,:,:)
-XU_LS(IIE+1,:,:)=2.*XU_LS(IIE,:,:)-XU_LS(IIE-1,:,:)
-XV_LS(IIB-1 ,:,:)=2.*XV_LS( IIB ,:,:)-XV_LS( IIB+1 ,:,:)
-XV_LS(IIE+1,:,:)=2.*XV_LS(IIE,:,:)-XV_LS(IIE-1,:,:)
-XW_LS(IIB-1 ,:,:)=2.*XW_LS( IIB ,:,:)-XW_LS( IIB+1 ,:,:)
-XW_LS(IIE+1,:,:)=2.*XW_LS(IIE,:,:)-XW_LS(IIE-1,:,:)
-XTH_LS(IIB-1 ,:,:)=2.*XTH_LS( IIB ,:,:)-XTH_LS( IIB+1 ,:,:)
-XTH_LS(IIE+1,:,:)=2.*XTH_LS(IIE,:,:)-XTH_LS(IIE-1,:,:)
-XR_LS(IIB-1 ,:,:,:)=MAX(2.*XR_LS( IIB ,:,:,:)-XR_LS( IIB+1 ,:,:,:),0.)
-XR_LS(IIE+1,:,:,:)=MAX(2.*XR_LS(IIE,:,:,:)-XR_LS(IIE-1,:,:,:),0.)
-!
-XU_LS(:, IJB-1,:)=2.*XU_LS(:, IJB ,:)-XU_LS(:, IJB+1 ,:)
-XU_LS(:,IJE+1,:)=2.*XU_LS(:,IJE,:)-XU_LS(:,IJE-1,:)
-XV_LS(:, IJB-1,:)=2.*XV_LS(:, IJB ,:)-XV_LS(:, IJB+1 ,:)
-XV_LS(:,IJE+1,:)=2.*XV_LS(:,IJE,:)-XV_LS(:,IJE-1,:)
-XW_LS(:, IJB-1,:)=2.*XW_LS(:, IJB ,:)-XW_LS(:, IJB+1 ,:)
-XW_LS(:,IJE+1,:)=2.*XW_LS(:,IJE,:)-XW_LS(:,IJE-1,:)
-XTH_LS(:, IJB-1,:)=2.*XTH_LS(:, IJB ,:)-XTH_LS(:, IJB+1 ,:)
-XTH_LS(:,IJE+1,:)=2.*XTH_LS(:,IJE,:)-XTH_LS(:,IJE-1,:)
-XR_LS(:, IJB-1,:,:)=MAX(2.*XR_LS(:, IJB ,:,:)-XR_LS(:, IJB+1 ,:,:),0.)
-XR_LS(:,IJE+1,:,:)=MAX(2.*XR_LS(:,IJE,:,:)-XR_LS(:,IJE-1,:,:),0.)
+!20131106 : also here
+IF (LWEST_ll()) XU_LS(IIB-1 ,:,:)=2.*XU_LS( IIB ,:,:)-XU_LS( IIB+1 ,:,:)
+!20131105 use UPDATE_HALO
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XU_LS)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!20131105 use LEAST_ll() as in pressurez or phys_paramn
+IF (LEAST_ll()) XU_LS(IIE+1,:,:)=2.*XU_LS(IIE,:,:)-XU_LS(IIE-1,:,:)
+!20131105 use UPDATE_HALO
+!20131112 disable update_halo
+!CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!20131104 add check on xu_ls
+CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile7.3::XU_LS",PRECISION)
+
+!20131105 add condition on WEST,EAST
+!20131128 correct condition on XTH_LS(IIU,:,:) use LEAST_ll not LWEST_ll
+IF (LWEST_ll()) XV_LS(IIB-1 ,:,:)=2.*XV_LS( IIB ,:,:)-XV_LS( IIB+1 ,:,:)
+IF (LEAST_ll()) XV_LS(IIE+1,:,:)=2.*XV_LS(IIE,:,:)-XV_LS(IIE-1,:,:)
+IF (LWEST_ll()) XW_LS(IIB-1 ,:,:)=2.*XW_LS( IIB ,:,:)-XW_LS( IIB+1 ,:,:)
+IF (LEAST_ll()) XW_LS(IIE+1,:,:)=2.*XW_LS(IIE,:,:)-XW_LS(IIE-1,:,:)
+IF (LWEST_ll()) XTH_LS(IIB-1 ,:,:)=2.*XTH_LS( IIB ,:,:)-XTH_LS( IIB+1 ,:,:)
+IF (LEAST_ll()) XTH_LS(IIE+1,:,:)=2.*XTH_LS(IIE,:,:)-XTH_LS(IIE-1,:,:)
+IF (LWEST_ll()) XR_LS(IIB-1 ,:,:,:)=MAX(2.*XR_LS( IIB ,:,:,:)-XR_LS( IIB+1 ,:,:,:),0.)
+IF (LEAST_ll()) XR_LS(IIE+1,:,:,:)=MAX(2.*XR_LS(IIE,:,:,:)-XR_LS(IIE-1,:,:,:),0.)
+!
+!20131105 add condition on SOUTH,NORTH
+IF (LSOUTH_ll()) XU_LS(:, IJB-1,:)=2.*XU_LS(:, IJB ,:)-XU_LS(:, IJB+1 ,:)
+IF (LNORTH_ll()) XU_LS(:,IJE+1,:)=2.*XU_LS(:,IJE,:)-XU_LS(:,IJE-1,:)
+!
+!20131105 use UPDATE_HALO
+!20131112 disable update_halo here
+!CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+!CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131104
+CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile7.3::XU_LS",PRECISION)
+!
+!20131105 add condition on NORTH,SOUTH
+IF (LSOUTH_ll()) XV_LS(:, IJB-1,:)=2.*XV_LS(:, IJB ,:)-XV_LS(:, IJB+1 ,:)
+IF (LNORTH_ll()) XV_LS(:,IJE+1,:)=2.*XV_LS(:,IJE,:)-XV_LS(:,IJE-1,:)
+IF (LSOUTH_ll()) XW_LS(:, IJB-1,:)=2.*XW_LS(:, IJB ,:)-XW_LS(:, IJB+1 ,:)
+IF (LNORTH_ll()) XW_LS(:,IJE+1,:)=2.*XW_LS(:,IJE,:)-XW_LS(:,IJE-1,:)
+IF (LSOUTH_ll()) XTH_LS(:, IJB-1,:)=2.*XTH_LS(:, IJB ,:)-XTH_LS(:, IJB+1 ,:)
+IF (LNORTH_ll()) XTH_LS(:,IJE+1,:)=2.*XTH_LS(:,IJE,:)-XTH_LS(:,IJE-1,:)
+IF (LSOUTH_ll()) XR_LS(:, IJB-1,:,:)=MAX(2.*XR_LS(:, IJB ,:,:)-XR_LS(:, IJB+1 ,:,:),0.)
+IF (LNORTH_ll()) XR_LS(:,IJE+1,:,:)=MAX(2.*XR_LS(:,IJE,:,:)-XR_LS(:,IJE-1,:,:),0.)
!
!* 7.4 all boundaries for vapor (using relative humidity)
! ------------------------
!
-!
ALLOCATE(ZHU_LS(IIU,IJU,ILU))
WHERE (XR_LS(:,:,:,1)>0.)
ZHU_LS(:,:,:)=100.*XPMASS_LS(:,:,:)/(XRD/XRV/XR_LS(:,:,:,1)+1.) &
@@ -419,10 +493,10 @@ ELSEWHERE
ZHU_LS(:,:,:)=0.
END WHERE
!
-ZHU_LS(IIB-1 ,:,:)=ZHU_LS( IIB ,:,:)
-ZHU_LS(IIE+1,:,:)=ZHU_LS(IIE,:,:)
-ZHU_LS(:, IJB-1,:)=ZHU_LS(:, IJB ,:)
-ZHU_LS(:,IJE+1,:)=ZHU_LS(:,IJE,:)
+IF (LWEST_ll()) ZHU_LS(IIB-1 ,:,:)=ZHU_LS( IIB ,:,:)
+IF (LEAST_ll()) ZHU_LS(IIE+1,:,:)=ZHU_LS(IIE,:,:)
+IF (LSOUTH_ll()) ZHU_LS(:, IJB-1,:)=ZHU_LS(:, IJB ,:)
+IF (LNORTH_ll()) ZHU_LS(:,IJE+1,:)=ZHU_LS(:,IJE,:)
!
IF (NRR>1) THEN
WHERE (XR_LS(IIB-1 ,:,:,2)>0.)
@@ -454,11 +528,28 @@ DEALLOCATE(ZHU_LS)
! --------------------------
!
XU_LS(:,:,1:JPVEXT)=-SPREAD(XU_LS(:,:,JPVEXT+1),3,JPVEXT)
+!20131104
+!CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile8::XU_LS",PRECISION) !
XV_LS(:,:,1:JPVEXT)=-SPREAD(XV_LS(:,:,JPVEXT+1),3,JPVEXT)
!
XU_LS(:,:,ILU-JPVEXT+1:ILU)=SPREAD(XU_LS(:,:,ILU-JPVEXT),3,JPVEXT)
+!20131104
+!CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile8::XU_LS",PRECISION)
XV_LS(:,:,ILU-JPVEXT+1:ILU)=SPREAD(XV_LS(:,:,ILU-JPVEXT),3,JPVEXT)
!
+!20131112 final checking on _LS vars still allocated
+CALL MPPDB_CHECK3D(XU_LS,"read_prc_fmfile8::XU_LS",PRECISION)
+CALL MPPDB_CHECK3D(XV_LS,"read_prc_fmfile8::XV_LS",PRECISION)
+CALL MPPDB_CHECK3D(XW_LS,"read_prc_fmfile8::XW_LS",PRECISION)
+CALL MPPDB_CHECK3D(XR_LS(:,:,:,1),"read_prc_fmfile8::XR_LS(:,:,:,1)",PRECISION)
+CALL MPPDB_CHECK3D(XTH_LS,"read_prc_fmfile8::XTH_LS",PRECISION)
+!
+!XU_LS(:,:,1:JPVEXT)=-SPREAD(XU_LS(:,:,JPVEXT+1),3,JPVEXT)
+!XV_LS(:,:,1:JPVEXT)=-SPREAD(XV_LS(:,:,JPVEXT+1),3,JPVEXT)
+!!
+!XU_LS(:,:,ILU-JPVEXT+1:ILU)=SPREAD(XU_LS(:,:,ILU-JPVEXT),3,JPVEXT)
+!XV_LS(:,:,ILU-JPVEXT+1:ILU)=SPREAD(XV_LS(:,:,ILU-JPVEXT),3,JPVEXT)
+!
!-------------------------------------------------------------------------------
!
WRITE (ILUOUT0,*) 'Routine READ_PRC_FMFILE completed'
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index 2b575787a8ef8bc237b88b53cccada77796362f9..f69ab13843e664bf6d5e2e4aeac570ff7bc7044c 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -697,6 +697,172 @@ DEALLOCATE(IMASK)
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFX2COV_MNH
!
+! #############################################################
+ SUBROUTINE READ_SURFX2COV_1COV_MNH(HREC,KL1,KCOVER,PFIELD,KRESP,HCOMMENT,HDIR)
+! #############################################################
+!
+!!**** *READX1* - routine to fill a real 2D array for the externalised surface
+!! with Logical mask on one specified vertical level
+!!
+!! PURPOSE
+!! -------
+!
+! The purpose of READ_SURFX1 is
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Malardel *METEO-FRANCE*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! original 01/08/03
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_FM
+USE MODE_FMREAD
+USE MODE_ll
+USE MODE_IO_ll
+!
+USE MODD_CST, ONLY : XPI
+!
+USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE , NLUOUT, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE, &
+ NIU_ALL, NJU_ALL, NIB_ALL, &
+ NJB_ALL, NIE_ALL, NJE_ALL, &
+ NMASK_ALL
+!
+USE MODI_PACK_2D_1D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=16), INTENT(IN) :: HREC ! name of the article to be read
+INTEGER, INTENT(IN) :: KL1 ! number of points
+INTEGER, INTENT(IN) :: KCOVER ! index of the vertical level, it should be a index such that LCOVER(KCOVER)=.TRUE.
+REAL, DIMENSION(KL1), INTENT(OUT):: PFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
+CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment
+CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+! ! 'H' for HOR : with hor. dim.; and distributed.
+! ! 'A' for ALL : with hor. dim.; and not distributed.
+! ! '-' : no horizontal dim.
+
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: IGRID ! IGRID : grid indicator
+INTEGER :: ILENCH ! ILENCH : length of comment string
+
+INTEGER :: IMASDEV
+CHARACTER(LEN=20) :: YREC
+CHARACTER(LEN=2) :: YDIR
+CHARACTER(LEN=2) :: YSTORAGE_TYPE
+!
+INTEGER :: IIU, IJU, IIB, IJB, IIE, IJE ! dimensions of horizontal fields
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK ! mask for packing
+!JUANZ
+INTEGER :: NCOVER,ICOVER,JL2
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
+!JUANZ
+INTEGER :: IVERSION, IBUGFIX
+LOGICAL :: GCOVER_PACKED ! .T. if COVER are all packed into one field
+ CHARACTER(LEN=1) :: YDIR1
+!-------------------------------------------------------------------------------
+!
+KRESP = 0
+!YDIR1 = 'H'
+!IF (PRESENT(HDIR)) YDIR1 = HDIR
+YDIR1 = HDIR
+!
+IF (YDIR1=='A') THEN
+ YDIR="--"
+ IIU = NIU_ALL
+ IJU = NJU_ALL
+ IIB = NIB_ALL
+ IJB = NJB_ALL
+ IIE = NIE_ALL
+ IJE = NJE_ALL
+ ALLOCATE(IMASK(SIZE(NMASK_ALL)))
+ IMASK = NMASK_ALL
+ELSE
+ YDIR="XY"
+ IIU = NIU
+ IJU = NJU
+ IIB = NIB
+ IJB = NJB
+ IIE = NIE
+ IJE = NJE
+ ALLOCATE(IMASK(SIZE(NMASK)))
+ IMASK = NMASK
+END IF
+!
+!! Reading of a 2D fields, masked and packed into 1D vector
+!
+!
+ALLOCATE (ZWORK2D(IIU,IJU))
+ZWORK2D(:,:) = 0.0
+!
+
+CALL FMREAD(CFILE,'VERSION',COUT,'--',IVERSION,IGRID,ILENCH,HCOMMENT,KRESP)
+!GAELLE CALL FMREAD(CFILE,'BUGFIX',COUT,'--',IBUGFIX,IGRID,ILENCH,HCOMMENT,KRESP)
+CALL FMREAD(CFILE,'BUG ',COUT,'--',IBUGFIX,IGRID,ILENCH,HCOMMENT,KRESP)
+
+IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) THEN
+ GCOVER_PACKED = .FALSE.
+ELSE
+ CALL FMREAD(CFILE,'COVER_PACKED',COUT,'--',GCOVER_PACKED,IGRID,ILENCH,HCOMMENT,KRESP)
+END IF
+!
+IF (.NOT. GCOVER_PACKED) THEN
+ WRITE(YREC,'(A5,I3.3)') 'COVER',KCOVER
+ CALL FMREAD(CFILE,YREC,COUT,YDIR1,ZWORK2D(:,:),IGRID,ILENCH,HCOMMENT,KRESP)
+ELSE
+ WRITE(NLUOUT,*) 'WARNING'
+ WRITE(NLUOUT,*) '-------'
+ WRITE(NLUOUT,*) 'error : GCOVER_PACKED = ', GCOVER_PACKED, ' and we try to read the covers one by one '
+ WRITE(NLUOUT,*) ' '
+ CALL ABORT
+! CALL FMREAD(CFILE,HREC,COUT,YDIR,ZWORK2D(:,:,:),IGRID,ILENCH,HCOMMENT,KRESP)
+END IF
+!
+IF (KRESP /=0) THEN
+ WRITE(NLUOUT,*) 'WARNING'
+ WRITE(NLUOUT,*) '-------'
+ WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
+ WRITE(NLUOUT,*) ' '
+ELSE IF (YDIR1=='H' .OR. YDIR1=='A') THEN
+ CALL PACK_2D_1D(IMASK,ZWORK2D(IIB:IIE,IJB:IJE),PFIELD(:))
+END IF
+!
+DEALLOCATE(ZWORK2D)
+
+
+DEALLOCATE(IMASK)
+!-------------------------------------------------------------------------------
+END SUBROUTINE READ_SURFX2COV_1COV_MNH
+!
! #############################################################
SUBROUTINE READ_SURFN0_MNH(HREC,KFIELD,KRESP,HCOMMENT)
! #############################################################
diff --git a/src/MNH/retrieve1_nest_infon.f90 b/src/MNH/retrieve1_nest_infon.f90
index 17f647d0b60a24c06ce4945b30022b7004e934a4..03b49bc76a3ef17ad6dadd7e242c54bd0fee213e 100644
--- a/src/MNH/retrieve1_nest_infon.f90
+++ b/src/MNH/retrieve1_nest_infon.f90
@@ -147,8 +147,8 @@ IF ( CPROGRAM /= 'SPAWN ' ) THEN
XPGDXHAT(:)=XXHAT(:)
XPGDYHAT(:)=XYHAT(:)
ELSE
- NPGDIMAX =NIMAX_ll
- NPGDJMAX =NJMAX_ll
+ NPGDIMAX =NIMAX
+ NPGDJMAX =NJMAX
ENDIF
!
CALL RETRIEVE2_NEST_INFO_n(KMI,KDAD,KXOR,KYOR,KXSIZE,KYSIZE,KDXRATIO,KDYRATIO)
diff --git a/src/MNH/retrieve2_nest_infon.f90 b/src/MNH/retrieve2_nest_infon.f90
index 0f2da4ed0c82d62e9aa205fc81d99462d6c245dc..f9c929597acaf656ac631c823fc3a705f6780dba 100644
--- a/src/MNH/retrieve2_nest_infon.f90
+++ b/src/MNH/retrieve2_nest_infon.f90
@@ -13,12 +13,12 @@
!
INTERFACE
!
- SUBROUTINE RETRIEVE2_NEST_INFO_n(KMI,KDAD,KXOR,KYOR,KXSIZE,KYSIZE,KDXRATIO,KDYRATIO)
+ SUBROUTINE RETRIEVE2_NEST_INFO_n(KMI,KDAD,KXOR_C_ll,KYOR_C_ll,KXSIZE,KYSIZE,KDXRATIO,KDYRATIO)
!
INTEGER,INTENT(IN) :: KMI ! son model index
INTEGER,INTENT(IN) :: KDAD ! dad model index
-INTEGER,INTENT(OUT) :: KXOR ! position of pgd model origine points
-INTEGER,INTENT(OUT) :: KYOR ! according to father domain
+INTEGER,INTENT(OUT) :: KXOR_C_ll ! position of pgd model origine points
+INTEGER,INTENT(OUT) :: KYOR_C_ll ! according to father domain
INTEGER,INTENT(OUT) :: KXSIZE ! number of grid meshes in father grid to be
INTEGER,INTENT(OUT) :: KYSIZE ! covered by the pgd domain
INTEGER,INTENT(OUT) :: KDXRATIO ! resolution ratio between father grid
@@ -33,7 +33,7 @@ END MODULE MODI_RETRIEVE2_NEST_INFO_n
!
!
! ###############################################################
- SUBROUTINE RETRIEVE2_NEST_INFO_n(KMI,KDAD,KXOR,KYOR,KXSIZE,KYSIZE, &
+ SUBROUTINE RETRIEVE2_NEST_INFO_n(KMI,KDAD,KXOR_C_ll,KYOR_C_ll,KXSIZE,KYSIZE, &
KDXRATIO,KDYRATIO)
! ###############################################################
!
@@ -91,6 +91,7 @@ END MODULE MODI_RETRIEVE2_NEST_INFO_n
!! Original 25/09/96
!! 22/09/99 PGD modules for dad, and _n module for son
!! J Stein 04/07/01 add cartesian case
+!! M.Faivre 2014
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -100,7 +101,7 @@ USE MODD_CONF
USE MODD_PARAMETERS
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_DIM_n
+USE MODD_DIM_n, ONLY : NIMAX, NJMAX
USE MODD_PGDGRID
USE MODD_PGDDIM
USE MODD_LUNIT
@@ -109,6 +110,19 @@ USE MODE_FM
USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
!
+!20131024
+USE MODE_MPPDB
+USE MODE_TOOLS_ll, ONLY : LEAST_ll, LWEST_ll, LNORTH_ll, LSOUTH_ll
+USE MODD_MPIF
+USE MODD_DIM_ll, ONLY : NXOR_ALL, NXEND_ALL, NYOR_ALL, NYEND_ALL, NIMAX_ll, NJMAX_ll
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+!USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_VAR_ll, ONLY : YSPLITTING, NMNH_COMM_WORLD, MPI_PRECISION
+USE MODD_IO_ll, ONLY : ISNPROC, ISP
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODE_NEST_ll, ONLY : GO_TOMODEL_ll
+!USE MODE_EXCHANGE_ll
+!USE MODD_ARGSLIST_ll, ONLY : LIST1D_ll
!
IMPLICIT NONE
!
@@ -116,8 +130,8 @@ IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KMI ! son model index
INTEGER,INTENT(IN) :: KDAD ! dad model index
-INTEGER,INTENT(OUT) :: KXOR ! position of pgd model origine points
-INTEGER,INTENT(OUT) :: KYOR ! according to father (next refered as 1) domain
+INTEGER,INTENT(OUT) :: KXOR_C_ll ! position of pgd model origine points
+INTEGER,INTENT(OUT) :: KYOR_C_ll ! according to father (next refered as 1) domain
INTEGER,INTENT(OUT) :: KXSIZE ! number of grid meshes in model 1 to be
INTEGER,INTENT(OUT) :: KYSIZE ! covered by the pgd domain
INTEGER,INTENT(OUT) :: KDXRATIO ! resolution ratio between grid 1
@@ -129,53 +143,128 @@ INTEGER,INTENT(OUT) :: KDYRATIO ! and its son (next refered as 2) grid
INTEGER :: ILUOUT, IRESP
INTEGER :: IIU ! relatively to model 1
INTEGER :: IJU ! relatively to model 1
+INTEGER :: IIUGLB ! relatively to model 1
+INTEGER :: IJUGLB ! relatively to model 1
INTEGER :: IPGDIU ! relatively to model 2
INTEGER :: IPGDJU ! relatively to model 2
REAL :: ZLAT2 ! geographical coordinates of the first
-REAL :: ZLON2 ! physical flux point of model 2
+REAL :: ZLON2 ! local physical flux point of model 2
+REAL :: ZLAT2GLB ! geographical coordinates of the first
+REAL :: ZLON2GLB ! global physical flux point of model 2
REAL, DIMENSION(:,:), ALLOCATABLE :: ZPGDLAT1 ! geographical coordinates of all
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPGDLON1 ! the flux points of model 1
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPGDLON1 ! the local flux points of model 1
!
INTEGER,DIMENSION(2) :: IXY1 ! first point relatively to model 1
- ! corresponding to physical domain 2
+ ! corresponding to local physical domain 2 (local coords)
+INTEGER,DIMENSION(2) :: IXY1GLB ! first point relatively to model 1
+ ! corresponding to global physical domain 2 (global coords)
INTEGER,DIMENSION(1) :: IX2,IY2 ! point relatively to model 2 corresponding
! to second physical point of model 1
INTEGER,DIMENSION(1) :: IXSUP1,IYSUP1 ! last point relatively to model 1
! corresponding to physical domain 2
+REAL :: IXSUPCOORD1,IYSUPCOORD1 ! coordinates of the last point relatively to model 1
+ ! corresponding to physical domain 2
!
REAL :: ZEPS = 1.E-6 ! a small number
!
INTEGER :: JI,JJ ! loop controls relatively to model 2
INTEGER :: JIBOX,JJBOX ! grid mesh relatively to model 1
+INTEGER :: IINFO_ll
+INTEGER :: IROOTBUF
+INTEGER :: IROOT
+INTEGER :: IPROC
+INTEGER :: IXOR_F, IYOR_F ! origin of local father subdomain (global coord)
+INTEGER :: IXEND_F, IYEND_F ! end of local father subdomain (global coord)
+!INTEGER :: IXOR_C, IYOR_C ! origin of local father subdomain (global coord)
+!INTEGER :: IXEND_C, IYEND_C ! end of local father subdomain (global coord)
+!INTEGER :: IIMAX_C_ll, IJMAX_C_ll ! global dimensions of child model
+INTEGER :: II
+INTEGER :: ZSENDBUF, ZRECVBUF
REAL :: ZCOEF ! ponderation coefficient for linear interpolation
REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT, ZYHAT ! coordinates of model 2
! ! recomputed from coordinates of model 1 and ratios
REAL, DIMENSION(:), ALLOCATABLE :: ZPGDXHAT, ZPGDYHAT ! as XPGDXHAT and XPGDYHAT
! ! with one more point
REAL :: ZERROR_X,ZERROR_Y
+REAL :: ZPGDXHATIXY1,ZPGDYHATIXY1 ! value of XPGDXHAT and XPGDYHAT at origin point of son model
+REAL :: ZPGDXHATIXY1_1,ZPGDYHATIXY1_1 ! value of XPGDXHAT and XPGDYHAT at the next points in X and Y direction respectively
+REAL :: ZXHATFIRSTENTRY_C,ZYHATFIRSTENTRY_C ! value of XXHAT and XYHAT at the first physical point of son model
+REAL :: ZXHATLASTENTRY_C,ZYHATLASTENTRY_C ! value of XXHAT and XYHAT at the last physical point of son model
+REAL :: ZPGDXHATIXY2,ZPGDYHATIXY2 ! value of XPGDXHAT and XPGDYHAT at end point of son model
+REAL :: ZPGDXHATIXY2_1,ZPGDYHATIXY2_1 ! value of XPGDXHAT and XPGDYHAT at the next points in X and Y direction respectively
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+INTEGER, DIMENSION(2) :: IOR_C ! position of pgd model origin points according to father (refered as model 1) domain / 0 if not on local father subdomain
+!TYPE(LIST1D_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
+! variables needed for asynchronous communications
+!INTEGER,PARAMETER :: MPI_MAX_REQ = 1024
+!INTEGER,SAVE,DIMENSION(MPI_MAX_REQ) :: REQ_TAB
+!INTEGER :: NB_REQ
!
!-------------------------------------------------------------------------------
! Current model is DAD model
!
+! get splitting of father model
+ALLOCATE(TZSPLITTING(ISNPROC))
+CALL SPLIT2 ( NIMAX_ll, NJMAX_ll, 1, ISNPROC, TZSPLITTING, YSPLITTING )
+IXOR_F = TZSPLITTING(ISP)%NXOR-JPHEXT
+IYOR_F = TZSPLITTING(ISP)%NYOR-JPHEXT
+IXEND_F = TZSPLITTING(ISP)%NXEND-JPHEXT
+IYEND_F = TZSPLITTING(ISP)%NYEND-JPHEXT
+!
+! go to son model
CALL GOTO_MODEL(KMI)
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+!! get global dims of son model
+!IIMAX_C_ll = NXEND_ALL(KMI) - NXOR_ALL(KMI) - JPHEXT !c'est bizarre mais on l'a init comme ca car sinon get_globaldims_ll donne un resultat faux...
+!IJMAX_C_ll = NYEND_ALL(KMI) - NYOR_ALL(KMI) - JPHEXT !c'est bizarre mais on l'a init comme ca car sinon get_globaldims_ll donne un resultat faux...
+DEALLOCATE(TZSPLITTING)
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+!20131008 adapt calculation NPGDIMAX AND NPGDSJMAX and IIU,IJU from retrieve1 !
+!IIU=NPGDIMAX+2*JPHEXT
+!IJU=NPGDJMAX+2*JPHEXT
+IF ( CPROGRAM == 'REAL ' ) THEN
+!IF ( CPROGRAM == 'REAL ' .OR. CPROGRAM == 'NESPGD' ) THEN
+!20131009 adapt all changes from retrieve1
+ XPGDLATOR=XLATORI
+ XPGDLONOR=XLONORI
+ NPGDIMAX =NIMAX
+ NPGDJMAX =NJMAX
+ IF (ALLOCATED(XPGDXHAT)) DEALLOCATE(XPGDXHAT)
+ IF (ALLOCATED(XPGDYHAT)) DEALLOCATE(XPGDYHAT)
+ ALLOCATE(XPGDXHAT(SIZE(XXHAT)))
+ ALLOCATE(XPGDYHAT(SIZE(XYHAT)))
+ XPGDXHAT(:)=XXHAT(:)
+ XPGDYHAT(:)=XYHAT(:)
+ELSE
+!JUAN correction pour PREP_NEST_PGD 4/04/2014
+!!$NPGDIMAX =NIMAX_ll
+!!$NPGDJMAX =NJMAX_ll
+ENDIF
+!
+!20131008 : now compute IIU & IJU
IIU=NPGDIMAX+2*JPHEXT
IJU=NPGDJMAX+2*JPHEXT
!
-!* 1. KXOR,KYOR
+!
+!* 1. KXOR_C_ll,KYOR_C_ll
! ---------
!
IF(.NOT.LCARTESIAN) THEN
!
-!* 1.1 latitude and longitude of first flux point (model2)
+!* 1.1 latitude and longitude of first local flux point (model2)
! ---------------------------------------------------
!
CALL SM_LATLON(XLATORI,XLONORI, &
XXHAT(JPHEXT+1),XYHAT(JPHEXT+1), &
ZLAT2,ZLON2)
+
+ !20131024 MPPDB CHECK
+ CALL MPPDB_CHECK2D(ZPGDLAT1,"retrieve2_nest_info:ZPGDLAT1",PRECISION)
+ CALL MPPDB_CHECK2D(ZPGDLON1,"retrieve2_nest_info:ZPGDLON1",PRECISION)
!
-!* 1.2 latitude and longitude of all flux points (model1)
+!* 1.2 latitude and longitude of all local flux points (model1)
! --------------------------------------------------
!
ALLOCATE(ZPGDLAT1(IIU,IJU))
@@ -183,63 +272,258 @@ IF(.NOT.LCARTESIAN) THEN
CALL SM_LATLON(XPGDLATOR,XPGDLONOR, &
SPREAD(XPGDXHAT(:),2,IJU),SPREAD(XPGDYHAT(:),1,IIU), &
ZPGDLAT1(:,:),ZPGDLON1(:,:))
-!
-!* 1.3 KXOR, KYOR
-!
- IXY1(:)=MINLOC(ABS(ZPGDLAT1(:,:)-ZLAT2)+ABS(ZPGDLON1(:,:)-ZLON2))
-!
-ELSE
-!
- IXY1(1:1)=MINLOC(ABS(XPGDXHAT(:)-XXHAT(JPHEXT+1)))
- IXY1(2:2)=MINLOC(ABS(XPGDYHAT(:)-XYHAT(JPHEXT+1)))
ENDIF
!
-KXOR=IXY1(1)-JPHEXT
-KYOR=IXY1(2)-JPHEXT
+!* 1.3 KXOR_C_ll, KYOR_C_ll - origin (global) of son model in father grid
+!
+!
+! get origin of the intersection of father subdomain and son subdomain (in local coordinates)
+! we do not differenciate case LCARTESIAN and the other cases
+!
+IXY1(1:1)=MINLOC(ABS(XPGDXHAT(:)-XXHAT(JPHEXT+1)))
+IXY1(2:2)=MINLOC(ABS(XPGDYHAT(:)-XYHAT(JPHEXT+1)))
+! check if there is an intersection
+IF ( IXY1(1) == SIZE(XPGDXHAT) ) THEN
+ IF ( XPGDXHAT(SIZE(XPGDXHAT)) < XXHAT(JPHEXT+1) ) THEN
+ ! there is no intersection - son subdomain is west of father subdomain
+ IXY1(1) = 0
+ ENDIF
+ELSE IF ( IXY1(1) == 1 ) THEN
+ IF ( XPGDXHAT(1) > XXHAT(SIZE(XXHAT)-JPHEXT) ) THEN
+ ! there is no intersection - son subdomain is east of father subdomain
+ IXY1(1) = 0
+ ENDIF
+ENDIF
+IF ( IXY1(2) == SIZE(XPGDYHAT) ) THEN
+ IF ( XPGDYHAT(SIZE(XPGDYHAT)) < XYHAT(JPHEXT+1) ) THEN
+ ! there is no intersection - son subdomain is north of father subdomain
+ IXY1(2) = 0
+ ENDIF
+ELSE IF ( IXY1(2) == 1 ) THEN
+ IF ( XPGDYHAT(1) > XYHAT(SIZE(XYHAT)-JPHEXT) ) THEN
+ ! there is no intersection - son subdomain is south of father subdomain
+ IXY1(2) = 0
+ ENDIF
+ENDIF
!
-IF (KXOR<1 .OR. KXOR>IIU .OR. KYOR<1 .OR. KYOR >IJU) THEN
- WRITE(ILUOUT,*) 'KXOR or KYOR outside of the domain'
- WRITE(ILUOUT,*) 'KXOR= ', KXOR, 'KYOR= ', KYOR
- !callabortstop
-CALL ABORT
- STOP
-END IF
-IF (LCARTESIAN ) THEN
- ZERROR_X=MINVAL(ABS(XPGDXHAT(:)-XXHAT(JPHEXT+1)))
- ZERROR_Y=MINVAL(ABS(XPGDYHAT(:)-XYHAT(JPHEXT+1)))
- IF ( ZERROR_X+ZERROR_Y > ZEPS ) THEN
- WRITE(ILUOUT,*) 'the first physical flux point of model ',KDAD,' does not correspond'
- WRITE(ILUOUT,*) 'to any of its father.'
- WRITE(ILUOUT,*) 'error on x and y : ', ZERROR_X,ZERROR_Y
- !callabortstop
-CALL ABORT
- STOP
- END IF
-ELSE
- IF (MINVAL(ABS(ZPGDLAT1(:,:)-ZLAT2)+ABS(ZPGDLON1(:,:)-ZLON2))>ZEPS) THEN
- WRITE(ILUOUT,*) 'the first physical flux point of model ',KDAD,' does not correspond'
- WRITE(ILUOUT,*) 'to any of its father.'
- WRITE(ILUOUT,*) 'sum of error on latitude and longitude: ', &
- MINVAL(ABS(ZPGDLAT1(:,:)-ZLAT2)+ABS(ZPGDLON1(:,:)-ZLON2))
- !callabortstop
-CALL ABORT
- STOP
- END IF
-END IF
+! Get the indices of the origin of global son model in father model (global coordinates) : KXOR_C_ll, KYOR_C_ll
+!
+! get the value of XXHAT and XYHAT at the origin of global son model
+ ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
+ ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
+ CALL MPI_ALLREDUCE(XXHAT(JPHEXT+1), ZXHATFIRSTENTRY_C, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(XYHAT(JPHEXT+1), ZYHATFIRSTENTRY_C, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+! get the latitude and longitude ZLAT2 and ZLON2 at the origin of global son model
+ ZLAT2GLB = ZLAT2
+ ZLON2GLB = ZLON2
+ CALL MPI_ALLREDUCE(ZLAT2, ZLAT2GLB, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(ZLON2, ZLON2GLB, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+
+ ! identify the process that own the origin of global son model, and communicate the global indices of the origin to all processes
+ IF ( ZXHATFIRSTENTRY_C > XPGDXHAT(JPHEXT+1) .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) .AND. &
+ ZYHATFIRSTENTRY_C > XPGDYHAT(JPHEXT+1) .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ IOR_C(1:1) = MINLOC(ABS(XPGDXHAT(:)-ZXHATFIRSTENTRY_C))
+ IOR_C(2:2) = MINLOC(ABS(XPGDYHAT(:)-ZYHATFIRSTENTRY_C))
+ IOR_C(1:1) = IOR_C(1:1) + IXOR_F - 1 - JPHEXT
+ IOR_C(2:2) = IOR_C(2:2) + IYOR_F - 1 - JPHEXT
+ ! we do some tests....
+! IF (LCARTESIAN ) THEN
+ ZERROR_X=MINVAL(ABS(XPGDXHAT(:)-ZXHATFIRSTENTRY_C))
+ ZERROR_Y=MINVAL(ABS(XPGDYHAT(:)-ZYHATFIRSTENTRY_C))
+ IF ( ZERROR_X+ZERROR_Y > ZEPS ) THEN
+ WRITE(ILUOUT,*) 'the first physical flux point of model ',KDAD,' does not correspond'
+ WRITE(ILUOUT,*) 'to any of its father.'
+ WRITE(ILUOUT,*) 'error on x and y : ', ZERROR_X,ZERROR_Y
+ !callabortstop
+ !CALL ABORT
+ ! STOP
+ END IF
+! ELSE
+! IF (MINVAL(ABS(ZPGDLAT1(:,:)-ZLAT2)+ABS(ZPGDLON1(:,:)-ZLON2))>ZEPS) THEN
+! WRITE(ILUOUT,*) 'the first physical flux point of model ',KDAD,' does not correspond'
+! WRITE(ILUOUT,*) 'to any of its father.'
+! WRITE(ILUOUT,*) 'sum of error on latitude and longitude: ', &
+! MINVAL(ABS(ZPGDLAT1(:,:)-ZLAT2)+ABS(ZPGDLON1(:,:)-ZLON2))
+ !callabortstop
+ !CALL ABORT
+ ! STOP
+! END IF
+! END IF
+ ELSE
+ IOR_C(1:1)=0
+ IOR_C(2:2)=0
+ ENDIF
+ CALL MPI_ALLREDUCE(IOR_C(1:1), KXOR_C_ll, 1,MPI_INTEGER, MPI_SUM, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(IOR_C(2:2), KYOR_C_ll, 1,MPI_INTEGER, MPI_SUM, NMNH_COMM_WORLD, IINFO_ll)
!
!* 1.4 modify coordinates
+! so that XXHAT(JPEXT+1) and XYHAT(JPEXT+1) correspond to the coordinates of the closest father grid points east (resp. north) of XXHAT(JPEXT+1) and XYHAT(JPEXT+1)
! ------------------
!
-XXHAT(:) = XXHAT(:) + XPGDXHAT(IXY1(1))-XXHAT(JPHEXT+1)
-XYHAT(:) = XYHAT(:) + XPGDYHAT(IXY1(2))-XYHAT(JPHEXT+1)
+! we need to do communications :
+! each process must get the value of XPGDXHAT at the origin of its local son subdomain
+!
+!
+! 1.4.1- Identify the process that owns the origin of local son model
+! we do not know the size of son domain in the father grid nor the global index of the origin of the local son subdmain,
+! so it is tricky.
+! We use the coordinates of the origin of local son model : XXHAT(JPHEXT+1) and XYHAT(JPHEXT+1)
+! 1.4.2- communicate the values of XPGDXHAT and XPGDYHAT at the origin of local son model
+DO IPROC = 0,ISNPROC-1 !loop on all processes
+ ! XXHAT(JPHEXT+1), XYHAT(JPHEXT+1) is the first physical entry of local son subdomain
+ ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
+ ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
+ ! broadcast XXHAT(JPHEXT+1) and find which process' father subdomain contains the coords of the first physical entry of local son subdomain
+ CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ !
+ ! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! in this case, the local father subdomain contains the first physical point of local son subdomain
+ ZPGDXHATIXY1 = XPGDXHAT(IXY1(1))
+ ZPGDYHATIXY1 = XPGDYHAT(IXY1(2))
+ ELSE IF ( ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! the local father subdomain of current process contains the first physical point of local son subdomain of IPROC
+ ! search for the first father physical grid point east and north of (not strictly) the first physical point of local son subdomain
+ II=SIZE(XPGDXHAT)-JPHEXT
+ DO WHILE ( XPGDXHAT(II) > ZXHATFIRSTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the first physical point of the local son subdomain of IPROC is II on the current process
+ ! send XPGDXHAT(II) to process IPROC
+ ZSENDBUF = XPGDXHAT(II)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDXHATIXY1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ !
+ ! communicating the value of XPGDYHAT (Y direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! in this case, the local father subdomain contains the first physical point of local son subdomain
+ ZPGDXHATIXY1 = XPGDXHAT(IXY1(1))
+ ZPGDYHATIXY1 = XPGDYHAT(IXY1(2))
+ ELSE IF ( ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! the local father subdomain of current process contains the first physical point of local son subdomain
+ ! search for the first father physical grid point east and north of (not strictly) the first physical point of local son subdomain
+ II=SIZE(XPGDYHAT)-JPHEXT
+ DO WHILE ( XPGDYHAT(II) > ZYHATFIRSTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the first physical point of the local son subdomain is II on the current process
+ ! send XPGDYHAT(II) to process IPROC
+ ZSENDBUF = XPGDYHAT(II)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDYHATIXY1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ ! REMARK :
+ ! I have to do synchronous communications since the receiving process does not know the rank
+ ! of the sending process, nor the tag of the message
+ENDDO
+!
+! 1.4.3- communicate the values of XPGDXHAT (resp. XPGDYHAT) at the next point east (resp. north) of the origin of local son model
+! (same as for 1.4.2)
+!
+DO IPROC = 0,ISNPROC-1 !loop on all processes
+ ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
+ ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
+ ! broadcast XXHAT(JPHEXT+1) and find which process' father subdomain contains the coords of the first physical entry of local son subdomain
+ CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MPI_DOUBLE_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MPI_DOUBLE_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ !
+ ! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! in this case, the local father subdomain contains the first physical point of local son subdomain
+ ZPGDXHATIXY1_1 = XPGDXHAT(IXY1(1)+1)
+ ZPGDYHATIXY1_1 = XPGDYHAT(IXY1(2)+1)
+ ELSE IF ( ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! the local father subdomain of current process contains the first physical point of local son subdomain
+ ! search for the first father physical grid point east and north of (not strictly) the first physical point of local son subdomain
+ II=SIZE(XPGDXHAT)-JPHEXT
+ DO WHILE ( XPGDXHAT(II) > ZXHATFIRSTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the first physical point of the local son subdomain is II on the current process
+ ! XPGDXHAT(II+1) is also defined on current process since HALO is at least 1
+ ! send XPGDXHAT(II+1) to process IPROC
+ ZSENDBUF = XPGDXHAT(II+1)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDXHATIXY1_1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ !
+ ! communicating the value of XPGDYHAT (Y direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! in this case, the local father subdomain contains the first physical point of local son subdomain
+ ZPGDXHATIXY1_1 = XPGDXHAT(IXY1(1)+1)
+ ZPGDYHATIXY1_1 = XPGDYHAT(IXY1(2)+1)
+ ELSE IF ( ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) &
+ .AND. ZYHATFIRSTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATFIRSTENTRY_C <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! the local father subdomain of current process contains the first physical point of local son subdomain
+ ! search for the first father physical grid point east and north of (not strictly) the first physical point of local son subdomain
+ II=SIZE(XPGDYHAT)-JPHEXT
+ DO WHILE ( XPGDYHAT(II) > ZYHATFIRSTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the first physical point of the local son subdomain is II on the current process
+ ! XPGDYHAT(II+1) is also defined on current process since HALO is at least 1
+ ! send XPGDYHAT(II+1) to process IPROC
+ ZSENDBUF = XPGDYHAT(II+1)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDYHATIXY1_1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ENDDO
+!
+! 1.4.4 - modify coordinates so that XXHAT(JPEXT+1) and XYHAT(JPEXT+1) correspond to the coordinates of the closest father grid points east (resp. north) of XXHAT(JPEXT+1) and XYHAT(JPEXT+1)
+!
+XXHAT(:) = XXHAT(:) + ZPGDXHATIXY1-XXHAT(JPHEXT+1)
+XYHAT(:) = XYHAT(:) + ZPGDYHATIXY1-XYHAT(JPHEXT+1)
+!XXHAT(:) = XXHAT(:) + XPGDXHAT(IXY1(1))-XXHAT(JPHEXT+1)
+!XYHAT(:) = XYHAT(:) + XPGDYHAT(IXY1(2))-XYHAT(JPHEXT+1)
!
!-------------------------------------------------------------------------------
!
!* 2. KDXRATIO, KDYRATIO
! ------------------
!
-IX2(:)=MINLOC(ABS(XPGDXHAT(IXY1(1)+1)-XXHAT(:)))
-IY2(:)=MINLOC(ABS(XPGDYHAT(IXY1(2)+1)-XYHAT(:)))
+IX2(:)=MINLOC(ABS(ZPGDXHATIXY1_1-XXHAT(:)))
+IY2(:)=MINLOC(ABS(ZPGDYHATIXY1_1-XYHAT(:)))
!
KDXRATIO=IX2(1)-JPHEXT-1
KDYRATIO=IY2(1)-JPHEXT-1
@@ -248,23 +532,144 @@ KDYRATIO=IY2(1)-JPHEXT-1
!
!* 3. KXSIZE,KYSIZE
! -------------
-!
-IXSUP1(:)=MINLOC(ABS(XPGDXHAT(:)-XXHAT(NIMAX+JPHEXT+1)))
-IYSUP1(:)=MINLOC(ABS(XPGDYHAT(:)-XYHAT(NJMAX+JPHEXT+1)))
-!
-IXSUP1(:)= IXSUP1(:) -1
-IYSUP1(:)= IYSUP1(:) -1
-!
-KXSIZE=IXSUP1(1)-IXY1(1)+1
-KYSIZE=IYSUP1(1)-IXY1(2)+1
-!
-IF ( KXOR+KXSIZE+2*JPHEXT-1<1 .OR. KXOR+KXSIZE+2*JPHEXT-1>IIU &
- .OR. KYOR+KYSIZE+2*JPHEXT-1<1 .OR. KYOR+KYSIZE+2*JPHEXT-1>IJU) THEN
+
+! 3.1- Identify the process that owns the end of local son model
+! we do not know the size of son domain in the father grid nor the global index of the end of the local son subdmain,
+! so it is tricky.
+! We use the coordinates of the origin of local son model : XXHAT(JPHEXT+1) and XYHAT(JPHEXT+1)
+! 3.2- communicate the values of XPGDXHAT and XPGDYHAT at the point just past the end of local son model
+! WARNING: we assume JPHEXT >= 1
+DO IPROC = 0,ISNPROC-1 !loop on all processes
+ ZXHATLASTENTRY_C = XXHAT(SIZE(XXHAT)-JPHEXT)
+ ZYHATLASTENTRY_C = XYHAT(SIZE(XYHAT)-JPHEXT)
+ ! broadcast XXHAT(SIZE(XXHAT)-JPHEXT) and find which process' father subdomain contains the coords of the last physical entry of local son subdomain
+ CALL MPI_BCAST( ZXHATLASTENTRY_C, 1, MPI_DOUBLE_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATLASTENTRY_C, 1, MPI_DOUBLE_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ !
+ ! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATLASTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATLASTENTRY_C < XPGDXHAT(SIZE(XPGDXHAT)) &
+ .AND. ZYHATLASTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATLASTENTRY_C < XPGDYHAT(SIZE(XPGDYHAT)) ) THEN
+ ! the local father subdomain of current process contains the last physical point of local son subdomain
+ ! search for the last father physical grid point west and south of (not strictly) the last physical point of local son subdomain
+ II=SIZE(XPGDXHAT)-JPHEXT
+ DO WHILE ( XPGDXHAT(II) > ZXHATLASTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the last physical point of the local son subdomain is II on the current process
+ ! XPGDYHAT(II+1) is also defined on current process since HALO is at least 1
+ ZPGDXHATIXY2_1 = XPGDXHAT(II)
+ ELSE IF ( ZXHATLASTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATLASTENTRY_C < XPGDXHAT(SIZE(XPGDXHAT)) &
+ .AND. ZYHATLASTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATLASTENTRY_C < XPGDYHAT(SIZE(XPGDYHAT)) ) THEN
+ ! the local father subdomain of current process contains the last physical point of local son subdomain
+ ! search for the last father physical grid point west and south of (not strictly) the last physical point of local son subdomain
+ II=SIZE(XPGDXHAT)-JPHEXT
+ DO WHILE ( XPGDXHAT(II) > ZXHATLASTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the last physical point of the local son subdomain is II on the current process
+ ! send XPGDXHAT(II) to process IPROC
+ ! XPGDYHAT(II+1) is also defined on current process since HALO is at least 1
+ ZSENDBUF = XPGDXHAT(II)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDXHATIXY2_1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ !
+ ! communicating the value of XPGDYHAT (Y direction) at the origin of local son subdomain
+ IF ( IPROC == ISP-1 .AND. ZXHATLASTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATLASTENTRY_C < XPGDXHAT(SIZE(XPGDXHAT)) &
+ .AND. ZYHATLASTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATLASTENTRY_C < XPGDYHAT(SIZE(XPGDYHAT)) ) THEN
+ ! the local father subdomain of current process contains the last physical point of local son subdomain
+ ! search for the last father physical grid point west and south of (not strictly) the last physical point of local son subdomain
+ II=SIZE(XPGDYHAT)-JPHEXT
+ DO WHILE ( XPGDYHAT(II) > ZYHATLASTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the last physical point of the local son subdomain is II on the current process
+ ! send XPGDYHAT(II) to process IPROC
+ ZPGDYHATIXY2_1 = XPGDYHAT(II)
+ ELSE IF ( ZXHATLASTENTRY_C >= XPGDXHAT(JPHEXT+1) &
+ .AND. ZXHATLASTENTRY_C < XPGDXHAT(SIZE(XPGDXHAT)) &
+ .AND. ZYHATLASTENTRY_C >= XPGDYHAT(JPHEXT+1) &
+ .AND. ZYHATLASTENTRY_C < XPGDYHAT(SIZE(XPGDYHAT)) ) THEN
+ ! the local father subdomain of current process contains the last physical point of local son subdomain
+ ! search for the last father physical grid point west and south of (not strictly) the last physical point of local son subdomain
+ II=SIZE(XPGDYHAT)-JPHEXT
+ DO WHILE ( XPGDYHAT(II) > ZYHATLASTENTRY_C )
+ II=II-1
+ END DO
+ ! the index of the last physical point of the local son subdomain is II on the current process
+ ! send XPGDYHAT(II) to process IPROC
+ ZSENDBUF = XPGDYHAT(II)
+ CALL MPI_SEND( ZSENDBUF,1,MPI_DOUBLE_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ ELSE IF ( IPROC == ISP-1 ) THEN
+ CALL MPI_RECV( ZRECVBUF,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ ZPGDYHATIXY2_1 = ZRECVBUF
+ ELSE
+ ! the other processes do nothing...
+ ENDIF
+ENDDO
+ ! REMARK :
+ ! I have to do synchronous communications since the receiving process does not know the rank
+ ! of the sending process, nor the tag of the message
+ ! For the same reason (tag unknown to receiving process),
+ ! I cannot send/recv XPGDXHAT(II) and XPGDYHAT(II) at the same time
+
+! 3.3 - now we have the coordinates (ZPGDXHATIXY2_1, ZPGDYHATIXY2_1) of the point in father grid just right+north of the LOCAL son subdomain
+! We compute the coordinates of the last point in father grid of the GLOBAL son subdomain
+CALL MPI_ALLREDUCE(ZPGDXHATIXY2_1, IXSUPCOORD1, 1,MPI_DOUBLE_PRECISION, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+CALL MPI_ALLREDUCE(ZPGDYHATIXY2_1, IYSUPCOORD1, 1,MPI_DOUBLE_PRECISION, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+
+! we compute the index of this point in local father grid
+IF ( IXSUPCOORD1 >= XPGDXHAT(1+JPHEXT) .AND. IXSUPCOORD1 <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) .AND. &
+ IYSUPCOORD1 >= XPGDYHAT(1+JPHEXT) .AND. IYSUPCOORD1 <= XPGDYHAT(SIZE(XPGDYHAT)-JPHEXT) ) THEN
+ ! the point in father grid just right+north of the local son subdomain is in local subdomain
+ ! compute the local index in X (resp. Y) direction of this point
+ IXSUP1(:)=1
+ DO WHILE( XPGDXHAT(IXSUP1(1)) < IXSUPCOORD1 )
+ IXSUP1(:)=IXSUP1(:)+1
+ ENDDO
+ IYSUP1(:)=1
+ DO WHILE( XPGDYHAT(IYSUP1(1)) < IYSUPCOORD1 )
+ IYSUP1(:)=IYSUP1(:)+1
+ ENDDO
+ ! switch to global coordinates
+ IXSUP1(:) = IXSUP1(:) + IXOR_F - 1
+ IYSUP1(:) = IYSUP1(:) + IYOR_F - 1
+ELSE
+ IXSUP1(:)=0
+ IYSUP1(:)=0
+ENDIF
+CALL MPI_ALLREDUCE(IXSUP1(1), KXSIZE, 1,MPI_INTEGER, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+CALL MPI_ALLREDUCE(IYSUP1(1), KYSIZE, 1,MPI_INTEGER, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+IXSUP1(1) = KXSIZE
+IYSUP1(1) = KYSIZE
+!
+! compute the global size of son model in the father grid
+KXSIZE=IXSUP1(1)-(KXOR_C_ll+JPHEXT)+1
+KYSIZE=IYSUP1(1)-(KYOR_C_ll+JPHEXT)+1
+!
+! some more tests
+!
+CALL MPI_ALLREDUCE(IIU-2*JPHEXT, IIUGLB, 1,MPI_INTEGER, MPI_SUM, NMNH_COMM_WORLD, IINFO_ll)
+CALL MPI_ALLREDUCE(IJU-2*JPHEXT, IJUGLB, 1,MPI_INTEGER, MPI_SUM, NMNH_COMM_WORLD, IINFO_ll)
+IIUGLB = IIUGLB + 2*JPHEXT
+IJUGLB = IJUGLB + 2*JPHEXT
+IF ( KXOR_C_ll<1 .OR. KXOR_C_ll+KXSIZE+2*JPHEXT>IIUGLB &
+ .OR. KYOR_C_ll<1 .OR. KYOR_C_ll+KYSIZE+2*JPHEXT>IJUGLB) THEN
WRITE(ILUOUT,*) 'KXEND or KYEND (last point used in domain',KMI,') outside of the domain'
- WRITE(ILUOUT,*) 'KXEND= ', KXOR+KXSIZE+2*JPHEXT-1, 'KYEND= ', KYOR+KYSIZE+2*JPHEXT-1
+ WRITE(ILUOUT,*) 'KXEND= ', KXOR_C_ll+KXSIZE+2*JPHEXT-1, 'KYEND= ', KYOR_C_ll+KYSIZE+2*JPHEXT-1
!callabortstop
-CALL ABORT
- STOP
+!CALL ABORT
+! STOP
END IF
!-------------------------------------------------------------------------------
!
@@ -280,21 +685,38 @@ IPGDJU = NPGDJMAX+2*JPHEXT
ALLOCATE(ZPGDXHAT(0:IPGDIU+1))
ALLOCATE(ZPGDYHAT(0:IPGDJU+1))
!
+! it is too complicated to test on the HALO
+! it would require communications to determine the neighbouring processes
+! and updating the extra halo points we added in ZPGDXHAT / ZPGDYHAT
+!
ZPGDXHAT(1:IPGDIU) = XPGDXHAT(:)
ZPGDYHAT(1:IPGDJU) = XPGDYHAT(:)
+!IF ( LEAST_ll() ) THEN
ZPGDXHAT(IPGDIU+1) = 2.* XPGDXHAT(IPGDIU) - XPGDXHAT(IPGDIU-1)
+!ENDIF
+!IF ( LNORTH_ll() ) THEN
ZPGDYHAT(IPGDJU+1) = 2.* XPGDYHAT(IPGDJU) - XPGDYHAT(IPGDJU-1)
+!ENDIF
+!IF ( LWEST_ll() ) THEN
ZPGDXHAT(0) = 2.* XPGDXHAT(1) - XPGDXHAT(2)
+!ENDIF
+!IF ( LSOUTH_ll() ) THEN
ZPGDYHAT(0) = 2.* XPGDYHAT(1) - XPGDYHAT(2)
+!ENDIF
!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! JE COMMENTE TOUTE LA PARTIE 4 CAR IL S'AGIT SEULEMENT DE TESTS,
+!!! ET POUR LES FAIRE CORRECTEMENT IL FAUT FAIRE DES COMMUNICATIONS : C'EST INUTILE DE LE FAIRE SYSTEMATIQUEMENT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#if 0
DO JI=1,NIMAX+2*JPHEXT
- JIBOX=(JI+KDXRATIO-1-JPHEXT)/KDXRATIO + KXOR
+ JIBOX=(JI+KDXRATIO-1-JPHEXT)/KDXRATIO + KXOR_C_ll
ZCOEF= FLOAT(MOD(JI+KDXRATIO-1-JPHEXT,KDXRATIO))/FLOAT(KDXRATIO)
ZXHAT(JI)=(1.-ZCOEF)*ZPGDXHAT(JIBOX+JPHEXT-1)+ZCOEF*ZPGDXHAT(JIBOX+JPHEXT) ! +1
END DO
!
DO JJ=1,NJMAX+2*JPHEXT
- JJBOX=(JJ+KDYRATIO-1-JPHEXT)/KDYRATIO + KYOR
+ JJBOX=(JJ+KDYRATIO-1-JPHEXT)/KDYRATIO + KYOR_C_ll
ZCOEF= FLOAT(MOD(JJ+KDYRATIO-1-JPHEXT,KDYRATIO))/FLOAT(KDYRATIO)
ZYHAT(JJ)=(1.-ZCOEF)*ZPGDYHAT(JJBOX+JPHEXT-1)+ZCOEF*ZPGDYHAT(JJBOX+JPHEXT) ! +1
END DO
@@ -313,9 +735,10 @@ IF ( ANY(ABS(XXHAT(:)-ZXHAT(:))>ZEPS) &
' ZYHAT(',JJ,') = ', ZYHAT(JJ)
END DO
!callabortstop
-CALL ABORT
- STOP
+!CALL ABORT
+! STOP
END IF
+#endif
!
DEALLOCATE(ZXHAT)
DEALLOCATE(ZYHAT)
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index 3fef83ef7fb6a75d85b45cbfff38742af135c970..55aa53f701d34891ebb3cdef7960c1519b835a94 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -111,6 +111,7 @@ END MODULE MODI_SET_MASS
!! Tout a été modifié pour se rapprocher de PREP_REAL_CASE
!! J. Escobar 27/03/2012 modif for reprod sum
!! V.Masson 12/08/13 Parallelization of the initilization profile
+!! M.Moge 08/2015 add UPDATE_HALO_ll on XTHT, ZTHV3D, XRT(:,:,1,:) after computation
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!!
!-------------------------------------------------------------------------------
@@ -219,6 +220,8 @@ REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD ! dry d
!!$INTEGER :: IIBP,IIEP,IJBP,IJEP
REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLXZ_TOT,ZNFLYZ_TOT
REAL, DIMENSION(:) , ALLOCATABLE :: ZNFLXZ_TOT_ll,ZNFLYZ_TOT_ll ! total normalized mass flux
+!
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
@@ -454,6 +457,12 @@ ELSE
ZTHV3D(:,:,1)=ZTHV3D(:,:,2)
XTHT(:,:,1)=XTHT(:,:,2)
XRT(:,:,1,:)=XRT(:,:,2,:)
+NULLIFY( TZFIELDS_ll )
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XTHT)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTHV3D)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XRT(:,:,1,:))
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
!
IF (NRR>=3) THEN
diff --git a/src/MNH/set_ref.f90 b/src/MNH/set_ref.f90
index 8b04572f39ccd919fde0aad4e3041830c0e75815..bfe7052f2068d2a774082f52a4f1c0df5a46570d 100644
--- a/src/MNH/set_ref.f90
+++ b/src/MNH/set_ref.f90
@@ -151,6 +151,8 @@ END MODULE MODI_SET_REF
!! Modification 03/12/02 (P. Jabouille) add no thinshell condition
!! Modification 05/06 Remove the 'DAVI' type of lbc
!! Modification 07/13 (J.Colin) Special case for LBOUSS=T
+!! Modification 07/13 (M.Moge) calling UPDATE_HALO_ll on PRHODJ, PRVREF,
+!! PRHODREF, PEXNREF, PTHVREF after computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -249,6 +251,7 @@ REAL, ALLOCATABLE, DIMENSION (:,:) :: ZREFMASS_2D , ZMASS_O_PHI0_2D
REAL, ALLOCATABLE, DIMENSION (:,:) :: ZLINMASS_W_2D , ZLINMASS_E_2D , ZLINMASS_S_2D , ZLINMASS_N_2D
!REAL :: ZREFMASS , ZMASS_O_PHI0 , ZLINMASS ! total leak of mass
!JUAN16
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
!
!
!-------------------------------------------------------------------------------
@@ -408,6 +411,17 @@ ELSEIF ( CEQNSYS == 'MAE' .OR. CEQNSYS == 'LHE' ) THEN
PRHODJ(:,:,:) = PRHODREF(:,:,:)* PJ(:,:,:)
END IF
!
+! update halo of PRHODJ and PRVREF for future use ( notably in anel_balance_n )
+!
+NULLIFY( TZFIELDS_ll )
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PRHODJ)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVREF)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PRHODREF)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PEXNREF)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHVREF)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
CALL MPPDB_CHECK3D(ZRHOREF,"SET_REF::ZRHOREF",PRECISION)
CALL MPPDB_CHECK3D(PRVREF,"SET_REF::PRVREF",PRECISION)
CALL MPPDB_CHECK3D(PRHODJ,"SET_REF::PRHODJ",PRECISION)
@@ -504,6 +518,11 @@ IF ( HLBCY(1)=='OPEN' ) THEN
!
END IF
!
+CALL MPPDB_CHECK3D(PRHODREF,"SET_REF::PRHODREF",PRECISION)
+CALL MPPDB_CHECK3D(PTHVREF,"SET_REF::PTHVREF",PRECISION)
+CALL MPPDB_CHECK3D(PRVREF,"SET_REF::PRVREF",PRECISION)
+CALL MPPDB_CHECK3D(PEXNREF,"SET_REF::PEXNREF",PRECISION)
+CALL MPPDB_CHECK3D(PRHODJ,"SET_REF::PRHODJ",PRECISION)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/set_refz.f90 b/src/MNH/set_refz.f90
index ef8036822a38a95611701904af301b9b5e38a793..f07744d38f9faf8e3d91188ac3221b2523ee7214 100644
--- a/src/MNH/set_refz.f90
+++ b/src/MNH/set_refz.f90
@@ -122,6 +122,7 @@ END MODULE MODI_SET_REFZ
!! 26/10/10 (G. Tanguy) add control on rv : if equal to 0
!! at MINLEVEL, keep 0 for lower levels
!! (for ideal case)
+!! 2014 (M.Faivre)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -139,6 +140,9 @@ USE MODD_GRID_n
USE MODD_REF
USE MODD_PARAMETERS
!
+!20131024 mppdb
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -179,6 +183,10 @@ IKE=IKU-JPVEXT
!
ZZMASS(:,:,:)=MZF(1,IKU,1,XZZ(:,:,:))
ZZMASS(:,:,IKU)=1.5*XZZ(:,:,IKU)-0.5*XZZ(:,:,IKU-1)
+!
+!20131024 check zzmass and pthv
+CALL MPPDB_CHECK3D(PTHV,"SET_REFZ:PTHV",PRECISION)
+CALL MPPDB_CHECK3D(ZZMASS,"SET_REFZ:ZZMASS",PRECISION)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index eeed36994984653c1faa6fc83b8f48a54f0085a9..79d0874e4c962d711d6b17d2ee6b7517a7bff1df 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -140,6 +140,8 @@ END MODULE MODI_SPAWN_FIELD2
!! Modification 06/12 (M.Tomasini) Interpolation of turbulent fluxes (EDDY_FLUX)
!! for 2D west african monsoon
!! Modification 07/13 (Bosseur & Filippi) Adds Forefire
+!! Modification 2014 (M.Faivre)
+!! Modification 25/02/2015 (M.Moge) correction of the parallelization attempted by M.Faivre
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -184,6 +186,9 @@ USE MODD_LATZ_EDFLX
USE MODD_DEF_EDDY_FLUX_n
USE MODD_DEF_EDDYUV_FLUX_n
!
+USE MODE_MPPDB
+USE MODE_ll
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -227,8 +232,29 @@ INTEGER :: IRR ! Number of moist variables
REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XRT,1),SIZE(FIELD_MODEL(1)%XRT,2),SIZE(FIELD_MODEL(1)%XRT,3)) :: ZHUT ! relative humidity
! (model 1)
REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XTHT,1),SIZE(FIELD_MODEL(1)%XTHT,2),SIZE(FIELD_MODEL(1)%XTHT,3)) :: ZTHVT! virtual pot. T
- ! (model 1)
-INTEGER :: IMI
+ ! (model 1)
+!$20140708
+!$***** 3D
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUT_C, ZLSUM_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVT_C, ZLSVM_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWT_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVT_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSWM_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSTHM_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSRVM_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKET_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUT_C, ZSRCM_C, ZSRCT_C, ZSIGS_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVU_FLUX_M_C, ZVTH_FLUX_M_C, ZWTH_FLUX_M_C
+!$***** 4D
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT_C
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT_C, ZDTHFRC_C, ZDRVFRC_C
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTHREL_C, ZRVREL_C
+!$
+INTEGER :: IMI, JI,KI
+!$20140708
+INTEGER :: IDIMX_C, IDIMY_C
+INTEGER :: IINFO_ll
+!$
! Arrays for reading fields of input SON 1 file
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHT1,ZTHVT1
@@ -294,6 +320,10 @@ IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!
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
@@ -362,133 +392,298 @@ ELSE
!* 2.2 general case - change of resolution :
! -----------------------------------
!
+!$20140708 get XDIM, YDIM = G2^G1@resol1
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
+!
+!$20140708 use ZTHVM_C in BIKAT top cal PTHVM_C
+ !$**** 3D
+ ALLOCATE(ZUT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
+ ALLOCATE(ZLSUM_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
+ ALLOCATE(ZVT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZLSVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZWT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZLSWM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZLSTHM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZLSRVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ !$20140709
+ ALLOCATE(ZHUT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZTKET_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZSRCT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZSIGS_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZTHVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
+ ALLOCATE(ZVU_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZVTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ ALLOCATE(ZWTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
+ !$***** 4D
+ ALLOCATE(ZRT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ ALLOCATE(ZSVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ ALLOCATE(ZDRVFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ ALLOCATE(ZDTHFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ ALLOCATE(ZRVREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ ALLOCATE(ZTHREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
+ !$initialize
+ !$***** 3D
+ ZUT_C =0.
+ ZLSUM_C =0.
+ ZVT_C =0.
+ ZWT_C =0.
+ ZTHVT_C =0.
+ ZHUT_C =0.
+ ZTKET_C =0.
+ ZSRCT_C =0.
+ ZSIGS_C =0.
+ ZVU_FLUX_M_C=0.
+ ZVTH_FLUX_M_C=0.
+ ZWTH_FLUX_M_C=0.
+ !$***** 4D
+ ZRT_C =0.
+ ZSVT_C =0.
+ ZDRVFRC_C=0.
+ ZDTHFRC_C=0.
+ ZRVREL_C=0.
+ ZTHREL_C=00
+!
+ !$***** 3D VARS
+ DO JI=1,SIZE(PUT,3)
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ !
+ !$series of SET_LSFIELD_1WAY_ll
+ !$***** 3D VARS
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XUT(:,:,JI),ZUT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSUM(:,:,JI), ZLSUM_C(:,:,JI),2)
+ !
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XVT(:,:,JI),ZVT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSVM(:,:,JI),ZLSVM_C(:,:,JI),2)
+ !
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XWT(:,:,JI),ZWT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSWM(:,:,JI),ZLSWM_C(:,:,JI),2)
+ !
+ CALL SET_LSFIELD_1WAY_ll(ZTHVT(:,:,JI), ZTHVT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSTHM(:,:,JI),ZLSTHM_C(:,:,JI),2)
+ !$conditionnal VARS
+ IF (HTURB /= 'NONE') THEN
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XTKET(:,:,JI), ZTKET_C(:,:,JI),2)
+ ENDIF
+ IF (CONF_MODEL(1)%NRR>=1) THEN
+ CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSRVM(:,:,JI), ZLSRVM_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(ZHUT(:,:,JI),ZHUT_C(:,:,JI),2)
+ ENDIF
+ IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSRCT(:,:,JI),ZSRCT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSIGS(:,:,JI),ZSIGS_C(:,:,JI),2)
+ ENDIF
+ IF (LUV_FLX) &
+ CALL SET_LSFIELD_1WAY_ll(EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M(:,:,JI),ZVU_FLUX_M_C(:,:,JI),2)
+ IF (LTH_FLX) THEN
+ CALL SET_LSFIELD_1WAY_ll(EDDY_FLUX_MODEL(1)%XVTH_FLUX_M(:,:,JI),ZVTH_FLUX_M_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(EDDY_FLUX_MODEL(1)%XWTH_FLUX_M(:,:,JI),ZWTH_FLUX_M_C(:,:,JI),2)
+ ENDIF
+ !
+ CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ CALL UNSET_LSFIELD_1WAY_ll()
+!
+ ENDDO
+!if the child grid is the whole father grid, we first need to extrapolate
+!the data on a "pseudo halo" before doing BIKHARDT interpolation
+! -------> done in LS_FORCING_ll
+ !$***** 4D VARS
+ DO JI=1,SIZE(PUT,3)
+ DO KI=1,SIZE(PRT,4)
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ IF (CONF_MODEL(1)%NRR>=1) THEN
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XRT(:,:,JI,KI),ZRT_C(:,:,JI,KI),2)
+ ENDIF
+ IF (NSV>=1) THEN
+ CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSVT(:,:,JI,KI),ZSVT_C(:,:,JI,KI),2)
+ ENDIF
+ IF ( L2D_ADV_FRC ) THEN
+ CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDTHFRC(:,:,JI,KI),ZDTHFRC_C(:,:,JI,KI),2)
+ CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDRVFRC(:,:,JI,KI),ZDRVFRC_C(:,:,JI,KI),2)
+ ENDIF
+ IF (L2D_REL_FRC) THEN
+ CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XTHREL(:,:,JI,KI),ZTHREL_C(:,:,JI,KI),2)
+ CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XRVREL(:,:,JI,KI),ZRVREL_C(:,:,JI,KI),2)
+ ENDIF
+ !
+ CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ CALL UNSET_LSFIELD_1WAY_ll()
+!
+ ENDDO
+ ENDDO
+!if the child grid is the whole father grid, we first need to extrapolate
+!the data on a "pseudo halo" before doing BIKHARDT interpolation
+! -------> done in LS_FORCING_ll
+!
! Interpolation of the U variable at t
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,2, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XUT,PUT)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZUT_C,PUT)
+ CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
+!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,2, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSUM,PLSUM)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSUM_C,PLSUM)
+ CALL MPPDB_CHECK3D(PLSUM,"SPAWN_FIELD2:PLSUM",PRECISION)
!
! Interpolation of the V variable at t
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,3, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XVT,PVT)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZVT_C,PVT)
+ CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
+!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,3, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSVM,PLSVM)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSVM_C,PLSVM)
+ CALL MPPDB_CHECK3D(PLSVM,"SPAWN_FIELD2:PLSVM",PRECISION)
!
! Interpolation of variables at t
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,4, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSWM,PLSWM)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZWT_C,PWT)
+ CALL MPPDB_CHECK3D(PWT,"SPAWN_FIELD2:PWT",PRECISION)
+!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSTHM,PLSTHM)
- IF (CONF_MODEL(1)%NRR>=1) &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSWM_C,PLSWM)
+ CALL MPPDB_CHECK3D(PLSWM,"SPAWN_FIELD2:PLSWM",PRECISION)
+!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSRVM,PLSRVM)
- IF (CONF_MODEL(1)%NRR>=1) &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSTHM_C,PLSTHM)
+ CALL MPPDB_CHECK3D(PLSTHM,"SPAWN_FIELD2:PLSTHM",PRECISION)
!
-! Interpolation of variables at t
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,4, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XWT,PWT)
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTHVT,PTHVT)
- IF (HTURB /= 'NONE') &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XTKET,PTKET)
+ IF (CONF_MODEL(1)%NRR>=1) THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSRVM_C,PLSRVM)
+ CALL MPPDB_CHECK3D(PLSRVM,"SPAWN_FIELD2:PLSRVM",PRECISION)
+ ENDIF
!
- IF (CONF_MODEL(1)%NRR>=1) &
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHUT,PHUT)
-
- IF (CONF_MODEL(1)%NRR>=1) &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XRT,PRT)
- IF (NSV>=1) &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSVT,PSVT)
- IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSRCT,PSRCT)
- IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSIGS,PSIGS)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTHVT_C,PTHVT)
+ CALL MPPDB_CHECK3D(PTHVT,"SPAWN_FIELD2:PTHVT",PRECISION)
+!
+ IF (HTURB /= 'NONE') THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTKET_C,PTKET)
+ CALL MPPDB_CHECK3D(PTKET,"SPAWN_FIELD2:PTKET",PRECISION)
+ ENDIF
+!
+ IF (CONF_MODEL(1)%NRR>=1) THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHUT_C,PHUT)
+ CALL MPPDB_CHECK3D(PHUT,"SPAWN_FIELD2:PHUT",PRECISION)
+ ENDIF
+!
+ IF (CONF_MODEL(1)%NRR>=1) THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZRT_C,PRT)
+ CALL MPPDB_CHECK3D(PRT(:,:,:,1),"SPAWN_FIELD2:PRT",PRECISION)
+ ENDIF
+!
+ IF (NSV>=1) THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSVT_C,PSVT)
+ CALL MPPDB_CHECK3D(PSVT(:,:,:,1),"SPAWN_FIELD2:PSVT",PRECISION)
+ ENDIF
+!
+ IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSRCT_C,PSRCT)
+ CALL MPPDB_CHECK3D(PSRCT,"SPAWN_FIELD2:PSRCT",PRECISION)
+ ENDIF
+!
+ IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSIGS_C,PSIGS)
+ CALL MPPDB_CHECK3D(PSIGS,"SPAWN_FIELD2:PSIGS",PRECISION)
+ ENDIF
!
IF ( L2D_ADV_FRC ) THEN ! MT adding for ADVFRC
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- ADVFRC_MODEL(1)%XDTHFRC,PDTHFRC)
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- ADVFRC_MODEL(1)%XDRVFRC,PDRVFRC)
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZDTHFRC_C,PDTHFRC)
+!
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZDRVFRC_C,PDRVFRC)
ENDIF
IF (L2D_REL_FRC) THEN ! MT adding for REL FRC
WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: Appel a BIKHARDT pour RELFRC'
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- RELFRC_MODEL(1)%XTHREL,PTHREL)
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- RELFRC_MODEL(1)%XRVREL,PRVREL)
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZTHREL_C,PTHREL)
+!
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZRVREL_C,PRVREL)
ENDIF
!
IF ( LUV_FLX) THEN ! MT adding for EDDY_FLUX
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M,PVU_FLUX_M)
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZVU_FLUX_M_C,PVU_FLUX_M)
+ CALL MPPDB_CHECK3D(PVU_FLUX_M,"SPAWN_FIELD2:PVU_FLUX_M",PRECISION)
ENDIF
-
+!
IF (LTH_FLX) THEN
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- EDDY_FLUX_MODEL(1)%XVTH_FLUX_M,PVTH_FLUX_M)
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
- EDDY_FLUX_MODEL(1)%XWTH_FLUX_M,PWTH_FLUX_M)
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZVTH_FLUX_M_C,PVTH_FLUX_M)
+ CALL MPPDB_CHECK3D(PVTH_FLUX_M,"SPAWN_FIELD2:PVTH_FLUX_M",PRECISION)
+!
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZWTH_FLUX_M_C,PWTH_FLUX_M)
+ CALL MPPDB_CHECK3D(PWTH_FLUX_M,"SPAWN_FIELD2:PWTH_FLUX_M",PRECISION)
ENDIF
!
END IF
diff --git a/src/MNH/spawn_grid2.f90 b/src/MNH/spawn_grid2.f90
index 27c6c23bd7c2645026802fc323718aabdcd65233..23e9a897441348c7c2c11cce792cf4042f603507 100644
--- a/src/MNH/spawn_grid2.f90
+++ b/src/MNH/spawn_grid2.f90
@@ -147,6 +147,8 @@ END MODULE MODI_SPAWN_GRID2
!! to avoid problem when Input parameter and GRID1 parameter
!! are exactly the same !!!
!! Modification 20/05/06 Remove Clark and Farley interpolation
+!! Modification 24/02/15 (M.Moge) parallelization
+!! Modification 10/06/15 (M.Moge) bug fix for reproductibility
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -163,7 +165,8 @@ USE MODD_LBC_n, ONLY: LBC_MODEL
!
USE MODD_LUNIT_n
USE MODD_BIKHARDT_n
-!
+USE MODD_VAR_ll
+USE MODE_ll
USE MODE_FM
USE MODE_IO_ll
USE MODE_TIME
@@ -173,6 +176,7 @@ USE MODI_BIKHARDT
USE MODI_SPAWN_ZS
!
USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -190,10 +194,10 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PXHAT,PYHAT,PZHAT ! positions x,y,z in th
LOGICAL, INTENT(OUT) :: OSLEVE ! flag for SLEVE coordinate
REAL, INTENT(OUT) :: PLEN1 ! Decay scale for smooth topography
REAL, INTENT(OUT) :: PLEN2 ! Decay scale for small-scale topography deviation
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZS ! orography
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZSMT ! smooth orography
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZS_LS ! interpolated orography
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZSMT_LS ! interpolated smooth orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZS ! orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZSMT ! smooth orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZS_LS ! interpolated orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZSMT_LS ! interpolated smooth orography
!
!
TYPE (DATE_TIME), INTENT(INOUT) :: TPDTMOD ! Date and Time of MODel beginning
@@ -205,6 +209,10 @@ INTEGER :: ILUOUT ! Logical unit number for the output listing
INTEGER :: IRESP ! Return codes in FM routines
!
REAL :: ZPOND1,ZPOND2 ! interpolation coefficients
+INTEGER :: IIU_C ! Upper dimension in x direction
+INTEGER :: IJU_C ! Upper dimension in y direction
+INTEGER :: IIB_C ! indice I Beginning in x direction
+INTEGER :: IJB_C ! indice J Beginning in y direction
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
@@ -214,10 +222,23 @@ INTEGER :: IIS,IJS ! indices I and J in x and y dir. for scalars
INTEGER :: JI,JEPSX ! Loop index in x direction
INTEGER :: JJ,JEPSY ! Loop index in y direction
REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_EXTENDED, ZYHAT_EXTENDED
-INTEGER :: IXSIZE1,IYSIZE1 ! sizes of the XHAT and YHAT arrays
+INTEGER :: IXSIZE1_F,IYSIZE1_F ! sizes of the XHAT and YHAT arrays
!
CHARACTER (LEN=40) :: YTITLE ! Title for time print
-INTEGER :: IMI
+INTEGER :: IMI
+INTEGER :: IINFO_ll
+INTEGER :: IXOR_F, IYOR_F, IXEND_F, IYEND_F
+INTEGER :: IXOR_ll, IYOR_ll
+INTEGER :: IXDIM, IYDIM
+REAL, DIMENSION(1) :: PXMAX, PYMAX, PXMIN, PYMIN
+INTEGER :: DELTA_JI,JI_MIN,JI_MAX, DELTA_JJ,JJ_MIN,JJ_MAX
+REAL :: ZMIN
+INTEGER :: IDIMX_C, IDIMY_C
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXHAT_2D_EXTENDED_F, ZYHAT_2D_EXTENDED_F
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_EXTENDED_C, ZYHAT_EXTENDED_C
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXHAT_2D_C, ZYHAT_2D_C
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXHAT_2D_F, ZYHAT_2D_F
+LOGICAL :: GCYCLIC_EXTRAPOL
!-------------------------------------------------------------------------------
!
!
@@ -232,28 +253,50 @@ CALL GOTO_MODEL(2)
!
!* 1.1 computes dimensions of arrays and other indices
!
-IIU = SIZE(PXHAT)
-IJU = SIZE(PYHAT)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIU_C = SIZE(PXHAT)
+IJU_C = SIZE(PYHAT)
+IIB_C = 1+JPHEXT
+IJB_C = 1+JPHEXT
+!
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+CALL GET_FEEDBACK_COORD_ll(IXOR_F,IYOR_F,IXEND_F,IYEND_F,IINFO_ll)
+!
+CALL GO_TOMODEL_ll(1,IINFO_ll)
+CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
+CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+!
+IF (IXOR_F>0 .and. IYOR_F>0 .and. &
+ IXEND_F>0 .and. IYEND_F>0) THEN
+ IXOR_F = IXOR_F-JPHEXT
+ IYOR_F = IYOR_F-JPHEXT
+ IXEND_F= IXEND_F+JPHEXT
+ IYEND_F= IYEND_F+JPHEXT
+ELSE
+ IXOR_F = 1!4!2
+ IXEND_F= 1!4!10
+ IYOR_F = -10!4!2
+ IYEND_F= -10!4!10
+ENDIF
+!$
!
!* 1.2 recovers logical unit number of output listing
!
CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
!
!* 1.3 checks that model 2 domain is included in the one of model 1
-!
-IF ( (KXEND) > SIZE(GRID_MODEL(1)%XXHAT) ) THEN
- WRITE(ILUOUT,FMT=*) 'SPAWN_MODEL2: MODEL 2 DOMAIN OUTSIDE THE MODEL1 DOMAIN ', &
- ' KXOR = ', KXOR,' KXEND = ', KXEND, &
+IF ( (IXEND_F) > SIZE(GRID_MODEL(1)%XXHAT) ) THEN
+ WRITE(ILUOUT,FMT=*) 'SPAWN_MODEL2: MODEL 2 DOMAIN OUTSIDE THE MODEL1 DOMAIN ', &
+ ' IXOR_F = ', IXOR_F,' IXEND_F = ', IXEND_F, &
' IIU of model1 = ',SIZE(GRID_MODEL(1)%XXHAT)
!callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
CALL ABORT
STOP
END IF
-IF ( (KYEND) > SIZE(GRID_MODEL(1)%XYHAT) ) THEN
- WRITE(ILUOUT,FMT=*) 'SPAWN_MODEL2: MODEL 2 DOMAIN OUTSIDE THE MODEL1 DOMAIN ', &
- ' KYOR = ', KYOR,' KYEND = ', KYEND, &
+IF ( (IYEND_F) > SIZE(GRID_MODEL(1)%XYHAT) ) THEN
+ WRITE(ILUOUT,FMT=*) 'SPAWN_MODEL2: MODEL 2 DOMAIN OUTSIDE THE MODEL1 DOMAIN ', &
+ ' IYOR_F = ', IYOR_F,' IYEND_F = ', IYEND_F, &
' IJU of model1 = ',SIZE(GRID_MODEL(1)%XYHAT)
!callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
@@ -274,7 +317,7 @@ PLEN2 = GRID_MODEL(1)%XLEN2
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)
@@ -287,38 +330,157 @@ ELSE
!* 2.2 general case - change of resolution :
!
!* 2.2.1 linear interpolation for XHAT and YHAT
-!
- IXSIZE1=SIZE(GRID_MODEL(1)%XXHAT)
- ALLOCATE(ZXHAT_EXTENDED(IXSIZE1+1))
- ZXHAT_EXTENDED(1:IXSIZE1)=GRID_MODEL(1)%XXHAT(:)
- ZXHAT_EXTENDED(IXSIZE1+1)=2.*GRID_MODEL(1)%XXHAT(IXSIZE1)-GRID_MODEL(1)%XXHAT(IXSIZE1-1)
- DO JEPSX = 1,KDXRATIO
- ZPOND2 = FLOAT(JEPSX-1)/FLOAT(KDXRATIO)
- ZPOND1 = 1.-ZPOND2
- DO JI = KXOR,KXEND
- IIS = IIB+JEPSX-1+(JI-KXOR-JPHEXT)*KDXRATIO
-!
- IF (1 <= IIS .AND. IIS <= IIU) &
- PXHAT(IIS) = ZPOND1*ZXHAT_EXTENDED(JI) +ZPOND2*ZXHAT_EXTENDED(JI+1)
- END DO
- END DO
- DEALLOCATE(ZXHAT_EXTENDED)
-!
- IYSIZE1=SIZE(GRID_MODEL(1)%XYHAT)
- ALLOCATE(ZYHAT_EXTENDED(IYSIZE1+1))
- ZYHAT_EXTENDED(1:IYSIZE1)=GRID_MODEL(1)%XYHAT(:)
- ZYHAT_EXTENDED(IYSIZE1+1)=2.*GRID_MODEL(1)%XYHAT(IYSIZE1)-GRID_MODEL(1)%XYHAT(IYSIZE1-1)
- DO JEPSY = 1,KDYRATIO
- ZPOND2 = FLOAT(JEPSY-1)/FLOAT(KDYRATIO)
- ZPOND1 = 1.-ZPOND2
- DO JJ = KYOR,KYEND
- IJS = IJB+JEPSY-1+(JJ-KYOR-JPHEXT)*KDYRATIO
-!
- IF (1 <= IJS .AND. IJS <= IJU) &
- PYHAT(IJS) = ZPOND1*ZYHAT_EXTENDED(JJ) +ZPOND2*ZYHAT_EXTENDED(JJ+1)
- END DO
- END DO
- DEALLOCATE(ZYHAT_EXTENDED)
+ GCYCLIC_EXTRAPOL = .FALSE.
+!
+! XHAT
+!
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< spawn_grid2.f90
+ IXSIZE1_F=SIZE(GRID_MODEL(1)%XXHAT)
+ IYSIZE1_F=SIZE(GRID_MODEL(1)%XYHAT)
+! before the interpolation of XXHAT into PXHAT, we need to use LS_FORCING_ll
+! to communicate the values on the subdomains of the son grid to the appropriate processes
+! LS_FORCING_ll does not work on 1D arrays, so we have to construct a temporary pseudo-2D array
+ ALLOCATE(ZXHAT_2D_F(IXSIZE1_F,IYSIZE1_F))
+ ZXHAT_2D_F(:,:) = SPREAD(GRID_MODEL(1)%XXHAT(:),DIM=2,NCOPIES=IYSIZE1_F)
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(IMI, IDIMX_C, IDIMY_C, IINFO_ll)
+ !allocation of the 1D and pseudo-2D arrays on child grid
+ ALLOCATE(ZXHAT_EXTENDED_C(IDIMX_C+1))
+ ALLOCATE(ZXHAT_2D_C(IDIMX_C,IDIMY_C))
+ CALL SET_LSFIELD_1WAY_ll(ZXHAT_2D_F, ZXHAT_2D_C, IMI)
+ CALL LS_FORCING_ll(IMI, IINFO_ll,.TRUE.,GCYCLIC_EXTRAPOL)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ CALL GOTO_MODEL(IMI)
+ CALL UNSET_LSFIELD_1WAY_ll()
+! initialization of ZXHAT_EXTENDED_C
+! Remark : we take the 2nd row of ZXHAT_2D_C because the first one is the "pseudo halo" added for spawning
+! and may be uninitialized or an extrapolation of the second row
+ ZXHAT_EXTENDED_C(1:IDIMX_C)=ZXHAT_2D_C(:,2)
+! extrapolation on the extra point
+ ZXHAT_EXTENDED_C(IDIMX_C+1)= 2.*ZXHAT_EXTENDED_C(IDIMX_C)-ZXHAT_EXTENDED_C(IDIMX_C-1) !TODO : faire un update_nhalo1D
+! interpolation on the child grid
+ PXHAT(:)=0.
+ !on the west halo of the son model
+ DO JI = 1,JPHEXT
+ DO JEPSX=1,KDXRATIO
+ ZPOND2 = FLOAT(KDXRATIO-JEPSX)/FLOAT(KDXRATIO)
+ ZPOND1 = 1.-ZPOND2
+ IF( JPHEXT+1-(JI-1)*KDXRATIO-JEPSX > 0 ) THEN
+ PXHAT(JPHEXT+1-(JI-1)*KDXRATIO-JEPSX) = ZPOND1*ZXHAT_EXTENDED_C(JPHEXT+1-JI+1)+ ZPOND2*ZXHAT_EXTENDED_C(JPHEXT+1-JI+2)
+ ENDIF
+ ENDDO
+ ENDDO
+ !on the physical domain of the son model
+ DO JI = 1,IDIMX_C-2*(JPHEXT+1) !the physical size of the son model in the father grid
+ DO JEPSX = 1,KDXRATIO
+ ZPOND2 = FLOAT(JEPSX-1)/FLOAT(KDXRATIO)
+ ZPOND1 = 1.-ZPOND2
+ PXHAT(JPHEXT+JEPSX+(JI-1)*KDXRATIO) = ZPOND1*ZXHAT_EXTENDED_C(JI+IIB_C)+ ZPOND2*ZXHAT_EXTENDED_C(JI+IIB_C+1)
+ ENDDO
+ ENDDO
+ !on the east halo of the son model
+ DO JI = 1,JPHEXT
+ DO JEPSX=1,KDXRATIO
+ ZPOND1 = FLOAT(KDXRATIO-JEPSX+1)/FLOAT(KDXRATIO)
+ ZPOND2 = 1.-ZPOND1
+ IF( SIZE(PXHAT)-JPHEXT+(JI-1)*KDXRATIO+JEPSX <= SIZE(PXHAT) ) THEN
+ PXHAT(SIZE(PXHAT)-JPHEXT+(JI-1)*KDXRATIO+JEPSX) = ZPOND1*ZXHAT_EXTENDED_C(IDIMX_C-JPHEXT+JI-1)+ ZPOND2*ZXHAT_EXTENDED_C(IDIMX_C-JPHEXT+JI)
+ ENDIF
+ ENDDO
+ ENDDO
+ DEALLOCATE(ZXHAT_2D_F)
+ DEALLOCATE(ZXHAT_EXTENDED_C)
+ DEALLOCATE(ZXHAT_2D_C)
+!
+! YHAT
+!
+! before the interpolation of XXHAT into PXHAT, we need to use LS_FORCING_ll
+! to communicate the values on the subdomains of the son grid to the appropriate processes
+! LS_FORCING_ll does not work on 1D arrays, so we have to construct a temporary pseudo-2D array
+ ALLOCATE(ZYHAT_2D_F(IXSIZE1_F,IYSIZE1_F))
+ ZYHAT_2D_F(:,:) = SPREAD(GRID_MODEL(1)%XYHAT(:),DIM=1,NCOPIES=IXSIZE1_F)
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(IMI, IDIMX_C, IDIMY_C, IINFO_ll)
+ !allocation of the 1D and pseudo-2D arrays on child grid
+ ALLOCATE(ZYHAT_EXTENDED_C(IDIMY_C+1))
+ ALLOCATE(ZYHAT_2D_C(IDIMX_C,IDIMY_C))
+ CALL SET_LSFIELD_1WAY_ll(ZYHAT_2D_F, ZYHAT_2D_C, IMI)
+ CALL LS_FORCING_ll(IMI, IINFO_ll,.TRUE.,GCYCLIC_EXTRAPOL)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ CALL GOTO_MODEL(IMI)
+ CALL UNSET_LSFIELD_1WAY_ll()
+! initialization of ZXHAT_EXTENDED_C
+ ZYHAT_EXTENDED_C(1:IDIMY_C)=ZYHAT_2D_C(1,:)
+! extrapolation on the extra point
+ ZYHAT_EXTENDED_C(IDIMY_C+1)= 2.*ZYHAT_EXTENDED_C(IDIMY_C)-ZYHAT_EXTENDED_C(IDIMY_C-1)
+ PYHAT(:)=0.
+ !on the south halo of the son model
+ DO JJ = 1,JPHEXT
+ DO JEPSY=1,KDYRATIO
+ ZPOND2 = FLOAT(KDXRATIO-JEPSY)/FLOAT(KDYRATIO)
+ ZPOND1 = 1.-ZPOND2
+ IF( JPHEXT+1-(JJ-1)*KDYRATIO-JEPSY > 0 ) THEN
+ PYHAT(JPHEXT+1-(JJ-1)*KDYRATIO-JEPSY) = ZPOND1*ZYHAT_EXTENDED_C(JPHEXT+1-JJ+1)+ ZPOND2*ZYHAT_EXTENDED_C(JPHEXT+1-JJ+2)
+ ENDIF
+ ENDDO
+ ENDDO
+ !on the physical domain of the son model
+ DO JJ = 1,IDIMY_C-2*(JPHEXT+1) !the physical size of the son model in the father grid
+ DO JEPSY = 1,KDYRATIO
+ ZPOND2 = FLOAT(JEPSY-1)/FLOAT(KDYRATIO)
+ ZPOND1 = 1.-ZPOND2
+ PYHAT(JPHEXT+JEPSY+(JJ-1)*KDYRATIO) = ZPOND1*ZYHAT_EXTENDED_C(JJ+JPHEXT+1)+ ZPOND2*ZYHAT_EXTENDED_C(JJ+JPHEXT+1+1)
+ ENDDO
+ ENDDO
+ !on the north halo of the son model
+ DO JJ = 1,JPHEXT
+ DO JEPSY=1,KDYRATIO
+ ZPOND1 = FLOAT(KDYRATIO-JEPSY+1)/FLOAT(KDYRATIO)
+ ZPOND2 = 1.-ZPOND1
+ IF( SIZE(PYHAT)-JPHEXT+(JJ-1)*KDYRATIO+JEPSY <= SIZE(PYHAT) ) THEN
+ PYHAT(SIZE(PYHAT)-JPHEXT+(JJ-1)*KDYRATIO+JEPSY) = ZPOND1*ZYHAT_EXTENDED_C(IDIMY_C-JPHEXT+JJ-1)+ ZPOND2*ZYHAT_EXTENDED_C(IDIMY_C-JPHEXT+JJ)
+ ENDIF
+ ENDDO
+ ENDDO
+ DEALLOCATE(ZYHAT_2D_F)
+ DEALLOCATE(ZYHAT_EXTENDED_C)
+ DEALLOCATE(ZYHAT_2D_C)
+!!$=======
+!!$ IXSIZE1=SIZE(GRID_MODEL(1)%XXHAT)
+!!$ ALLOCATE(ZXHAT_EXTENDED(IXSIZE1+1))
+!!$ ZXHAT_EXTENDED(1:IXSIZE1)=GRID_MODEL(1)%XXHAT(:)
+!!$ ZXHAT_EXTENDED(IXSIZE1+1)=2.*GRID_MODEL(1)%XXHAT(IXSIZE1)-GRID_MODEL(1)%XXHAT(IXSIZE1-1)
+!!$ DO JEPSX = 1,KDXRATIO
+!!$ ZPOND2 = FLOAT(JEPSX-1)/FLOAT(KDXRATIO)
+!!$ ZPOND1 = 1.-ZPOND2
+!!$ DO JI = KXOR,KXEND
+!!$ IIS = IIB+JEPSX-1+(JI-KXOR-JPHEXT)*KDXRATIO
+!!$!
+!!$ IF (1 <= IIS .AND. IIS <= IIU) &
+!!$ PXHAT(IIS) = ZPOND1*ZXHAT_EXTENDED(JI) +ZPOND2*ZXHAT_EXTENDED(JI+1)
+!!$ END DO
+!!$ END DO
+!!$ DEALLOCATE(ZXHAT_EXTENDED)
+!!$!
+!!$ IYSIZE1=SIZE(GRID_MODEL(1)%XYHAT)
+!!$ ALLOCATE(ZYHAT_EXTENDED(IYSIZE1+1))
+!!$ ZYHAT_EXTENDED(1:IYSIZE1)=GRID_MODEL(1)%XYHAT(:)
+!!$ ZYHAT_EXTENDED(IYSIZE1+1)=2.*GRID_MODEL(1)%XYHAT(IYSIZE1)-GRID_MODEL(1)%XYHAT(IYSIZE1-1)
+!!$ DO JEPSY = 1,KDYRATIO
+!!$ ZPOND2 = FLOAT(JEPSY-1)/FLOAT(KDYRATIO)
+!!$ ZPOND1 = 1.-ZPOND2
+!!$ DO JJ = KYOR,KYEND
+!!$ IJS = IJB+JEPSY-1+(JJ-KYOR-JPHEXT)*KDYRATIO
+!!$!
+!!$ IF (1 <= IJS .AND. IJS <= IJU) &
+!!$ PYHAT(IJS) = ZPOND1*ZYHAT_EXTENDED(JJ) +ZPOND2*ZYHAT_EXTENDED(JJ+1)
+!!$ END DO
+!!$ END DO
+!!$ DEALLOCATE(ZYHAT_EXTENDED)
+!!$>>>>>>> 1.3.4.2.18.2.2.1
!
!
!* 2.2.2 interpolation of ZS performed later
@@ -332,12 +494,14 @@ PLATOR = XLATORI
!
!* 3. INITIALIZATION OF ZS and ZSMT:
! ------------------------------
-!
-CALL SPAWN_ZS(KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,CLUOUT, &
+CALL SPAWN_ZS(IXOR_F,IXEND_F,IYOR_F,IYEND_F,KDXRATIO,KDYRATIO,IDIMX_C,IDIMY_C,LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,CLUOUT, &
GRID_MODEL(1)%XZS, PZS, 'ZS ',PZS_LS)
-CALL SPAWN_ZS(KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,CLUOUT, &
+CALL SPAWN_ZS(IXOR_F,IXEND_F,IYOR_F,IYEND_F,KDXRATIO,KDYRATIO,IDIMX_C,IDIMY_C,LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,CLUOUT, &
GRID_MODEL(1)%XZSMT,PZSMT,'ZSMT ',PZSMT_LS)
!
+CALL MPPDB_CHECK2D(PZS,"SPAWN_GRID2:PZS",PRECISION)
+CALL MPPDB_CHECK2D(PZSMT,"SPAWN_GRID2:PZSMT",PRECISION)
+!$
!-------------------------------------------------------------------------------
!
!* 4. INITIALIZATION OF MODEL 2 DATE AND TIME:
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index 7247739316c51d6199e0f2aaa0c860cdde2d83dc..e7bb19e6b608588df86d4bb566a1df5227b95aa5 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -184,6 +184,7 @@ END MODULE MODI_SPAWN_MODEL2
!! 24/04/2014 (J.escobar) bypass CRAY internal compiler error on IIJ computation
!! Modification 06/2014 (C.Lac) Initialization of physical param of
!! model2 before the call to ini_nsv
+!! Modification 05/02/2015 (M.Moge) parallelization of SPAWNING
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -220,7 +221,9 @@ USE MODD_TURB_n
USE MODD_METRICS_n
USE MODD_CH_MNHC_n
USE MODD_PASPOL_n
-!
+!$20140515
+USE MODD_VAR_ll, ONLY : NPROC
+!USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
!
USE MODE_GRIDCART ! Executive modules
USE MODE_GRIDPROJ
@@ -244,11 +247,14 @@ USE MODI_DEALLOCATE_MODEL1
USE MODI_BOUNDARIES
USE MODI_INI_NSV
USE MODI_CH_INIT_SCHEME_n
+!$20140710
+USE MODI_UPDATE_METRICS
!
USE MODE_FM
USE MODE_IO_ll
USE MODE_MODELN_HANDLER
USE MODE_FMREAD
+USE MODE_MPPDB
!
USE MODE_THERMO
!
@@ -266,6 +272,10 @@ USE MODD_ADVFRC_n
USE MODD_RELFRC_n
USE MODD_2D_FRC
!
+USE MODE_LB_ll, ONLY : SET_LB_FIELD_ll
+USE MODI_GET_SIZEX_LB
+USE MODI_GET_SIZEY_LB
+!
IMPLICIT NONE
!
!* 0.1.1 Declarations of global variables not declared in the modules :
@@ -355,7 +365,18 @@ INTEGER :: IJE1 ! indice J End in y direction
LOGICAL :: GNOSON = .TRUE.
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! working array
CHARACTER(LEN=28) :: YDAD_SON
-INTEGER,DIMENSION(:,:),ALLOCATABLE :: IJCOUNT
+!$
+INTEGER :: IDIMX, IDIMY
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+INTEGER :: NXOR_TMP, NYOR_TMP, NXEND_TMP, NYEND_TMP
+INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
+INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
+INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
+INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
+!
+CHARACTER(LEN=4) :: YLBTYPE
+!
!-------------------------------------------------------------------------------
!
! Save model index and switch to model 2 variables
@@ -406,8 +427,6 @@ CALL DEALLOCATE_MODEL1(2)
!
NIMAX_ll = NXSIZE * NDXRATIO
NJMAX_ll = NYSIZE * NDYRATIO
-NIMAX=NIMAX_ll !! coding for one processor
-NJMAX=NJMAX_ll
!
IF (NIMAX_ll==1 .AND. NJMAX_ll==1) THEN
L1D=.TRUE.
@@ -423,6 +442,9 @@ END IF
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
+NIMAX = IIE-IIB+1
+NJMAX = IJE-IJB+1
+!$
IKU = SIZE(XTHVREFZ,1)
NKMAX = IKU - 2*JPVEXT ! initialization of NKMAX (MODD_DIM2)
!
@@ -432,24 +454,28 @@ IKE = IKU - JPVEXT
!
!* 3.2 Position of model 2 domain relative to model 1 and controls
!
-!
-IF ( (NXSIZE*NDXRATIO) /= (IIE-IIB+1) ) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN X-SIZE INCOHERENT WITH THE', &
- ' MODEL1 MESH ',' IIB = ',IIB,' IIE = ', IIE ,'NDXRATIO = ',NDXRATIO
- !callabortstop
- CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
- CALL ABORT
- STOP
-END IF
-!
-IF ( (NYSIZE*NDYRATIO) /= (IJE-IJB+1) ) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN Y-SIZE INCOHERENT WITH THE', &
- ' MODEL1 MESH ',' IJB = ',IJB,' IJE = ', IJE ,'NDYRATIO = ',NDYRATIO
- !callabortstop
- CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
- CALL ABORT
- STOP
-END IF
+!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
+!$then cancel it
+!IF ( (NXSIZE*NDXRATIO) /= (IIE-IIB+1) ) THEN
+! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN X-SIZE INCOHERENT WITH THE', &
+! ' MODEL1 MESH ',' IIB = ',IIB,' IIE = ', IIE ,'NDXRATIO = ',NDXRATIO
+! !callabortstop
+! CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
+! CALL ABORT
+! STOP
+!END IF
+!$
+!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
+!$then cancel it
+!IF ( (NYSIZE*NDYRATIO) /= (IJE-IJB+1) ) THEN
+! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN Y-SIZE INCOHERENT WITH THE', &
+! ' MODEL1 MESH ',' IJB = ',IJB,' IJE = ', IJE ,'NDYRATIO = ',NDYRATIO
+! !callabortstop
+! CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
+! CALL ABORT
+! STOP
+!END IF
+!$
!
!* 3.3 Treatement of a SON 1 model (input)
!
@@ -591,6 +617,12 @@ IF ( .NOT. L2D ) THEN
ELSE
NRIMY=0
END IF
+IF (NRIMX == IIU/2-1) THEN ! Error ! this case is not supported - it should be, but there is a bug
+ WRITE(*,*) "Error : The size of the LB zone is too big for the size of the subdomains"
+ WRITE(*,*) "Try with less cores, a smaller LB size, or a bigger grid"
+ CALL ABORT
+ STOP
+ENDIF
!
LHORELAX_UVWTH=.TRUE.
LHORELAX_RV=LUSERV
@@ -687,82 +719,110 @@ ALLOCATE(XLSUM(IIU,IJU,IKU))
ALLOCATE(XLSVM(IIU,IJU,IKU))
ALLOCATE(XLSWM(IIU,IJU,IKU))
ALLOCATE(XLSTHM(IIU,IJU,IKU))
-IF ( NRR >= 1) ALLOCATE(XLSRVM(IIU,IJU,IKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(IIU,IJU,IKU))
+ENDIF
! LB fields for lbc coupling
-ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,IJU,IKU))
+!
+!get the size of the local portion of the LB zone in X and Y direction
+CALL GET_SIZEX_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+CALL GET_SIZEY_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMY, &
+ IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
+ IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
+!on fait des choses inutiles avec GET_SIZEX_LB, on pourrait utiliser seulement GET_LOCAL_LB_SIZE_X_ll
+!ILOCLBSIZEX = GET_LOCAL_LB_SIZE_X_ll( NRIMX )
+!ILOCLBSIZEY = GET_LOCAL_LB_SIZE_Y_ll( NRIMY )
+!
+ ALLOCATE(XLBXUM(IISIZEXFU,IJU,IKU))
+!! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,IJU,IKU))
!
IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYUM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ ALLOCATE(XLBYUM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYUM(IIU,2*NRIMY+2*JPHEXT,IKU))
ELSE
ALLOCATE(XLBYUM(0,0,0))
END IF
!
-ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,IJU,IKU))
+ALLOCATE(XLBXVM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,IJU,IKU))
!
IF ( .NOT. L2D ) THEN
IF ( NRIMY == 0 ) THEN
- ALLOCATE(XLBYVM(IIU,4,IKU))
+ ALLOCATE(XLBYVM(IIU,IJSIZEY4,IKU))
ELSE
- ALLOCATE(XLBYVM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ ALLOCATE(XLBYVM(IIU,IJSIZEYFV,IKU))
+!! ALLOCATE(XLBYVM(IIU,2*NRIMY+2*JPHEXT,IKU))
END IF
ELSE
ALLOCATE(XLBYVM(0,0,0))
END IF
!
-ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,IJU,IKU))
+ALLOCATE(XLBXWM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,IJU,IKU))
!
IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYWM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ ALLOCATE(XLBYWM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYWM(IIU,2*NRIMY+2*JPHEXT,IKU))
ELSE
ALLOCATE(XLBYWM(0,0,0))
END IF
!
-ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,IJU,IKU))
+ALLOCATE(XLBXTHM(IISIZEXF,IJU,IKU))
+!!ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,IJU,IKU))
!
IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYTHM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ ALLOCATE(XLBYTHM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYTHM(IIU,2*NRIMY+2*JPHEXT,IKU))
ELSE
ALLOCATE(XLBYTHM(0,0,0))
END IF
!
IF (CTURB /= 'NONE') THEN
- ALLOCATE(XLBXTKEM(2*NRIMX+2*JPHEXT,IJU,IKU))
+ ALLOCATE(XLBXTKEM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXTKEM(2*NRIMX+2*JPHEXT,IJU,IKU))
ELSE
ALLOCATE(XLBXTKEM(0,0,0))
END IF
!
IF (CTURB /= 'NONE' .AND. (.NOT. L2D)) THEN
- ALLOCATE(XLBYTKEM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ ALLOCATE(XLBYTKEM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYTKEM(IIU,2*NRIMY+2*JPHEXT,IKU))
ELSE
ALLOCATE(XLBYTKEM(0,0,0))
END IF
!
-ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,IJU,IKU,NRR))
+ALLOCATE(XLBXRM(IISIZEXF,IJU,IKU,NRR))
+!!ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,IJU,IKU,NRR))
!
IF (.NOT. L2D ) THEN
- ALLOCATE(XLBYRM(IIU,2*NRIMY+2*JPHEXT,IKU,NRR))
+ ALLOCATE(XLBYRM(IIU,IJSIZEYF,IKU,NRR))
+!! ALLOCATE(XLBYRM(IIU,2*NRIMY+2*JPHEXT,IKU,NRR))
ELSE
ALLOCATE(XLBYRM(0,0,0,0))
END IF
!
-ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,IJU,IKU,NSV))
+ALLOCATE(XLBXSVM(IISIZEXF,IJU,IKU,NSV))
+!!ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,IJU,IKU,NSV))
!
IF (.NOT. L2D ) THEN
- ALLOCATE(XLBYSVM(IIU,2*NRIMY+2*JPHEXT,IKU,NSV))
+ ALLOCATE(XLBYSVM(IIU,IJSIZEYF,IKU,NSV))
+!! ALLOCATE(XLBYSVM(IIU,2*NRIMY+2*JPHEXT,IKU,NSV))
ELSE
ALLOCATE(XLBYSVM(0,0,0,0))
END IF
!
-NSIZELBX_ll=SIZE(XLBXWM,1)
-NSIZELBXU_ll=SIZE(XLBXUM,1)
-NSIZELBY_ll=SIZE(XLBYWM,2)
-NSIZELBYV_ll=SIZE(XLBYVM,2)
-NSIZELBXR_ll=SIZE(XLBXRM,1) !! coding for one processor
-NSIZELBXSV_ll=SIZE(XLBXSVM,1)
-NSIZELBXTKE_ll=SIZE(XLBXTKEM,1)
-NSIZELBYTKE_ll=SIZE(XLBYTKEM,2)
-NSIZELBYR_ll=SIZE(XLBYRM,2)
-NSIZELBYSV_ll=SIZE(XLBYSVM,2)
+NSIZELBX_ll=2*NRIMX+2*JPHEXT
+NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+NSIZELBY_ll=2*NRIMY+2*JPHEXT
+NSIZELBYV_ll=2*NRIMY+2*JPHEXT
+NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT
+NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT
+NSIZELBYR_ll=2*NRIMY+2*JPHEXT
+NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
!
!
! 4.8 precipitation variables ! same allocations than in ini_micron
@@ -920,10 +980,25 @@ ZMISC = ZTIME2 - ZTIME1
!
CALL SECOND_MNH(ZTIME1)
!
+IF(NPROC.GT.1)THEN
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GET_FEEDBACK_COORD_ll(NXOR_TMP,NYOR_TMP,NXEND_TMP,NYEND_TMP,IINFO_ll) !phys domain
+ELSE
+ NXOR_TMP = NXOR
+ NYOR_TMP = NYOR
+ NXEND_TMP= NXEND
+ NYEND_TMP = NYEND
+ENDIF
+XZS=0.
CALL SPAWN_GRID2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
XLONORI,XLATORI,XXHAT,XYHAT,XZHAT,LSLEVE,XLEN1,XLEN2, &
XZS,XZSMT,ZZS_LS,ZZSMT_LS,TDTMOD,TDTCUR )
!
+CALL MPPDB_CHECK2D(ZZS_LS,"SPAWN_MOD2:ZZS_LS",PRECISION)
+CALL MPPDB_CHECK2D(ZZSMT_LS,"SPAWN_MOD2:ZZSMT_LS",PRECISION)
+CALL MPPDB_CHECK2D(XZS,"SPAWN_MOD2:XZS",PRECISION)
+CALL MPPDB_CHECK2D(XZSMT,"SPAWN_MOD2:XZSMT",PRECISION)
+!
CALL SECOND_MNH(ZTIME2)
!
ZGRID2 = ZTIME2 - ZTIME1
@@ -944,8 +1019,24 @@ END IF
!
!* 5.4 Compute the metric coefficients
!
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XZZ)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
!
+CALL MPPDB_CHECK3D(XDXX,"spawnmod2-beforeupdate_metrics:XDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"spawnmod2-beforeupdate_metrics:XDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"spawnmod2-beforeupdate_metrics:XDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"spawnmod2-beforeupdate_metrics:XDZY",PRECISION)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL MPPDB_CHECK3D(XDXX,"spawnmod2-aftrupdate_metrics:XDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"spawnmod2-aftrupdate_metrics:XDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"spawnmod2-aftrupdate_metrics:XDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"spawnmod2-aftrupdate_metrics:XDZY",PRECISION)
+!$
!
!* 5.5 3D Reference state variables :
!
@@ -967,6 +1058,7 @@ ZTIME1 = ZTIME2
ALLOCATE(ZTHVT(IIU,IJU,IKU))
ALLOCATE(ZHUT(IIU,IJU,IKU))
!
+MPPDB_CHECK_LB = .TRUE.
IF (GNOSON) THEN
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
@@ -974,7 +1066,9 @@ IF (GNOSON) THEN
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
XVU_FLUX_M,XVTH_FLUX_M,XWTH_FLUX_M )
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
ELSE
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before SPAWN_FIELD2:XUT",PRECISION)
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
XSRCT,XSIGS, &
@@ -984,8 +1078,12 @@ ELSE
HSONFILE,IIUSON,IJUSON, &
IIB2,IJB2,IIE2,IJE2, &
IIB1,IJB1,IIE1,IJE1 )
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
END IF
!
+CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2aftFIELD2:XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2aftFIELD2:XVT",PRECISION)
+!$
!* correction of positivity
!
IF (SIZE(XLSRVM,1)>0) XLSRVM = MAX(0.,XLSRVM)
@@ -1002,10 +1100,18 @@ ZTIME1 = ZTIME2
!* vertical interpolation
!
IF (ANY(XZS(:,:)>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) ) THEN
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before VER_INTERP_FIELD:XUT",PRECISION)
CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ, &
XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT, &
XSRCT,XSIGS, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM )
+ !
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2aftVERINTER:XUT",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"SPAWN_M2aftVERINTER:XVT",PRECISION)
+ CALL MPPDB_CHECK3D(XWT,"SPAWN_M2aftVERINTER:XWT",PRECISION)
+ CALL MPPDB_CHECK3D(ZHUT,"SPAWN_M2aftVERINTER:ZHUT",PRECISION)
+ CALL MPPDB_CHECK3D(XTKET,"SPAWN_M2aftVERINTER:XTKET",PRECISION)
+ CALL MPPDB_CHECK3D(XSRCT,"SPAWN_M2aftVERINTER:XSRCT",PRECISION)
ENDIF
!
CALL SECOND_MNH(ZTIME2)
@@ -1027,12 +1133,11 @@ IF (.NOT.GNOSON) THEN
END IF
!
IF (NVERB>=2) THEN
- ALLOCATE(IJCOUNT(IIU,IJU))
- IK4000 = COUNT(XZHAT(:)<4000.)
- IJCOUNT(IIB:IIE,IJB:IJE) = COUNT((ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
- >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01),DIM=3 )
- IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
- MASK= ( IJCOUNT(IIB:IIE,IJB:IJE) >=1 ) ) &
+ IK4000 = COUNT(XZHAT(:)<4000.)
+ IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
+ MASK=COUNT(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
+ >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
+ >=1 ) &
+ JPHEXT
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) 'humidity (I=',IIJ(1),';J=',IIJ(2),')'
@@ -1057,6 +1162,7 @@ ELSE
ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
END DO
XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
+ CALL MPPDB_CHECK3D(XTHT,"SPAWN_MOD2:XTHT",PRECISION)
END IF
!
DEALLOCATE (ZHUT)
@@ -1067,85 +1173,119 @@ ZPRESSURE2=ZTIME2-ZTIME1
!* 5.9 Large Scale field for lbc treatment:
!
!
-!* 5.9.1 U variable
-!
-!
-!
-XLBXUM(1:NRIMX+JPHEXT,:,:) = XUT(2:NRIMX+JPHEXT+1,:,:)
-XLBXUM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XUT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-IF( .NOT. L2D ) THEN
- XLBYUM(:,1:NRIMY+JPHEXT,:) = XUT(:,1:NRIMY+JPHEXT,:)
- XLBYUM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XUT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-END IF
-!
-!* 5.9.2 V variable
-!
-!
-XLBXVM(1:NRIMX+JPHEXT,:,:) = XVT(1:NRIMX+JPHEXT,:,:)
-XLBXVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XVT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-IF( .NOT. L2D ) THEN
- XLBYVM(:,1:NRIMY+JPHEXT,:) = XVT(:,2:NRIMY+JPHEXT+1,:)
- XLBYVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XVT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-END IF
-!
-!* 5.9.3 W variable
-!
-!
-XLBXWM(1:NRIMX+JPHEXT,:,:) = XWT(1:NRIMX+JPHEXT,:,:)
-XLBXWM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XWT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-IF( .NOT. L2D ) THEN
- XLBYWM(:,1:NRIMY+JPHEXT,:) = XWT(:,1:NRIMY+JPHEXT,:)
- XLBYWM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XWT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-END IF
-!
-!* 5.9.4 TH variable
-!
-!
-XLBXTHM(1:NRIMX+JPHEXT,:,:) = XTHT(1:NRIMX+JPHEXT,:,:)
-XLBXTHM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTHT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-IF( .NOT. L2D ) THEN
- XLBYTHM(:,1:NRIMY+JPHEXT,:) = XTHT(:,1:NRIMY+JPHEXT,:)
- XLBYTHM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTHT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-END IF
-!
-!* 5.9.5 TKE variable
-!
-!
-IF (HTURB /= 'NONE') THEN
- XLBXTKEM(1:NRIMX+JPHEXT,:,:) = XTKET(1:NRIMX+JPHEXT,:,:)
- XLBXTKEM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTKET(IIE+1-NRIMX:IIE+JPHEXT,:,:)
- IF( .NOT. L2D ) THEN
- XLBYTKEM(:,1:NRIMY+JPHEXT,:) = XTKET(:,1:NRIMY+JPHEXT,:)
- XLBYTKEM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTKET(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!* 5.9.1 West-East LB zones
+!
+!
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< spawn_model2.f90
+ MPPDB_CHECK_LB = .TRUE.
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2 before lbc treatment:XUT",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2 before lbc treatment:XVT",PRECISION)
+ MPPDB_CHECK_LB = .FALSE.
+ YLBTYPE = 'LBU'
+ CALL SET_LB_FIELD_ll( YLBTYPE, XUT, XLBXUM, XLBYUM, IIB, IJB, IIE, IJE, 1, 0, 0, 0 )
+ ! copy XUT(IIB:IIB+NRIMX,:,:) instead of XUT(IIB-1:IIB-1+NRIMX,:,:) in XLBXUM
+ CALL SET_LB_FIELD_ll( YLBTYPE, XVT, XLBXVM, XLBYVM, IIB, IJB, IIE, IJE, 0, 0, 1, 0 )
+ ! copy XVT(:,IJB:IJB+NRIMY,:) instead of XVT(:,IJB-1:IJB-1+NRIMY,:) in XLBYVM
+ CALL SET_LB_FIELD_ll( YLBTYPE, XWT, XLBXWM, XLBYWM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ CALL SET_LB_FIELD_ll( YLBTYPE, XTHT, XLBXTHM, XLBYTHM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ IF (HTURB /= 'NONE') THEN
+ CALL SET_LB_FIELD_ll( YLBTYPE, XTKET, XLBXTKEM, XLBYTKEM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ ENDIF
+ IF (NRR >= 1) THEN
+ DO JRR =1,NRR
+ CALL SET_LB_FIELD_ll( YLBTYPE, XRT(:,:,:,JRR), XLBXRM(:,:,:,JRR), XLBYRM(:,:,:,JRR), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ END DO
+ END IF
+ IF (NSV /= 0) THEN
+ DO JSV = 1, NSV
+ CALL SET_LB_FIELD_ll( YLBTYPE, XSVT(:,:,:,JSV), XLBXSVM(:,:,:,JSV), XLBYSVM(:,:,:,JSV), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ END DO
+!!$=======
+!!$!
+!!$XLBXUM(1:NRIMX+JPHEXT,:,:) = XUT(2:NRIMX+JPHEXT+1,:,:)
+!!$XLBXUM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XUT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYUM(:,1:NRIMY+JPHEXT,:) = XUT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYUM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XUT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.2 V variable
+!!$!
+!!$!
+!!$XLBXVM(1:NRIMX+JPHEXT,:,:) = XVT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XVT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYVM(:,1:NRIMY+JPHEXT,:) = XVT(:,2:NRIMY+JPHEXT+1,:)
+!!$ XLBYVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XVT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.3 W variable
+!!$!
+!!$!
+!!$XLBXWM(1:NRIMX+JPHEXT,:,:) = XWT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXWM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XWT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYWM(:,1:NRIMY+JPHEXT,:) = XWT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYWM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XWT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.4 TH variable
+!!$!
+!!$!
+!!$XLBXTHM(1:NRIMX+JPHEXT,:,:) = XTHT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXTHM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTHT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYTHM(:,1:NRIMY+JPHEXT,:) = XTHT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYTHM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTHT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.5 TKE variable
+!!$!
+!!$!
+!!$IF (HTURB /= 'NONE') THEN
+!!$ XLBXTKEM(1:NRIMX+JPHEXT,:,:) = XTKET(1:NRIMX+JPHEXT,:,:)
+!!$ XLBXTKEM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTKET(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYTKEM(:,1:NRIMY+JPHEXT,:) = XTKET(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYTKEM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTKET(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
END IF
-ENDIF
-!
-!
-!* 5.9.6 moist variables
-!
-IF (NRR >= 1) THEN
- DO JRR =1,NRR
- XLBXRM(1:NRIMX+JPHEXT,:,:,JRR) = XRT(1:NRIMX+JPHEXT,:,:,JRR)
- XLBXRM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JRR)
- IF( .NOT. L2D ) THEN
- XLBYRM(:,1:NRIMY+JPHEXT,:,JRR) = XRT(:,1:NRIMY+JPHEXT,:,JRR)
- XLBYRM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JRR)
- END IF
- END DO
-END IF
-!
-!* 5.9.7 scalar variables
!
-IF (NSV /= 0) THEN
- DO JSV = 1, NSV
- XLBXSVM(1:NRIMX+JPHEXT,:,:,JSV) = XSVT(1:NRIMX+JPHEXT,:,:,JSV)
- XLBXSVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JSV)
- IF( .NOT. L2D ) THEN
- XLBYSVM(:,1:NRIMY+JPHEXT,:,JSV) = XSVT(:,1:NRIMY+JPHEXT,:,JSV)
- XLBYSVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JSV)
- END IF
- END DO
-ENDIF
+! <<<<<<< spawn_model2.f90
+ CALL MPPDB_CHECKLB(XLBXUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBXVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXVM",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBXWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXWM",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBYUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYUM",PRECISION,'LBYV',NRIMY)
+ CALL MPPDB_CHECKLB(XLBYVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYVM",PRECISION,'LBYV',NRIMY)
+ CALL MPPDB_CHECKLB(XLBYWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYWM",PRECISION,'LBYV',NRIMY)
+!!$=======
+!!$!* 5.9.6 moist variables
+!!$!
+!!$IF (NRR >= 1) THEN
+!!$ DO JRR =1,NRR
+!!$ XLBXRM(1:NRIMX+JPHEXT,:,:,JRR) = XRT(1:NRIMX+JPHEXT,:,:,JRR)
+!!$ XLBXRM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JRR)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYRM(:,1:NRIMY+JPHEXT,:,JRR) = XRT(:,1:NRIMY+JPHEXT,:,JRR)
+!!$ XLBYRM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JRR)
+!!$ END IF
+!!$ END DO
+!!$END IF
+!!$!
+!!$!* 5.9.7 scalar variables
+!!$!
+!!$IF (NSV /= 0) THEN
+!!$ DO JSV = 1, NSV
+!!$ XLBXSVM(1:NRIMX+JPHEXT,:,:,JSV) = XSVT(1:NRIMX+JPHEXT,:,:,JSV)
+!!$ XLBXSVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JSV)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYSVM(:,1:NRIMY+JPHEXT,:,JSV) = XSVT(:,1:NRIMY+JPHEXT,:,JSV)
+!!$ XLBYSVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JSV)
+!!$ END IF
+!!$ END DO
+!!$ENDIF
+!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
!
!* 5.10 Surface precipitation computation
!
@@ -1171,6 +1311,11 @@ ZTIME1 = ZTIME2
ALLOCATE(ZRHOD(IIU,IJU,IKU))
ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
/(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+!$20140709
+ CALL MPPDB_CHECK3D(ZRHOD,"SPAWN_MOD2:ZRHOD",PRECISION)
+ CALL MPPDB_CHECK3D(XPABST,"SPAWN_MOD2:XPABST",PRECISION)
+ CALL MPPDB_CHECK3D(ZSUMRT,"SPAWN_MOD2:ZSUMRT",PRECISION)
+!$20140710 until here all ok after UPHALO(XZZ)
!
CALL TOTAL_DMASS(CLUOUT,ZJ,ZRHOD,XDRYMASST)
!
diff --git a/src/MNH/spawn_pressure2.f90 b/src/MNH/spawn_pressure2.f90
index c22f000bfa7f19434a7be7eaa227895cee715ac4..afc88db334519f191b7af38171bbcce3b3e48a6f 100644
--- a/src/MNH/spawn_pressure2.f90
+++ b/src/MNH/spawn_pressure2.f90
@@ -104,6 +104,8 @@ END MODULE MODI_SPAWN_PRESSURE2
!! Original 10/07/97
!! 14/09/97 (V. Masson) use of thv as dummy argument
!! Modification 20/05/06 Remove Clark and Farley interpolation
+!! 2014 (M.Faivre) parallelization
+!! 10/02/15 (M.Moge) correction of M.Faivre's parallelization attempt
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -130,6 +132,8 @@ USE MODI_COEF_VER_INTERP_LIN
USE MODI_VER_INTERP_LIN
!
USE MODE_MODELN_HANDLER
+USE MODE_ll
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -165,6 +169,10 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: & ! MODEL 1 VARIABLES
ZSUMR ! sum of water mixing ratios (at t-dt or t)
REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XTHT,1),SIZE(FIELD_MODEL(1)%XTHT,2)) :: & ! MODEL 1 VARIABLES
ZHYDEXNTOP1 ! model top Exner functions at t or t-dt
+!$20140709
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZHYDEXNTOP1_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHYDEXN1_C
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN1_C
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: & ! MODEL 2 VARIABLES
ZGRIDA, & ! mass point altitudes with purely interpoled orography
@@ -177,6 +185,8 @@ REAL, DIMENSION(SIZE(PTHVT,1),SIZE(PTHVT,2)) :: & ! MODEL 2 VARIABLES
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK
INTEGER :: IMI
+INTEGER :: JI, IDIMX_C,IDIMY_C
+INTEGER :: IINFO_ll
!
!-------------------------------------------------------------------------------
!
@@ -262,14 +272,54 @@ END IF
!
DEALLOCATE(ZTHV1)
DEALLOCATE(ZWORK)
+ !
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
+ ! 2D
+ ALLOCATE(ZHYDEXNTOP1_C(IDIMX_C,IDIMY_C))
+ ZHYDEXNTOP1_C=0.
+ ! 3D
+ ALLOCATE(ZHYDEXN1_C(IDIMX_C,IDIMY_C,SIZE(ZHYDEXN1,3)))
+ ALLOCATE(ZEXN1_C(IDIMX_C,IDIMY_C,SIZE(ZEXN1,3)))
+ ZHYDEXN1_C =0.
+ ZEXN1_C =0.
+ !
+ CALL SET_LSFIELD_1WAY_ll(ZHYDEXNTOP1,ZHYDEXNTOP1_C,2)
+ !
+ CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ CALL UNSET_LSFIELD_1WAY_ll()
+ ! 3D
+ DO JI=1,SIZE(ZEXN1,3)
+ CALL GOTO_MODEL(1)
+ CALL GO_TOMODEL_ll(1, IINFO_ll)
+ !
+ CALL SET_LSFIELD_1WAY_ll(ZHYDEXN1(:,:,JI),ZHYDEXN1_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(ZEXN1(:,:,JI),ZEXN1_C(:,:,JI),2)
+ !
+ CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ CALL UNSET_LSFIELD_1WAY_ll()
+ ENDDO
+!
+!if the child grid is the whole father grid, we first need to extrapolate
+!the data on a "pseudo halo" before doing BIKHARDT interpolation
+! CALL EXTRAPOL_ON_PSEUDO_HALO(ZHYDEXNTOP1_C)
+! CALL EXTRAPOL_ON_PSEUDO_HALO(ZHYDEXN1_C)
+! CALL EXTRAPOL_ON_PSEUDO_HALO(ZEXN1_C)
!
!* 2.4 model top Exner function interpolation
! --------------------------------------
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,4, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHYDEXNTOP1,ZHYDEXNTOP2)
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHYDEXNTOP1_C,ZHYDEXNTOP2)
+ CALL MPPDB_CHECK2D(ZHYDEXNTOP2,"SPAWN_PRESS2:ZHYDEXNTOP2",PRECISION)
+!
!
!* 2.5 interpolation of pi-hyd pi
! --------------------------
@@ -278,11 +328,16 @@ END IF
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZEXN1(:,:,:)-ZHYDEXN1(:,:,:),ZEXNMHEXN2)
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
+ ZEXN1_C-ZHYDEXN1_C,ZEXNMHEXN2)
+ CALL MPPDB_CHECK3D(ZEXNMHEXN2,"SPAWN_PRESS2:ZEXNMHEXN2",PRECISION)
!
DEALLOCATE(ZEXN1)
DEALLOCATE(ZHYDEXN1)
+ DEALLOCATE(ZEXN1_C)
+ DEALLOCATE(ZHYDEXN1_C)
+ DEALLOCATE(ZHYDEXNTOP1_C)
!
!* vertical interpolation
!
diff --git a/src/MNH/spawn_surf2_rain.f90 b/src/MNH/spawn_surf2_rain.f90
index f780a1ff73669122a459c0cc833de864a767f376..a3b6b3f5439001fdabd419916149c1ccaba8853f 100644
--- a/src/MNH/spawn_surf2_rain.f90
+++ b/src/MNH/spawn_surf2_rain.f90
@@ -106,6 +106,7 @@ END MODULE MODI_SPAWN_SURF2_RAIN
!! Original 19/07/04 after surface externalisation
!! Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
!! Modification 20/05/06 Remove Clark and Farley interpolation
+!! Modification 2014 (M.Faivre)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/spawn_zs.f90 b/src/MNH/spawn_zs.f90
index c249a3d95bbad3bd64a7d8e982a381e7da62dfc1..bc65fcc59212221391c4eb521b8fc89ea3ce4122 100644
--- a/src/MNH/spawn_zs.f90
+++ b/src/MNH/spawn_zs.f90
@@ -13,17 +13,19 @@ MODULE MODI_SPAWN_ZS
!
INTERFACE
!
- SUBROUTINE SPAWN_ZS (KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,HLBCX,HLBCY,&
- HLUOUT,PZS1,PZS2,HFIELD,PZS2_LS )
+ SUBROUTINE SPAWN_ZS (KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,KDIMX_C,KDIMY_C,HLBCX,HLBCY,&
+ HLUOUT,PZS1_F,PZS2_C,HFIELD,PZS2_LS )
!
INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin and END
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
+INTEGER, INTENT(IN) :: KDIMX_C ! dimension (X dir) of local son subdomain in father grid
+INTEGER, INTENT(IN) :: KDIMY_C ! dimension (Y dir) of local son subdomain in father grid
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output-listing file
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS1 ! model 1 orography
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZS2 ! interpolated orography with iterative correction
+REAL, DIMENSION(:,:), INTENT(IN) :: PZS1_F ! model 1 orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZS2_C ! interpolated orography with iterative correction
CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to nest
REAL, DIMENSION(:,:), INTENT(OUT),OPTIONAL :: PZS2_LS ! interpolated orography
!
@@ -35,8 +37,8 @@ END MODULE MODI_SPAWN_ZS
!
!
! #########################################################################
- SUBROUTINE SPAWN_ZS (KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,HLBCX,HLBCY,&
- HLUOUT,PZS1,PZS2,HFIELD,PZS2_LS )
+ SUBROUTINE SPAWN_ZS (KXOR,KXEND,KYOR,KYEND,KDXRATIO,KDYRATIO,KDIMX_C,KDIMY_C,HLBCX,HLBCY,&
+ HLUOUT,PZS1_F,PZS2_C,HFIELD,PZS2_LS )
! #########################################################################
!
!!**** *SPAWN_ZS * - subroutine to spawn zs field
@@ -97,7 +99,9 @@ END MODULE MODI_SPAWN_ZS
!! -------------
!!
!! Original 12/01/05
-!! Modification 20/05/06 Remove Clark and Farley interpolation
+! Modification 20/05/06 Remove Clark and Farley interpolation
+! Modification 2014 M.Faivre : parallelizattion attempt
+! Modification 10/02/15 M. Moge : paralellization
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -115,8 +119,23 @@ USE MODI_ZS_BOUNDARY
USE MODE_MODELN_HANDLER
!
USE MODE_MPPDB
+USE MODD_VAR_ll
+USE MODE_ll
+USE MODD_LBC_n
+USE MODD_NESTING
+USE MODE_EXCHANGE_ll
+USE MODE_EXTRAPOL
!
IMPLICIT NONE
+!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!$20140624 renaming for VARS :
+! frame=Father -> _F when DIMS = IDIMX,Y
+! projection from |grid1 to |grid2 :
+! obtained with SET_LSFIELD_1WAYn + LS_FORCING
+! frame=Son -> _C when DIMS = IOR,END
+! projection from |grid2 to |grid1 :
+! obtained with SET_LSFIELD_2WAYn + LS_FEEDBACK
+!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!* 0.1 Declarations of dummy arguments :
!
@@ -124,10 +143,12 @@ INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
+INTEGER, INTENT(IN) :: KDIMX_C ! dimension (X dir) of local son subdomain in father grid
+INTEGER, INTENT(IN) :: KDIMY_C ! dimension (Y dir) of local son subdomain in father grid
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output-listing file
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS1 ! model 1 orography
-REAL, DIMENSION(:,:), INTENT(OUT) :: PZS2 ! interpolated orography with iterative correction
+REAL, DIMENSION(:,:), INTENT(IN) :: PZS1_F ! model 1 orography
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZS2_C ! interpolated orography with iterative correction
CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to nest
REAL, DIMENSION(:,:), INTENT(OUT),OPTIONAL :: PZS2_LS ! interpolated orography
!
@@ -137,32 +158,83 @@ INTEGER :: ILUOUT ! Logical unit number for the output listing
INTEGER :: IRESP ! Return codes in FM routines
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS2_LS ! interpolated orography
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS1 ! zs of model 1 at iteration n or n+1
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS2 ! averaged zs of model 2 at iteration n
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDZS ! difference between PZS1 and ZZS2
-!
-INTEGER :: IXMIN, IXMAX ! indices to interpolate the
+REAL, DIMENSION(:,:), ALLOCATABLE :: PZS1_C ! model 1 orography resticted to the grid of model 2
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS1_C ! zs of model 1 at iteration n or n+1 in GRID2
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS2_C ! averaged zs of model 2 at iteration n
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDZS_C ! difference between PZS1 and ZZS2
+!$20140617 ZTZS1 result of SET_LSFIELD_1WAY_ll(PZS1)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTZS1_C
+!$20140704 ZDZS_3D to use MAX_ll(array3D arg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZS_3D
+!$
+INTEGER :: IXMIN, IXMAX ! indices to interpolate the
! modified orography on model 2
! domain to model 1 grid
-INTEGER :: JI,JEPSX ! Loop index in x direction
-INTEGER :: JJ,JEPSY ! Loop index in y direction
-INTEGER :: JCOUNTER ! counter for iterative method
-REAL :: ZRELAX ! relaxation factor
-INTEGER :: JMAXITER = 2000 ! maximum number of iterations
-!
-INTEGER, DIMENSION(2) :: IZSMAX
-INTEGER :: IMI ! current model index
-!
+!JUAN A REVOIR TODO_JPHEXT /!\ /!\
+! <<<<<<< spawn_zs.f90
+INTEGER :: JI,JEPSX ! Loop index in x direction
+INTEGER :: JJ,JEPSY ! Loop index in y direction
+INTEGER :: JCOUNTER ! counter for iterative method
+REAL :: ZRELAX ! relaxation factor
+INTEGER :: JMAXITER = 2000 ! maximum number of iterations
+!
+INTEGER, DIMENSION(2) :: IZSMAX
+INTEGER :: IMI ! current model index
+!$20140604
+INTEGER :: KMI,IDIMX_C,IDIMY_C
+!$20140602
+INTEGER :: PZS1_FSIZE1
+INTEGER :: PZS1_FSIZE2
+!$20140603
+INTEGER :: IINFO_ll
+!$20140619
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll => NULL() ! list of fields to exchange
+!$20140623
+INTEGER :: IXOR_F,IXEND_F
+INTEGER :: IYOR_F,IYEND_F
+INTEGER :: KDXRATIO_C, KDYRATIO_C
+!$20140704
+!$20140711 not INT, REAL !!
+REAL :: ZMAXVAL
+REAL :: LOCMAXVAL
+!$20140801
+INTEGER :: IORX, IORY, IIBINT,IJBINT,IIEINT,IJEINT
+INTEGER :: IXOR_C_ll, IXEND_C_ll ! origin and end of the local subdomain of the child model 2
+INTEGER :: IYOR_C_ll, IYEND_C_ll ! relative to the father model 1
+INTEGER :: IINFO ! return code of // routines
+!
+TYPE(LIST_ll), POINTER :: TZZSFIELD_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZZSHALO2_ll ! needed for update_halo2_ll
+
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS1CHILDGRID_C ! copy of ZZS1_C extended to the whole child domain
+INTEGER :: JI2INF,JI2SUP
+INTEGER :: JJ2INF,JJ2SUP
INTEGER :: IXSIZE,IYSIZE
-INTEGER :: INFO_ll ! error return code
+!
+KDXRATIO_C=KDXRATIO
+KDYRATIO_C=KDYRATIO
+ZMAXVAL=1000.
+!$
+!!$=======
+!!$INTEGER :: JI,JEPSX ! Loop index in x direction
+!!$INTEGER :: JJ,JEPSY ! Loop index in y direction
+!!$INTEGER :: JCOUNTER ! counter for iterative method
+!!$REAL :: ZRELAX ! relaxation factor
+!!$INTEGER :: JMAXITER = 2000 ! maximum number of iterations
+!!$!
+!!$INTEGER, DIMENSION(2) :: IZSMAX
+!!$INTEGER :: IMI ! current model index
+!!$!
+!!$INTEGER :: IXSIZE,IYSIZE
+!!$INTEGER :: INFO_ll ! error return code
+!!$>>>>>>> 1.1.4.1.18.2.2.1
!-------------------------------------------------------------------------------
!
!* 1. PROLOGUE:
! ---------
!
IMI = GET_CURRENT_MODEL_INDEX()
-CALL GOTO_MODEL(2)
-CALL GO_TOMODEL_ll(2,INFO_ll)
+CALL GOTO_MODEL(IMI)
!
!
!* 1.2 recovers logical unit number of output listing
@@ -177,12 +249,64 @@ CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!* 2.1 Purely interpolated zs:
! -----------------------
!
-ALLOCATE(ZZS2_LS(SIZE(PZS2,1),SIZE(PZS2,2)))
-!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- HLBCX,HLBCY,PZS1,ZZS2_LS)
+ALLOCATE(ZZS2_LS(SIZE(PZS2_C,1),SIZE(PZS2_C,2)))
+PZS1_FSIZE1=SIZE(PZS1_F,1)
+PZS1_FSIZE2=SIZE(PZS1_F,2)
+!
+!
+!
+! This is one way to do it, but then the compute load are not well balanced
+! Each process computes the interpolation on the intersection of the global
+! child model with its part of the father model
+!CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+! XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+! KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
+! HLBCX,HLBCY,PZS1_F,ZZS2_LS)
+!
+! We want instead that each process computes the interpolation for its part
+! of the child model
+! Then we have to communicate the values of PZS1_F on each subdomain of the
+! child model to the corresponding process
+! before calling BIKHARDT on the local subdomain of the child model
+!
+!* 1 GATHER LS FIELD FOR THE CHILD MODEL KMI
+! 1.1 Must be on the father model to call get_child_dim
+CALL GOTO_MODEL(NDAD(IMI))
+!$20140623 KMI is DAD, IMI=son !!
+!$20140623 use IMI not KMI
+CALL GO_TOMODEL_ll(NDAD(IMI), IINFO_ll)
+IDIMX_C = KDIMX_C! + 2*(JPHEXT+1) !KXEND-KXOR-1
+IDIMY_C = KDIMY_C! + 2*(JPHEXT+1) !KYEND-KYOR-1
+!CALL GET_CHILD_DIM_ll(IMI, IDIMX_C, IDIMY_C, IINFO_ll)
+!
+! 1.3 Specify the ls "source" fields and receiver fields
+!
+ALLOCATE(ZZS1_C(IDIMX_C,IDIMY_C))
+ZZS1_C(:,:)=0.
+CALL SET_LSFIELD_1WAY_ll(PZS1_F, ZZS1_C, IMI)
+CALL MPPDB_CHECK2D(PZS1_F,"SPAWN_ZS:PZS1_F",PRECISION)
+! 1.4 Communication
+CALL LS_FORCING_ll(IMI, IINFO_ll, .TRUE.)
+! 1.5 Back to the (current) child model
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+CALL GOTO_MODEL(IMI)
+CALL UNSET_LSFIELD_1WAY_ll()
+!
+!if the child grid is the whole father grid, we first need to extrapolate
+!the data on a "pseudo halo" before doing BIKHARDT interpolation
+!CALL EXTRAPOL_ON_PSEUDO_HALO(ZZS1_C)
+! <<<<<<< spawn_zs.f90
+CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO_C,KDYRATIO_C,1, &
+ HLBCX,HLBCY,ZZS1_C,ZZS2_LS)
+!!$=======
+!
+!!$ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+!!$ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+!!$ KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
+!!$ HLBCX,HLBCY,PZS1,ZZS2_LS)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
CALL MPPDB_CHECK2D(ZZS2_LS,"SPAWN_ZS::ZZS2_LS",PRECISION)
!
!* 4.2 New zs:
@@ -196,12 +320,16 @@ ALLOCATE(ZZS2_LS(SIZE(PZS2,1),SIZE(PZS2,2)))
IF (KDXRATIO/=1 .OR. KDYRATIO/=1) THEN
!
!* allocations
-!
- IXSIZE = KXEND-KXOR - 2*JPHEXT + 1
- IYSIZE = KYEND-KYOR - 2*JPHEXT + 1
- ALLOCATE(ZZS2(IXSIZE,IYSIZE))
- ALLOCATE(ZDZS(IXSIZE,IYSIZE))
- ALLOCATE(ZZS1(SIZE(PZS1,1),SIZE(PZS1,2)))
+! <<<<<<< spawn_zs.f90
+ IXSIZE = IDIMX_C-2*(JPHEXT+1)
+ IYSIZE = IDIMY_C-2*(JPHEXT+1)
+ ALLOCATE(ZZS2_C(IXSIZE,IYSIZE))
+ ALLOCATE(ZDZS_C(IXSIZE,IYSIZE))
+ ALLOCATE(PZS1_C(IXSIZE,IYSIZE))
+!!$=======
+!!$ IXSIZE = KXEND-KXOR - 2*JPHEXT + 1
+!!$ IYSIZE = KYEND-KYOR - 2*JPHEXT + 1
+!!$>>>>>>> 1.1.4.1.18.2.2.1
!
!* constants
!
@@ -211,7 +339,9 @@ IF (KDXRATIO/=1 .OR. KDYRATIO/=1) THEN
!* initializations of initial state
!
JCOUNTER=0
- ZZS1(:,:)=PZS1(:,:)
+ PZS1_C(:,:) = ZZS1_C(JPHEXT+2:IDIMX_C-JPHEXT-1,JPHEXT+2:IDIMY_C-JPHEXT-1)
+ PZS2_C=0.
+ CALL MPPDB_CHECK2D(PZS2_C,"SPAWN_ZSbefBKAT:PZS2",PRECISION)
!
!* iterative loop
!
@@ -219,56 +349,93 @@ IF (KDXRATIO/=1 .OR. KDYRATIO/=1) THEN
!
!* interpolation
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- HLBCX,HLBCY,ZZS1,PZS2)
- CALL MPPDB_CHECK2D(PZS2,"SPAWN_ZS::PZS2",PRECISION)
+! <<<<<<< spawn_zs.f90
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO_C,KDYRATIO_C,1, &
+ HLBCX,HLBCY,ZZS1_C,PZS2_C)
+!!$=======
+!!$ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+!!$ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+!!$ KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
+!!$ HLBCX,HLBCY,ZZS1,PZS2)
+ CALL MPPDB_CHECK2D(PZS2_C,"SPAWN_ZS::PZS2_C/LOOP",PRECISION)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
JCOUNTER=JCOUNTER+1
!
!* if orography is positive, it stays positive
!
- DO JI=1,IXSIZE
- DO JJ=1,IYSIZE
- IF (PZS1(JI+KXOR,JJ+KYOR)>-1.E-15) &
- PZS2((JI-1)*KDXRATIO+1+JPHEXT:JI*KDXRATIO+JPHEXT, &
- (JJ-1)*KDYRATIO+1+JPHEXT:JJ*KDYRATIO+JPHEXT) = &
- MAX( PZS2((JI-1)*KDXRATIO+1+JPHEXT:JI*KDXRATIO+JPHEXT, &
- (JJ-1)*KDYRATIO+1+JPHEXT:JJ*KDYRATIO+JPHEXT), 0.)
- END DO
- END DO
- CALL MPPDB_CHECK2D(PZS2,"SPAWN_ZS::PZS2",PRECISION)
+! <<<<<<< spawn_zs.f90
+ DO JI=1,IXSIZE
+ DO JJ=1,IYSIZE
+ IF (PZS1_C(JI,JJ)>-1.E-15) THEN
+ JI2INF = (JI-1)*KDXRATIO_C+1+JPHEXT
+ JI2SUP = JI*KDXRATIO_C+JPHEXT
+ JJ2INF = (JJ-1)*KDYRATIO_C+1+JPHEXT
+ JJ2SUP = JJ*KDYRATIO_C+JPHEXT
+ PZS2_C(JI2INF:JI2SUP,JJ2INF:JJ2SUP)= MAX(PZS2_C(JI2INF:JI2SUP,JJ2INF:JJ2SUP),0.)
+ ENDIF
+ END DO
+ END DO
+!!$=======
+!!$ DO JI=1,IXSIZE
+!!$ DO JJ=1,IYSIZE
+!!$ IF (PZS1(JI+KXOR,JJ+KYOR)>-1.E-15) &
+!!$ PZS2((JI-1)*KDXRATIO+1+JPHEXT:JI*KDXRATIO+JPHEXT, &
+!!$ (JJ-1)*KDYRATIO+1+JPHEXT:JJ*KDYRATIO+JPHEXT) = &
+!!$ MAX( PZS2((JI-1)*KDXRATIO+1+JPHEXT:JI*KDXRATIO+JPHEXT, &
+!!$ (JJ-1)*KDYRATIO+1+JPHEXT:JJ*KDYRATIO+JPHEXT), 0.)
+!!$ END DO
+!!$ END DO
+ CALL MPPDB_CHECK2D(PZS2_C,"SPAWN_ZS::PZS2_C/POS",PRECISION)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
!
!* computation of new averaged orography
-!
- ZZS2(:,:) = 0.
- DO JI=1,IXSIZE
- DO JJ=1,IYSIZE
- DO JEPSX = (JI-1)*KDXRATIO+1+JPHEXT, JI*KDXRATIO+JPHEXT
- DO JEPSY = (JJ-1)*KDYRATIO+1+JPHEXT, JJ*KDYRATIO+JPHEXT
- ZZS2(JI,JJ) = ZZS2(JI,JJ) + PZS2(JEPSX,JEPSY)
- END DO
- END DO
- END DO
+! <<<<<<< spawn_zs.f90
+ ZZS2_C(:,:) = 0.
+ DO JI=1,IXSIZE
+ DO JJ=1,IYSIZE
+ DO JEPSX = (JI-1)*KDXRATIO_C+1+JPHEXT, JI*KDXRATIO_C+JPHEXT
+ DO JEPSY = (JJ-1)*KDYRATIO_C+1+JPHEXT, JJ*KDYRATIO_C+JPHEXT
+ ZZS2_C(JI,JJ) = ZZS2_C(JI,JJ) + PZS2_C(JEPSX,JEPSY)
+ END DO
+ END DO
+ END DO
+!!$=======
+!!$>>>>>>> 1.1.4.1.18.2.2.1
END DO
- ZZS2(:,:) = ZZS2(:,:) / (KDXRATIO*KDYRATIO)
+! <<<<<<< spawn_zs.f90
+ ZZS2_C(:,:) = ZZS2_C(:,:) / (KDXRATIO_C*KDYRATIO_C)
!
- ZDZS(:,:)=PZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)-ZZS2(:,:)
+ ZDZS_C(:,:)=PZS1_C(:,:)-ZZS2_C(:,:)
+!!$=======
+!!$ ZZS2(:,:) = ZZS2(:,:) / (KDXRATIO*KDYRATIO)
+!!$ !
+!!$ ZDZS(:,:)=PZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)-ZZS2(:,:)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
!
!* test to end the iterative process
!
- IF (MAXVAL(ABS(ZDZS(:,:)))<1.E-3) EXIT
+ ALLOCATE(ZDZS_3D(SIZE(ZDZS_C,1),SIZE(ZDZS_C,2),1)) ! WARNING : this is highly inefficient, this copy is unecessary
+ ZDZS_3D(:,:,1)=ZDZS_C(:,:) ! We could write a function MAX2D_ll or use a POINTER for ZDZS_3D
+ LOCMAXVAL=MAXVAL(ABS(ZDZS_C))
+ CALL MPI_ALLREDUCE(LOCMAXVAL,ZMAXVAL,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+ IF (ZMAXVAL<1.E-3) THEN
+ EXIT
+ ENDIF
!
IF (JCOUNTER>=JMAXITER) THEN
WRITE(ILUOUT,FMT=*) 'SPAWN_ZS: convergence of ',TRIM(HFIELD), &
' NOT obtained after',JCOUNTER,' iterations'
WRITE(ILUOUT,FMT=*) TRIM(HFIELD), &
' is modified to insure egality of large scale and averaged fine field'
+! <<<<<<< spawn_zs.f90
DO JI=1,IXSIZE
DO JJ=1,IYSIZE
- DO JEPSX = (JI-1)*KDXRATIO+1+JPHEXT, JI*KDXRATIO+JPHEXT
- DO JEPSY = (JJ-1)*KDYRATIO+1+JPHEXT, JJ*KDYRATIO+JPHEXT
- PZS2(JEPSX,JEPSY) = PZS2(JEPSX,JEPSY) + ZDZS(JI,JJ)
+ DO JEPSX = (JI-1)*KDXRATIO_C+1+JPHEXT, JI*KDXRATIO_C+JPHEXT
+ DO JEPSY = (JJ-1)*KDYRATIO_C+1+JPHEXT, JJ*KDYRATIO_C+JPHEXT
+ PZS2_C(JEPSX,JEPSY) = PZS2_C(JEPSX,JEPSY) + ZDZS_C(JI,JJ)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
END DO
END DO
END DO
@@ -280,80 +447,198 @@ IF (KDXRATIO/=1 .OR. KDYRATIO/=1) THEN
!* prints
!
IF (NVERB >=7) THEN
- IZSMAX=MAXLOC(ABS(ZDZS(:,:)))
- IF (MOD(JCOUNTER,500)==1) &
+ IZSMAX=MAXLOC(ABS(ZDZS_C(:,:)))
+ IF (MOD(JCOUNTER,500)==1) THEN
WRITE(ILUOUT,FMT='(A4,1X,A4,1X,A2,1X,A2,1X,A12,1X,A12,1X,A12)') &
'n IT','nDIV','I1','J1',' ZS1',' ZS2',' DZS'
WRITE(ILUOUT,FMT='(I4,1X,I4,1X,I2,1X,I2,1X,F12.7,1X,F12.7,1X,F12.7)')&
- JCOUNTER,COUNT(ABS(ZDZS(:,:))>=1.E-3), &
- IZSMAX(1)+KXOR,IZSMAX(2)+KYOR, &
- PZS1(KXOR+IZSMAX(1),KYOR+IZSMAX(2)), &
- ZZS2(IZSMAX(1),IZSMAX(2)), &
- ZDZS(IZSMAX(1),IZSMAX(2))
+ JCOUNTER,COUNT(ABS(ZDZS_C(:,:))>=1.E-3), &
+ IZSMAX(1)+2,IZSMAX(2)+2, &
+! PZS1(KXOR+IZSMAX(1),KYOR+IZSMAX(2)), &
+ ZTZS1_C(2+IZSMAX(1),2+IZSMAX(2)), &
+ ZZS2_C(IZSMAX(1),IZSMAX(2)), &
+ ZDZS_C(IZSMAX(1),IZSMAX(2))
+ ENDIF
END IF
!
!* correction of coarse orography
!
- ZZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) = &
- ZZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) + ZRELAX * ZDZS(:,:)
+! <<<<<<< spawn_zs.f90
+ ZZS1_C(JPHEXT+2:IDIMX_C-JPHEXT-1,JPHEXT+2:IDIMY_C-JPHEXT-1) = &
+ ZZS1_C(JPHEXT+2:IDIMX_C-JPHEXT-1,JPHEXT+2:IDIMY_C-JPHEXT-1) + ZRELAX * ZDZS_C(:,:)
+
+ ! update the Halo
+ ! UPDATE_HALO_ll routines only work with fields of the size of the subdomain
+ ! so we have to copy the values we want to update in a temporary field ZZS1CHILDGRID_C
+ ALLOCATE(ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2,SIZE(PZS2_C,2)+2))
+ ! TODO : renommer ZZS1CHILDGRID_C avec un nom plus explicite
+ ZZS1CHILDGRID_C = 0.
+ ! west boundary of ZZS1_C
+ DO JI=1,JPHEXT+1
+ DO JJ=1,IDIMY_C
+ ZZS1CHILDGRID_C(JI,JJ) = ZZS1_C(JI,JJ) ! distant value, not on local physical domain
+ ZZS1CHILDGRID_C(JI+JPHEXT+1,JJ) = ZZS1_C(JI+JPHEXT+1,JJ) ! local value, on local physical domain
+ END DO
+ END DO
+ ! east boundary of ZZS1_C
+ DO JI=1,JPHEXT+1
+ DO JJ=1,IDIMY_C
+ ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1,JJ) = ZZS1_C(IDIMX_C-JI+1,JJ) ! distant value, not on local physical domain
+ ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1-JPHEXT-1,JJ) = ZZS1_C(IDIMX_C-JI+1-JPHEXT-1,JJ) ! local value, on local physical domain
+ END DO
+ END DO
+ ! south boundary of ZZS1_C
+ DO JI=1,IDIMX_C
+ DO JJ=1,JPHEXT+1
+ ZZS1CHILDGRID_C(JI,JJ) = ZZS1_C(JI,JJ) ! distant value, not on local physical domain
+ ZZS1CHILDGRID_C(JI,JJ+JPHEXT+1) = ZZS1_C(JI,JJ+JPHEXT+1) ! local value, on local physical domain
+ END DO
+ END DO
+ ! north boundary of ZZS1_C
+ DO JI=1,IDIMX_C
+ DO JJ=1,JPHEXT+1
+ ZZS1CHILDGRID_C(JI,SIZE(PZS2_C,2)+2-JJ+1) = ZZS1_C(JI,IDIMY_C-JJ+1) ! distant value, not on local physical domain
+ ZZS1CHILDGRID_C(JI,SIZE(PZS2_C,2)+2-JJ+1-JPHEXT-1) = ZZS1_C(JI,IDIMY_C-JJ+1-JPHEXT-1) ! local value, on local physical domain
+ END DO
+ END DO
+ ! If we leave the north-east corner with zero values, UPDATE_HALO_EXTENDED_ll will
+ ! cause errors on the south-east and north-west internal border of the neigbouring processes
+ DO JI=1,JPHEXT+1
+ DO JJ=1,JPHEXT+1
+ ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1-JPHEXT-1,SIZE(PZS2_C,2)+2-JJ+1-JPHEXT-1) = ZZS1_C(IDIMX_C-JI+1-JPHEXT-1,IDIMY_C-JJ+1-JPHEXT-1) ! local value, on local physical domain
+ END DO
+ END DO
+ !
+ NULLIFY(TZZSFIELD_ll)
+ CALL ADD2DFIELD_ll(TZZSFIELD_ll, ZZS1CHILDGRID_C)
+ CALL UPDATE_HALO_EXTENDED_ll(TZZSFIELD_ll,IINFO)
+ CALL CLEANLIST_ll(TZZSFIELD_ll)
+ ! west and east boundaries - distant points
+ DO JI=1,JPHEXT+1
+ DO JJ=JPHEXT+1,IDIMY_C-JPHEXT+1
+ ZZS1_C(JI,JJ) = ZZS1CHILDGRID_C(JI,JJ)
+ ZZS1_C(IDIMX_C-JI+1,JJ) = ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1,JJ)
+ END DO
+ END DO
+ ! north and south boundaries - distant points
+ DO JI=JPHEXT+1,IDIMX_C-JPHEXT+1
+ DO JJ=1,JPHEXT+1
+ ZZS1_C(JI,JJ) = ZZS1CHILDGRID_C(JI,JJ)
+ ZZS1_C(JI,IDIMY_C-JJ+1) = ZZS1CHILDGRID_C(JI,SIZE(PZS2_C,2)+2-JJ+1)
+ END DO
+ END DO
+ ! "corner" halo
+ DO JI=1,JPHEXT+1
+ DO JJ=1,JPHEXT+1
+ ZZS1_C(JI,JJ) = ZZS1CHILDGRID_C(JI,JJ)
+ ZZS1_C(IDIMX_C-JI+1,JJ) = ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1,JJ)
+ ZZS1_C(JI,IDIMY_C-JJ+1) = ZZS1CHILDGRID_C(JI,SIZE(PZS2_C,2)+2-JJ+1)
+ ZZS1_C(IDIMX_C-JI+1,IDIMY_C-JJ+1) = ZZS1CHILDGRID_C(SIZE(PZS2_C,1)+2-JI+1,SIZE(PZS2_C,2)+2-JJ+1)
+ END DO
+ END DO
+ ! corner points - distant points
+ ! we have to treat the halo points in the corner separately to have correct values
+ ! in the intersection of the halos (points (1,1), (1,2), (2,1), (2,2), (IDIMX_C,IDIMY_C), etc.)
+!!$=======
+!!$ ZZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) = &
+!!$ ZZS1(KXOR+JPHEXT:KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) + ZRELAX * ZDZS(:,:)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
!
! extrapolations (X direction)
!
- IF(KXOR==1 .AND. KXEND==SIZE(PZS1,1) .AND. HLBCX(1)=='CYCL' ) THEN
- ZZS1(KXOR,KYOR+JPHEXT:KYEND-JPHEXT) = ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
- ZZS1(KXEND,KYOR+JPHEXT:KYEND-JPHEXT) = ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+! <<<<<<< spawn_zs.f90
+ ! TODO: utiliser JPHEXT dans une boucle pour generaliser au cas ou le halo est plus grand que 1
+ IF(KXOR==1 .AND. KXEND==SIZE(PZS1_F,1) .AND. HLBCX(1)=='CYCL' ) THEN
+ !c'est pris en compte et deja fait par UPDATE_HALO_ll et UPDATE_HALO2_ll ? --------> NON
+!!$=======
+!!$ IF(KXOR==1 .AND. KXEND==SIZE(PZS1,1) .AND. HLBCX(1)=='CYCL' ) THEN
+!!$ ZZS1(KXOR,KYOR+JPHEXT:KYEND-JPHEXT) = ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$ ZZS1(KXEND,KYOR+JPHEXT:KYEND-JPHEXT) = ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
ELSE
- ZZS1(KXOR+JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT) = &
- 2. * ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXOR+JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT)
- IF(KXOR>1) &
- ZZS1(KXOR+JPHEXT-2,KYOR+JPHEXT:KYEND-JPHEXT) = &
- 2. * ZZS1(KXOR+JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
- ZZS1(KXEND-JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT) = &
- 2. * ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXEND-JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT)
- IF(KXEND<SIZE(PZS1,1)) &
- ZZS1(KXEND-JPHEXT+2,KYOR+JPHEXT:KYEND-JPHEXT) = &
- 2. * ZZS1(KXEND-JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+! <<<<<<< spawn_zs.f90
+ IF ( LWEST_ll() ) THEN
+ ZZS1_C(1+JPHEXT,1:IDIMY_C) = 2. * ZZS1_C(2+JPHEXT,1:IDIMY_C) - ZZS1_C(3+JPHEXT,1:IDIMY_C)
+ ZZS1_C(JPHEXT,1:IDIMY_C) = 2. * ZZS1_C(1+JPHEXT,1:IDIMY_C) - ZZS1_C(2+JPHEXT,1:IDIMY_C)
+ ENDIF
+ IF ( LEAST_ll() ) THEN
+ ZZS1_C(IDIMX_C-JPHEXT,1:IDIMY_C) = 2. * ZZS1_C(IDIMX_C-JPHEXT-1,1:IDIMY_C) - ZZS1_C(IDIMX_C-JPHEXT-2,1:IDIMY_C)
+ ZZS1_C(IDIMX_C-JPHEXT+1,1:IDIMY_C) = 2. * ZZS1_C(IDIMX_C-JPHEXT,1:IDIMY_C) - ZZS1_C(IDIMX_C-JPHEXT-1,1:IDIMY_C)
+ ENDIF
+!!$=======
+!!$ ZZS1(KXOR+JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT) = &
+!!$ 2. * ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXOR+JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$ IF(KXOR>1) &
+!!$ ZZS1(KXOR+JPHEXT-2,KYOR+JPHEXT:KYEND-JPHEXT) = &
+!!$ 2. * ZZS1(KXOR+JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXOR+JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$ ZZS1(KXEND-JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT) = &
+!!$ 2. * ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXEND-JPHEXT-1,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$ IF(KXEND<SIZE(PZS1,1)) &
+!!$ ZZS1(KXEND-JPHEXT+2,KYOR+JPHEXT:KYEND-JPHEXT) = &
+!!$ 2. * ZZS1(KXEND-JPHEXT+1,KYOR+JPHEXT:KYEND-JPHEXT) - ZZS1(KXEND-JPHEXT,KYOR+JPHEXT:KYEND-JPHEXT)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
END IF
!
! extrapolations (Y direction)
!
- IXMIN=MAX(KXOR-1,1)
- IXMAX=MIN(KXEND+1,SIZE(PZS1,1))
- IF(KYOR==1 .AND. KYEND==SIZE(PZS1,2) .AND. HLBCY(1)=='CYCL' ) THEN
- ZZS1(IXMIN:IXMAX,KYOR) = ZZS1(IXMIN:IXMAX,KYEND-JPHEXT)
- ZZS1(IXMIN:IXMAX,KYEND) = ZZS1(IXMIN:IXMAX,KYOR+JPHEXT)
+! <<<<<<< spawn_zs.f90
+! IXMIN=MAX(KXOR-1,1)
+! IXMAX=MIN(KXEND+1,SIZE(PZS1_F,1))
+ IF(KYOR==1 .AND. KYEND==SIZE(PZS1_F,2) .AND. HLBCY(1)=='CYCL' ) THEN
+ !c'est pris en compte et deja fait par UPDATE_HALO_ll et UPDATE_HALO2_ll ? --------> NON
+!!$=======
+!!$ IXMIN=MAX(KXOR-1,1)
+!!$ IXMAX=MIN(KXEND+1,SIZE(PZS1,1))
+!!$ IF(KYOR==1 .AND. KYEND==SIZE(PZS1,2) .AND. HLBCY(1)=='CYCL' ) THEN
+!!$ ZZS1(IXMIN:IXMAX,KYOR) = ZZS1(IXMIN:IXMAX,KYEND-JPHEXT)
+!!$ ZZS1(IXMIN:IXMAX,KYEND) = ZZS1(IXMIN:IXMAX,KYOR+JPHEXT)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
ELSE
- ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-1) = &
- 2. * ZZS1(IXMIN:IXMAX,KYOR+JPHEXT) - ZZS1(IXMIN:IXMAX,KYOR+JPHEXT+1)
- IF(KYOR>1) &
- ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-2) = &
- 2. * ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-1) - ZZS1(IXMIN:IXMAX,KYOR+JPHEXT)
- ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+1) = &
- 2. * ZZS1(IXMIN:IXMAX,KYEND-JPHEXT) - ZZS1(IXMIN:IXMAX,KYEND-JPHEXT-1)
- IF(KYEND<SIZE(PZS1,2)) &
- ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+2) = &
- 2. * ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+1) - ZZS1(IXMIN:IXMAX,KYEND-JPHEXT)
+! <<<<<<< spawn_zs.f90
+ IF ( LSOUTH_ll() ) THEN
+ ZZS1_C(1:IDIMX_C,1+JPHEXT) = 2. * ZZS1_C(1:IDIMX_C,2+JPHEXT) - ZZS1_C(1:IDIMX_C,3+JPHEXT)
+ ZZS1_C(1:IDIMX_C,JPHEXT) = 2. * ZZS1_C(1:IDIMX_C,1+JPHEXT) - ZZS1_C(1:IDIMX_C,2+JPHEXT)
+ ENDIF
+ IF ( LNORTH_ll() ) THEN
+ ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT) = 2. * ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT-1) - ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT-2)
+ ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT+1) = 2. * ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT) - ZZS1_C(1:IDIMX_C,IDIMY_C-JPHEXT-1)
+ ENDIF
+!!$=======
+!!$ ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-1) = &
+!!$ 2. * ZZS1(IXMIN:IXMAX,KYOR+JPHEXT) - ZZS1(IXMIN:IXMAX,KYOR+JPHEXT+1)
+!!$ IF(KYOR>1) &
+!!$ ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-2) = &
+!!$ 2. * ZZS1(IXMIN:IXMAX,KYOR+JPHEXT-1) - ZZS1(IXMIN:IXMAX,KYOR+JPHEXT)
+!!$ ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+1) = &
+!!$ 2. * ZZS1(IXMIN:IXMAX,KYEND-JPHEXT) - ZZS1(IXMIN:IXMAX,KYEND-JPHEXT-1)
+!!$ IF(KYEND<SIZE(PZS1,2)) &
+!!$ ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+2) = &
+!!$ 2. * ZZS1(IXMIN:IXMAX,KYEND-JPHEXT+1) - ZZS1(IXMIN:IXMAX,KYEND-JPHEXT)
+!!$>>>>>>> 1.1.4.1.18.2.2.1
END IF
!
-!* next iteration
+ DEALLOCATE(ZZS1CHILDGRID_C)
+ DEALLOCATE(ZDZS_3D)
!
END DO
!
- CALL ZS_BOUNDARY(PZS2,ZZS2_LS)
+ CALL ZS_BOUNDARY(PZS2_C,ZZS2_LS)
+ JI=0
+ CALL MPPDB_CHECK2D(PZS2_C,"SPAWN_ZSend:PZS2",PRECISION)
!
WRITE(ILUOUT,FMT=*) 'convergence of ',TRIM(HFIELD),' obtained after ', &
JCOUNTER,' iterations'
!
- DEALLOCATE(ZZS2)
- DEALLOCATE(ZDZS)
- DEALLOCATE(ZZS1)
+ DEALLOCATE(ZZS2_C)
+ DEALLOCATE(ZDZS_C)
+ DEALLOCATE(ZZS1_C)
END IF
!
IF (PRESENT(PZS2_LS)) PZS2_LS(:,:)=ZZS2_LS(:,:)
DEALLOCATE(ZZS2_LS)
!
CALL GOTO_MODEL(IMI)
-CALL GO_TOMODEL_ll(IMI,INFO_ll)
+CALL GO_TOMODEL_ll(IMI,IINFO_ll)
!-------------------------------------------------------------------------------
END SUBROUTINE SPAWN_ZS
!
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 13d8f5739f7d0993e3e227d1deb7668a03bc8e0f..8840ddea03351aefc6c2302253f6d5664cdecac7 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -70,6 +70,7 @@
!! to keep finest fields of son1
!! Modification 05/06 Remove EPS
!! Modification 19/03/2008 (J.Escobar) rename INIT to INIT_MNH --> grib problem
+!! Modification 05/02/2015 (M.Moge) read namelist NAM_CONFZ, before INIT_MNH
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -89,6 +90,7 @@ USE MODD_REF
USE MODD_SPAWN
USE MODN_BLANK
USE MODD_NSV
+USE MODN_CONFZ
!
!* 0.2 Declarative modules of model 1
!
@@ -118,6 +120,8 @@ USE MODI_BOUNDARIES
USE MODI_VERSION
USE MODI_INIT_MNH
USE MODI_DEALLOC_SURFEX
+USE MODE_MPPDB
+!
!
USE MODN_CONF, ONLY : JPHEXT , NHALO
!
@@ -146,6 +150,7 @@ NAMELIST/NAM_CONF_SPAWN/JPHEXT, NHALO
!-------------------------------------------------------------------------------
!
CALL MPPDB_INIT()
+!
! First Switch to model 1 variables
CALL GOTO_MODEL(1)
!
@@ -164,17 +169,8 @@ CALL READ_EXSPA(CINIFILE,CINIFILEPGD,&
LBAL_ONLY, &
CDOMAIN,YSPAFILE,YSPANBR,CDADINIFILE,CDADSPAFILE,YSONFILE)
!
-!-------------------------------------------------------------------------------
-!
-!* 2. MODEL 1 INITIALIZATION
-! ----------------------
-!
-CALL INIT_MNH
-!
-CALL FMCLOS_ll(CINIFILE,'KEEP',CLUOUT,IRESP)
-CALL FMCLOS_ll(CINIFILEPGD,'KEEP',CLUOUT,IRESP)
!
-!* 3. NAM_BLANK READING AND EXSPA file CLOSURE
+!* 2. NAM_BLANK, NAM_SPAWN_SURF and NAM_CONFZ READING AND EXSPA file CLOSURE
! ----------------------------------------
!
YEXSPA = 'SPAWN1.nam'
@@ -188,12 +184,23 @@ IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_SPAWN_SURF)
CALL UPDATE_MODD_FROM_NMLVAR
CALL POSNAM(ILUSPA,'NAM_BLANK',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_BLANK)
+CALL POSNAM(ILUSPA,'NAM_CONFZ',GFOUND)
+IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONFZ)
CALL POSNAM(ILUSPA,'NAM_CONF_SPAWN',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONF_SPAWN)
-!!CALL CLOSE_ll(YEXSPA)
+CALL CLOSE_ll(YEXSPA)
!
!-------------------------------------------------------------------------------
!
+!* 3. MODEL 1 INITIALIZATION
+! ----------------------
+!
+CALL INIT_MNH
+!
+CALL FMCLOS_ll(CINIFILE,'KEEP',CLUOUT,IRESP)
+CALL FMCLOS_ll(CINIFILEPGD,'KEEP',CLUOUT,IRESP)
+!-------------------------------------------------------------------------------
+!
!* 4. INITIALIZATION OF OUTER POINTS OF MODEL 1
! -----------------------------------------
!
@@ -205,12 +212,16 @@ CALL BOUNDARIES &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
XRHODJ, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+CALL MPPDB_CHECK3D(XUT,"SPAWNING-after boundaries::XUT",PRECISION)
!
!-------------------------------------------------------------------------------
!
!* 5. SPAWNING OF MODEL 2 FROM MODEL 1
! --------------------------------
!
+CALL OPEN_ll(unit=ILUSPA,FILE=YEXSPA,iostat=IRESP,status="OLD",action='READ', &
+ form='FORMATTED',position="REWIND",mode=GLOBAL)
+CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
CALL GOTO_MODEL(2)
CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
CALL INIT_NMLVAR
@@ -227,7 +238,6 @@ CALL SPAWN_MODEL2 (NRR,NSV_USER,CTURB,CSURF,CCLOUD, &
CINIFILE, CINIFILEPGD, LSPAWN_SURF )
!
CALL DEALLOC_SURFEX
- !callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
CALL END_PARA_ll(IINFO_ll)
!JUAN CALL ABORT
diff --git a/src/MNH/split_grid_parameter_mnh.f90 b/src/MNH/split_grid_parameter_mnh.f90
index 04ec63c2cd22ec76defe722e17ccb7625aa54f66..fed28c271c66c42b89e5a22370edd23e29884dda 100644
--- a/src/MNH/split_grid_parameter_mnh.f90
+++ b/src/MNH/split_grid_parameter_mnh.f90
@@ -3,13 +3,24 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! #############################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
+#else
SUBROUTINE SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
+#endif
! #############################################################
!
!!**** * - routine to split a real array on the splitted grid
!
+! Modifications
+! M.Moge 10/02/2015 Using local subdomain for parallel execution
+! M.Moge 01/03/2015 Using KIMAX_ll,KJMAX_ll,KHALO for the call to SPLIT_GRID in subroutine PGD_GRID
!
+!
+#ifdef MNH_PARALLEL
+#else
USE MODD_IO_SURF_MNH, ONLY : NHALO
+#endif
!
IMPLICIT NONE
!
@@ -19,6 +30,11 @@ CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
INTEGER, INTENT(IN) :: KDIM ! size of PFIELD
INTEGER, INTENT(IN) :: KSIZE ! size of PFIELD_SPLIT
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KIMAX_ll !(global) dimension of the domain - X direction
+INTEGER, INTENT(IN) :: KJMAX_ll !(global) dimension of the domain - Y direction
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
REAL, DIMENSION(KDIM ), INTENT(IN) :: PFIELD ! real field for complete grid
REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for splitted grid
!
@@ -26,79 +42,86 @@ REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for splitted grid
!
INTEGER :: JI, JJ
INTEGER :: IIB, IIE, IJB, IJE
-INTEGER :: NIMAX_ll, NJMAX_ll
-INTEGER :: IXOR_ll, IYOR_ll
-INTEGER :: NIMAX, NJMAX
+INTEGER :: NIMAX, NJMAX !(local) dimensions of the subdomain
+INTEGER :: IXOR, IYOR !origin of local subdomain
!
REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZY
REAL :: ZDX, ZDY
!
INTEGER :: IINDEX
+#ifdef MNH_PARALLEL
+#else
+INTEGER :: KIMAX_ll
+INTEGER :: KJMAX_ll
+INTEGER :: KHALO
+!
+KHALO = NHALO
+CALL GET_GLOBALDIMS_ll (KIMAX_ll,KJMAX_ll)
+#endif
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
-CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
+CALL GET_OR_ll ('B',IXOR,IYOR)
NIMAX=IIE-IIB+1
NJMAX=IJE-IJB+1
!
!
IF (HREC=='XX' .OR. HREC=='DX') THEN
- ALLOCATE(ZX(NIMAX_ll+2*NHALO))
- ZX(1+NHALO:NIMAX_ll+NHALO) = PFIELD(1:NIMAX_ll)
+ ALLOCATE(ZX(NIMAX+2*KHALO))
+ ZX(1+KHALO:NIMAX+KHALO) = PFIELD(IXOR:IXOR+NIMAX-1)
IF (HREC=='DX') THEN
ZDX = PFIELD(1)
- DO JI=NHALO,1,-1
+ DO JI=KHALO,1,-1
ZX(JI) = ZDX
- ZX(NIMAX_ll+2*NHALO-JI+1) = ZDX
+ ZX(NIMAX+2*KHALO-JI+1) = ZDX
END DO
ELSE IF (HREC=='XX') THEN
ZDX = 0.
- IF (NIMAX_ll>1) ZDX = PFIELD(2) - PFIELD(1)
- IF (NIMAX_ll==1) ZDX = PFIELD(1) ! in 1D conf, one assumes that grid
+ IF (NIMAX>1) ZDX = PFIELD(2) - PFIELD(1)
+ IF (NIMAX==1) ZDX = PFIELD(1) ! in 1D conf, one assumes that grid
! is located between X=DX/2 and X=3DX/2
- DO JI=NHALO,1,-1
+ DO JI=KHALO,1,-1
ZX(JI) = ZX(JI+1) - ZDX
- ZX(NIMAX_ll+2*NHALO-JI+1) = ZX(NIMAX_ll+2*NHALO-JI) + ZDX
+ ZX(NIMAX+2*KHALO-JI+1) = ZX(NIMAX+2*KHALO-JI) + ZDX
END DO
END IF
!
- DO JJ=1,NJMAX+2*NHALO
- DO JI=1,NIMAX+2*NHALO
- IINDEX = JI+(JJ-1)*(NIMAX+2*NHALO)
- PFIELD_SPLIT(IINDEX) = ZX(JI+IXOR_ll-1)
+ DO JJ=1,NJMAX+2*KHALO
+ DO JI=1,NIMAX+2*KHALO
+ IINDEX = JI+(JJ-1)*(NIMAX+2*KHALO)
+ PFIELD_SPLIT(IINDEX) = ZX(JI)
END DO
END DO
DEALLOCATE(ZX)
ELSEIF (HREC=='YY' .OR. HREC=='DY') THEN
- ALLOCATE(ZY(NJMAX_ll+2*NHALO))
- DO JJ=1+NHALO,NJMAX_ll+NHALO
- ZY(JJ) = PFIELD(1+(JJ-1-NHALO)*NIMAX_ll)
+ ALLOCATE(ZY(NJMAX+2*KHALO))
+ DO JJ=1+KHALO,NJMAX+KHALO
+ ZY(JJ) = PFIELD(1+(IYOR+JJ-1-1-KHALO)*KIMAX_ll)
END DO
IF (HREC=='DY') THEN
ZDY = PFIELD(1)
- DO JJ=NHALO,1,-1
+ DO JJ=KHALO,1,-1
ZY(JJ) = ZDY
- ZY(NJMAX_ll+2*NHALO-JJ+1) = ZDY
+ ZY(NJMAX+2*KHALO-JJ+1) = ZDY
END DO
ELSE IF (HREC=='YY') THEN
ZDY = 0.
- IF (NJMAX_ll>1) ZDY = PFIELD(1+NIMAX_ll) - PFIELD(1)
- IF (NJMAX_ll==1) ZDY = PFIELD(1) ! in 1D or 2D conf, one assumes that grid
+ IF (NJMAX>1) ZDY = PFIELD(1+KIMAX_ll) - PFIELD(1)
+ IF (NJMAX==1) ZDY = PFIELD(1) ! in 1D or 2D conf, one assumes that grid
! is located between Y=DY/2 and Y=3DY/2
- DO JJ=NHALO,1,-1
+ DO JJ=KHALO,1,-1
ZY(JJ) = ZY(JJ+1) - ZDY
- ZY(NJMAX_ll+2*NHALO-JJ+1) = ZY(NJMAX_ll+2*NHALO-JJ) + ZDY
+ ZY(NJMAX+2*KHALO-JJ+1) = ZY(NJMAX+2*KHALO-JJ) + ZDY
END DO
END IF
- DO JJ=1,NJMAX+2*NHALO
- DO JI=1,NIMAX+2*NHALO
- IINDEX = JI+(JJ-1)*(NIMAX+2*NHALO)
- PFIELD_SPLIT(IINDEX) = ZY(JJ+IYOR_ll-1)
+ DO JJ=1,NJMAX+2*KHALO
+ DO JI=1,NIMAX+2*KHALO
+ IINDEX = JI+(JJ-1)*(NIMAX+2*KHALO)
+ PFIELD_SPLIT(IINDEX) = ZY(JJ)
END DO
END DO
DEALLOCATE(ZY)
@@ -110,7 +133,11 @@ END SUBROUTINE SPLIT_GRID_PARAMETERX1_MNH
!
!
! #############################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
+#else
SUBROUTINE SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KFIELD,KFIELD_SPLIT)
+#endif
! #############################################################
!
!!**** * - routine to define an integer related to splitted grid
@@ -119,7 +146,10 @@ END SUBROUTINE SPLIT_GRID_PARAMETERX1_MNH
!
USE MODE_ll
!
+#ifdef MNH_PARALLEL
+#else
USE MODD_IO_SURF_MNH, ONLY : NHALO
+#endif
!
IMPLICIT NONE
!
@@ -127,17 +157,26 @@ IMPLICIT NONE
!
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for splitted grid
!* 0.2 Declarations of local variables
!
INTEGER :: IIB, IIE, IJB, IJE
+#ifdef MNH_PARALLEL
+#else
+INTEGER :: KHALO
+!
+KHALO = NHALO
+#endif
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
-IF (HREC=='IMAX') KFIELD_SPLIT = IIE-IIB+1 + 2*NHALO
-IF (HREC=='JMAX') KFIELD_SPLIT = IJE-IJB+1 + 2*NHALO
+IF (HREC=='IMAX') KFIELD_SPLIT = IIE-IIB+1 + 2*KHALO
+IF (HREC=='JMAX') KFIELD_SPLIT = IJE-IJB+1 + 2*KHALO
!
!-------------------------------------------------------------------------------
END SUBROUTINE SPLIT_GRID_PARAMETERN0_MNH
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index f7fbb9942b4b059cfe40ba2c5df4b4ee7a942c37..4dd02ca40c37cfc3d99cb3071b5d9744763d1415 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -131,6 +131,7 @@ END MODULE MODI_VER_DYN
!! interpolation routine
!! V.Masson 24/11/97 use of the 3D dry density
!! J.Stein 20:01/98 add the LS field interpolation
+!! M.Faivre 2014
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -144,6 +145,7 @@ USE MODI_VER_INTERP_LIN
USE MODI_WGUESS
USE MODI_VER_SHIFT
USE MODI_VER_INT_DYN
+USE MODI_ANEL_BALANCE_n
USE MODI_SHUMAN
!
USE MODD_CONF ! declaration modules
@@ -161,6 +163,7 @@ USE MODD_DIM_n
USE MODE_MPPDB
USE MODE_ll
USE MODE_EXTRAPOL
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
IMPLICIT NONE
!
@@ -215,6 +218,11 @@ INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
+!
+!20131105 declare vars related to add3dfield and update_halo_ll
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+!
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
@@ -250,15 +258,36 @@ CALL MPPDB_CHECK3D(ZRHODVA,"VERDYN::ZRHODVA",PRECISION)
!* 3. CHANGE TO ARAKAWA C-GRID
! ------------------------
!
+!20131105 add UPDATE_HALO on ZRHODUA, ZRHODVA and PJ(needed) : ok ZRHODJU,V
+!20131112 impact of PJ update_halo =>ZRHODJU,V error => XUM,XVM error
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODUA)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODVA)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PJ)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!
ZRHODJU(:,:,:)=MXM(ZRHODUA(:,:,:)*PJ(:,:,:))
ZRHODJV(:,:,:)=MYM(ZRHODVA(:,:,:)*PJ(:,:,:))
-
+!
+!20131112 add update_halo_ll though checking on vars is correct
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODJU)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODJV)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!20131105 add check
+CALL MPPDB_CHECK3D(ZRHODJU,"VERDYN3-before extrapol::ZRHODJU",PRECISION)
+CALL MPPDB_CHECK3D(ZRHODJV,"VERDYN3-before extrapol::ZRHODJV",PRECISION)
+!
CALL EXTRAPOL('W',ZRHODJU)
CALL EXTRAPOL('S',ZRHODJV)
-
-CALL MPPDB_CHECK3D(ZRHODJU,"VERDYN::ZRHODJU",PRECISION)
-CALL MPPDB_CHECK3D(ZRHODJV,"VERDYN::ZRHODJV",PRECISION)
-
+!
+!CALL MPPDB_CHECK3D(ZRHODJU,"VERDYN::ZRHODJU",PRECISION)
+!CALL MPPDB_CHECK3D(ZRHODJV,"VERDYN::ZRHODJV",PRECISION)
+!
+!20131104 add check
+CALL MPPDB_CHECK3D(ZRHODJU,"VERDYN3-after extrapol::ZRHODJU",PRECISION)
+CALL MPPDB_CHECK3D(ZRHODJV,"VERDYN3-after extrapol::ZRHODJV",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -269,16 +298,30 @@ ALLOCATE(XUT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
ALLOCATE(XVT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
ALLOCATE(XWT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
!
+!20131104 add check on xpabsm
+CALL MPPDB_CHECK3D(XPABST,"VER_DYN4::XPABST",PRECISION)
+CALL MPPDB_CHECK3D(XTHT,"VER_DYN4::XTHT",PRECISION)
+!
ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
/(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
!
+CALL MPPDB_CHECK3D(ZRHOD,"VER_DYN4::ZRHOD",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHOD)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!
XUT(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
XVT(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XUT)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XVT)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
CALL EXTRAPOL('W',XUT)
CALL EXTRAPOL('S',XVT)
-!
+CALL MPPDB_CHECK3D(XUT,"VER_DYN4-after extrapol::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"VER_DYN4-after extrapol::XVT",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -294,12 +337,43 @@ IF( HATMFILETYPE == 'MESONH' ) THEN
ALLOCATE(XLSUM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
ALLOCATE(XLSVM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
!
+ !20131104 add check on zrhodua, zrhodju
+ CALL MPPDB_CHECK3D(ZRHODUA,"VER_DYN5::ZRHODUA",PRECISION)
+ CALL MPPDB_CHECK3D(ZRHODJU,"VER_DYN5::ZRHODJU",PRECISION)
+ !
+ !20131105 add UPDATE_HALO on ZRHODUA, ZRHODVA and PJ(needed): ok ZRHODJU,V
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODUA)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODVA)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PJ)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
ZRHODJU(:,:,:)=MXM(ZRHODUA(:,:,:)*PJ(:,:,:))
ZRHODJV(:,:,:)=MYM(ZRHODVA(:,:,:)*PJ(:,:,:))
!
+ !20131112 add update_halo_ll though checking on vars is correct
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODJU)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHODJV)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !20131105 add UPDATE_HALO on ZRHOD
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZRHOD)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
XLSUM(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
XLSVM(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
!
+ !20131112 add update_halo_ll though checking on vars is correct
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XLSUM)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XLSVM)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131126 add check on XLSUN, XLSVM
+ CALL MPPDB_CHECK3D(XLSUM,"VER_DYN5-beforeextrapol::XLSUM",PRECISION)
+ CALL MPPDB_CHECK3D(XLSVM,"VER_DYN5-beforeextrapol::XLSVM",PRECISION)
+ !
END IF
!
!-------------------------------------------------------------------------------
@@ -316,6 +390,10 @@ IF ( HATMFILETYPE == 'MESONH' ) THEN
XLSWM(:,:,:)=VER_INTERP_LIN(PLSW_MX(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
END IF
!
+!20131126 add check on XWM,XLSWM
+CALL MPPDB_CHECK3D(XWT,"VER_DYN5::XWT",PRECISION)
+CALL MPPDB_CHECK3D(XLSWM,"VER_DYN5::XLSWM",PRECISION)
+!
DEALLOCATE(NKLIN)
DEALLOCATE(XCOEFLIN)
!
@@ -326,6 +404,14 @@ ZCOEF(:,:,:)=( XZZ(:,:,:) -SPREAD(XZZ(:,:,IKB),3,IKU)) &
XWT(:,:,:)=XWT(:,:,:)*MAX(MIN( (4.-4.*ZCOEF(:,:,:)) ,1.),0.)
!-------------------------------------------------------------------------------
!
+!20131112 add update_halo_ll though checking on vars is correct
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZCOEF)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XWT)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!------------------------------------------------------------------------------
+!
!* 6. STORAGE OF LARGE SCALE FIELDS
! ------------------------------
!
@@ -350,7 +436,11 @@ CALL EXTRAPOL('W',XLSUM)
CALL EXTRAPOL('E',XLSUM)
CALL EXTRAPOL('S',XLSVM)
CALL EXTRAPOL('E',XLSVM)
-
+!
+!20131126 add check on XLSUN, XLSVM
+CALL MPPDB_CHECK3D(XLSUM,"VER_DYN5-afterextrapol::XLSUM",PRECISION)
+CALL MPPDB_CHECK3D(XLSVM,"VER_DYN5-afterextrapol::XLSVM",PRECISION)
+!
! FROM PREP_IDEAL_CASE
!
! 3D case
@@ -418,6 +508,15 @@ IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
ENDIF
!
+
+CALL MPPDB_CHECKLB(XLBXUM,"ver_dyn::XLBXUM::",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBXVM,"ver_dyn::XLBXVM::",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBXWM,"ver_dyn::XLBXWM::",PRECISION,'LBXU',NRIMX)
+
+
+CALL MPPDB_CHECKLB(XLBYUM,"ver_dyn::XLBYUM::",PRECISION,'LBYV',NRIMY)
+CALL MPPDB_CHECKLB(XLBYVM,"ver_dyn::XLBYVM::",PRECISION,'LBYV',NRIMY)
+CALL MPPDB_CHECKLB(XLBYWM,"ver_dyn::XLBYWM::",PRECISION,'LBYV',NRIMY)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ver_int_thermo.f90 b/src/MNH/ver_int_thermo.f90
index 85e22d053b79fe243102476a5150968c482884ab..29f1bf8aa7394ef432e75c481f58a54711627867 100644
--- a/src/MNH/ver_int_thermo.f90
+++ b/src/MNH/ver_int_thermo.f90
@@ -133,6 +133,8 @@ END MODULE MODI_VER_INT_THERMO
!! interpolation routine
!! 26/01/98 (J. Stein) add the LS fields' treatment
!! 24/04/2014 (J.escobar) bypass CRAY internal compiler error on IIJ computation
+!! 2014 (M.Faivre)
+!! 08/2015 (M.Moge) add UPDATE_HALO_ll(PR(:,:,:,1)) in part 6.3
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -163,6 +165,9 @@ USE MODE_EXTRAPOL
!JUAN REALZ
USE MODI_SECOND_MNH
!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -254,7 +259,12 @@ REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3))&
! ! points in the MESO-NH grid.
INTEGER :: JRR ! counter for moist variables
INTEGER,DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) :: IJCOUNT
-!-------------------------------------------------------------------------------
+!
+!20131113 add vars related to ADD3DFIELD and UPDATE_HALO
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+!
+!------------------------------------------------------------------------------
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
!
@@ -289,7 +299,15 @@ END IF
CALL COMPUTE_EXNER_FROM_TOP(PTHV_MX,PZFLUX_MX,PEXNTOP2D,ZHEXN_MX,ZHEXNMASS_MX)
!
ZP_MX(:,:,:)=PPMHP_MX(:,:,:) + XP00 * ZHEXNMASS_MX(:,:,:) ** (XCPD/XRD)
-
+!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZP_MX,"ver_int_thermo2a::ZP_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZP_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZP_MX,"ver_int_thermo2a::ZP_MX",PRECISION)
+!
CALL EXTRAPOL('E',ZP_MX)
CALL MPPDB_CHECK3D(ZP_MX,"VER_INT_THERMO:ZP_MX",PRECISION)
!
@@ -298,11 +316,27 @@ CALL MPPDB_CHECK3D(ZP_MX,"VER_INT_THERMO:ZP_MX",PRECISION)
!
ZEXNMASS_MX(:,:,:)= (ZP_MX(:,:,:)/XP00) ** (XRD/XCPD)
!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZEXNMASS_MX,"ver_int_thermo2a::ZEXNMASS_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZEXNMASS_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZEXNMASS_MX,"ver_int_thermo2a::ZEXNMASS_MX",PRECISION)
+!
!* 2.3 shift
! -----
!
ZPMHPOHP_SH(:,:,:) = PPMHP_MX(:,:,:) / (XP00*ZHEXNMASS_MX(:,:,:) ** (XCPD/XRD))
!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZPMHPOHP_SH,"ver_int_thermo2a::ZPMHPOHP_SH",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZPMHPOHP_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZPMHPOHP_SH,"ver_int_thermo2a::ZPMHPOHP_SH",PRECISION)
+!
!-------------------------------------------------------------------------------
!
!* 3. SHIFT OF THETAV
@@ -322,15 +356,37 @@ CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),PZMASS_MX(:,:,:))
ZTHV_FREE_MX(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"VER_INT_THERMO:ZTHV_FREE_MX",PRECISION)
!
-
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo3a::ZTHV_FREE_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTHV_FREE_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo2a::ZTHV_FREE_MX",PRECISION)
+!
CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),ZZMASS_SH(:,:,:))
ZTHV_FREE_SH(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"VER_INT_THERMO:ZTHV_FREE_SH",PRECISION)
!
-!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo3a::ZTHV_FREE_SH",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTHV_FREE_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo2a::ZTHV_FREE_SH",PRECISION)
!
ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo3a::ZTHV_SH",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTHV_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo2a::ZTHV_SH",PRECISION)
+!
+!
!-------------------------------------------------------------------------------
!
!* 4. SHIFT OF RELATIVE HUMIDITY
@@ -341,10 +397,36 @@ ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
!
ZRV_MX(:,:,:)=MAX(PR_MX(:,:,:,1),1.E-10)
ZTH_MX(:,:,:)=PTHV_MX(:,:,:)*(1.+WATER_SUM(PR_MX(:,:,:,:)))/(1.+XRV/XRD*ZRV_MX(:,:,:))
+!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4a::ZTH_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTH_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4b::ZTH_MX",PRECISION)
+!
ZT_MX(:,:,:)=ZTH_MX(:,:,:)*ZEXNMASS_MX(:,:,:)
+!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4a::ZT_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZT_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4b::ZT_MX",PRECISION)
+!
ZES_MX(:,:,:)=SM_FOES(ZT_MX(:,:,:))
ZHU_MX(:,:,:)=100.*ZP_MX(:,:,:)/(XRD/XRV/ZRV_MX(:,:,:)+1.)/ZES_MX(:,:,:)
!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZHU_MX,"ver_int_thermo4a::ZHU_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZHU_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZHU_MX,"ver_int_thermo4b::ZHU_MX",PRECISION)
+!
!* 4.2 Computation of the relative humidity on the shifted grid
! --------------------------------------------------------
!
@@ -362,6 +444,15 @@ CALL COMPUTE_EXNER_FROM_TOP(ZTHV_SH,ZZFLUX_SH,PEXNTOP2D,ZHEXNFLUX_SH,ZHEXNMASS_S
CALL EXTRAPOL('E',ZHEXNMASS_SH)
!
ZPMASS_SH(:,:,:)= (ZPMHPOHP_SH(:,:,:)+1.) * XP00 * ZHEXNMASS_SH(:,:,:)**(XCPD/XRD)
+!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZPMASS_SH,"ver_int_thermo4a::ZPMASS_SH",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZPMASS_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZPMASS_SH,"ver_int_thermo4b::ZPMASS_SH",PRECISION)
+!
CALL EXTRAPOL('E',ZPMASS_SH)
CALL MPPDB_CHECK3D(ZPMASS_SH,"VER_INT_THERMO:ZPMASS_SH",PRECISION)
!
@@ -369,6 +460,13 @@ CALL MPPDB_CHECK3D(ZPMASS_SH,"VER_INT_THERMO:ZPMASS_SH",PRECISION)
ZPMHP_SH(:,:,:) = ZPMASS_SH(:,:,:) - XP00 * ZHEXNMASS_SH(:,:,:) ** (XCPD/XRD)
CALL MPPDB_CHECK3D(ZPMHP_SH,"VER_INT_THERMO:ZPMHP_SH",PRECISION)
!
+!20131113 add update_halo here
+CALL MPPDB_CHECK3D(ZPMHP_SH,"ver_int_thermo4a::ZPMHP_SH",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZPMHP_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZPMHP_SH,"ver_int_thermo4b::ZPMHP_SH",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -387,6 +485,15 @@ CALL SECOND_MNH(ZTIME1)
!
IF (NVERB>4) THEN
ZTV_SH(:,:,:)=ZTHV_SH(:,:,:)*(ZPMASS_SH(:,:,:)/XP00)**(XRD/XCPD)
+ !
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTV_SH,"ver_int_thermo5a::ZTV_SH",PRECISION)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTV_SH)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131113 check3d
+ CALL MPPDB_CHECK3D(ZTV_SH,"ver_int_thermo5b::ZTV_SH",PRECISION)
+!
ZR_SH(:,:,:,1)=SM_PMR_HU(CLUOUT0,ZPMASS_SH(:,:,:),ZTV_SH(:,:,:),ZHU_SH(:,:,:),&
ZR_SH(:,:,:,:),KITERMAX=100)
CALL RMS_AT_Z(PTHV_MX/(1.+XRV/XRD*PR_MX(:,:,:,1))*(1.+WATER_SUM(PR_MX(:,:,:,:))), &
@@ -407,12 +514,20 @@ PDIAG = ZTIME2 - ZTIME1
!* 6.1 Altitude of the mass points on the MESO-NH grid
! -----------------------------------------------
!
+!20140217 upgrade shuman fct MZF
+!$ZZMASS(:,:,:)=MZF(XZZ(:,:,:))
ZZMASS(:,:,:)=MZF(1,IKU,1,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)
!
!* 6.2 Interpolation on the MESO-NH grid
! ---------------------------------
!
+!20131113 check 2VARS
+CALL MPPDB_CHECK3D(ZZMASS_SH,"ver_int_thermo6::ZZMASS_SH",PRECISION)
+CALL MPPDB_CHECK3D(ZZMASS,"ver_int_thermo6::ZZMASS",PRECISION)
+!
CALL COEF_VER_INTERP_LIN(ZZMASS_SH(:,:,:),ZZMASS(:,:,:))
!
!
@@ -436,9 +551,20 @@ END DO
CALL COMPUTE_EXNER_FROM_TOP(PTHV,XZZ,PEXNTOP2D,ZHEXN,ZHEXNMASS)
ZP(:,:,:) = PPMHP(:,:,:) + XP00 * ZHEXNMASS(:,:,:) ** (XCPD/XRD)
!
+!20131113 add update_halo here
+!CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6a::ZP",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZP)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6b::ZP",PRECISION)
+!
PR(:,:,:,1)=SM_PMR_HU(CLUOUT0,ZP(:,:,:), &
PTHV(:,:,:)*(ZP(:,:,:)/XP00)**(XRD/XCPD), &
ZHU(:,:,:),PR(:,:,:,:),KITERMAX=100)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,PR(:,:,:,1))
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
!
!* 6.4 Interpolate the Large Scale fields
! ----------------------------------
diff --git a/src/MNH/ver_interp_field.f90 b/src/MNH/ver_interp_field.f90
index 4624368013100e92626b4773aba545755a6e4053..92759dcb65ef518cfd6afdb2b4060d46f7f31693 100644
--- a/src/MNH/ver_interp_field.f90
+++ b/src/MNH/ver_interp_field.f90
@@ -85,6 +85,7 @@ END MODULE MODI_VER_INTERP_FIELD
!! Original 17/07/97
!! 14/09/97 (V. Masson) Interpolation of relative humidity
!! 05/06 Remobe KEPS
+!! 2014 (M.Faivre)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -98,6 +99,14 @@ USE MODD_VER_INTERP_LIN
USE MODI_SHUMAN
USE MODI_COEF_VER_INTERP_LIN
USE MODI_VER_INTERP_LIN
+!$20140709
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_FIELD_n ! modules relative to the outer model $n
+USE MODD_LSFIELD_n
+USE MODE_MPPDB
+!$20140710
+USE MODE_ll
+USE MODD_LBC_n
!
IMPLICIT NONE
!
@@ -126,6 +135,12 @@ INTEGER :: JRR, JSV
INTEGER :: IKU
INTEGER :: IKB
REAL, DIMENSION(SIZE(PZZ_LS,1),SIZE(PZZ_LS,2),SIZE(PZZ_LS,3)) :: ZGRID1, ZGRID2
+!$20140709
+TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of LS fields
+INTEGER :: IINFO_ll
+!$20140710
+INTEGER JI,JJ,IIB,IJB,IIE,IJE
+!
!-------------------------------------------------------------------------------
!
!* 1. Prologue
@@ -134,6 +149,8 @@ REAL, DIMENSION(SIZE(PZZ_LS,1),SIZE(PZZ_LS,2),SIZE(PZZ_LS,3)) :: ZGRID1, ZGRID2
IKU=SIZE(PZZ,3)
!
IKB=1+JPVEXT
+!$20140710
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
!-------------------------------------------------------------------------------
!
@@ -150,16 +167,37 @@ ZGRID2(:,:,:)=MZF(1,IKU,1,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))
+!$20140710
+CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDbefMXM:ZGRID1",PRECISION)
+CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDbefMXM:ZGRID2",PRECISION)
!* shift to U points
+!$20140710pb with MXM,MYM: MPPDB pb
+!$if cancel MXM, MYM then PUM,PVM are ok
ZGRID1(:,:,:)=MXM(ZGRID1(:,:,:))
-ZGRID1(1,:,:)=2.*ZGRID1(2,:,:)-ZGRID1(3,:,:)
ZGRID2(:,:,:)=MXM(ZGRID2(:,:,:))
-ZGRID2(1,:,:)=2.*ZGRID2(2,:,:)-ZGRID2(3,:,:)
-!
+DO JI=JPHEXT,1,-1
+ ZGRID1(JI,:,:)=2.*ZGRID1(JI+1,:,:)-ZGRID1(JI+2,:,:)
+ ZGRID2(JI,:,:)=2.*ZGRID2(JI+1,:,:)-ZGRID2(JI+2,:,:)
+ENDDO
+!$20140710 update_halo
+NULLIFY(TZLSFIELD_ll)
+CALL ADD3DFIELD_ll(TZLSFIELD_ll,ZGRID1)
+CALL ADD3DFIELD_ll(TZLSFIELD_ll,ZGRID2)
+CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZLSFIELD_ll)
+!
+!$20140710
+CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDaftMXM:ZGRID1",PRECISION)
+CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDaftMXM:ZGRID2",PRECISION)
+!
+!$20140710 add NKLIN and XCOEFLIN in COEF_VER_INTERP
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
PUT (:,:,:) = VER_INTERP_LIN(PUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSUM (:,:,:) = VER_INTERP_LIN(PLSUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!$20140709
+CALL MPPDB_CHECK3D(PUT,"VERINTERPFIELD:PUT",PRECISION)
+!$
!
!* 2.2 V component
! -----------
@@ -172,15 +210,28 @@ 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))
!* shift to V points
+
ZGRID1(:,:,:)=MYM(ZGRID1(:,:,:))
-ZGRID1(:,1,:)=2.*ZGRID1(:,2,:)-ZGRID1(:,3,:)
ZGRID2(:,:,:)=MYM(ZGRID2(:,:,:))
-ZGRID2(:,1,:)=2.*ZGRID2(:,2,:)-ZGRID2(:,3,:)
-!
+DO JJ=JPHEXT,1,-1
+ ZGRID1(:,JJ,:)=2.*ZGRID1(:,JJ+1,:)-ZGRID1(:,JJ+2,:)
+ ZGRID2(:,JJ,:)=2.*ZGRID2(:,JJ+1,:)-ZGRID2(:,JJ+2,:)
+ENDDO
+!$20140711 updatehalo(zg1,2) also here
+NULLIFY(TZLSFIELD_ll)
+CALL ADD3DFIELD_ll(TZLSFIELD_ll,ZGRID1)
+CALL ADD3DFIELD_ll(TZLSFIELD_ll,ZGRID2)
+CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZLSFIELD_ll)
+!$
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
+!$20140710
+CALL MPPDB_CHECK3D(XCOEFLIN,"VERINTERPFIELDaftVerinterplin:XCOEFLIN",PRECISION)
PVT (:,:,:) = VER_INTERP_LIN(PVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSVM (:,:,:) = VER_INTERP_LIN(PLSVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!$20140710
+CALL MPPDB_CHECK3D(PVT,"VERINTERPFIELDaftVerinterplin:PVT",PRECISION)
!
!* 2.3 W component
! -----------
diff --git a/src/MNH/ver_interp_to_mixed_grid.f90 b/src/MNH/ver_interp_to_mixed_grid.f90
index 75c09fd95cb13ad3e5f76923c805f20ad45c8b1f..dbb9f1cc9337b112ae66104836b70a73a36d218f 100644
--- a/src/MNH/ver_interp_to_mixed_grid.f90
+++ b/src/MNH/ver_interp_to_mixed_grid.f90
@@ -162,6 +162,7 @@ END MODULE MODI_VER_INTERP_TO_MIXED_GRID
!! 20/05/06 Remove EPS
!! 10/04/2014 (J.Escobar & M.Faivre ) add reprod_sum on XEXNTOP
!! 24/04/2014 (J.escobar) bypass CRAY internal compiler error on IIJ computation
+!! 2014 (M.Faivre)
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -190,6 +191,11 @@ USE MODD_PARAMETERS
USE MODD_PARAM_n
USE MODD_VER_INTERP_LIN
USE MODD_PREP_REAL
+!20131028 add MODD_DIMn to use NIMAX,JMAX
+USE MODD_DIM_n
+USE MODD_PGDDIM
+!20131028 add REPRO_SUM
+USE MODE_REPRO_SUM
!JUAN REALZ
USE MODE_ll
USE MODE_EXTRAPOL
@@ -251,7 +257,6 @@ REAL,DIMENSION(:,:,:), ALLOCATABLE:: ZZFLUX_MX,ZZMASS_MX
REAL :: ZCOUNT
INTEGER :: IINFO_ll
!JUAN REALZ
-INTEGER,DIMENSION(SIZE(PZMASS_LS,1),SIZE(PZMASS_LS,2)) :: IJCOUNT
!-------------------------------------------------------------------------------
!
@@ -415,13 +420,13 @@ IF (HFILE=='ATM ') THEN
!
!!$ XEXNTOP=SUM(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/FLOAT((IIE-IIB+1)*(IJE-IJB+1))
!JUAN REALZ
-!!$ XEXNTOP = SUM(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))
-!!$ CALL REDUCESUM_ll(XEXNTOP,IINFO_ll)
- XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))
-!
- ZCOUNT = FLOAT((IIE-IIB+1)*(IJE-IJB+1))
+!!! XEXNTOP = SUM(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))
+!20131028 in Mymodif --> 20131129 in MNHorig
+XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))
+ZCOUNT = FLOAT((IIE-IIB+1)*(IJE-IJB+1))
+!$20140227 disable reduce no xexntop !!
+!$ CALL REDUCESUM_ll(XEXNTOP,IINFO_ll)
CALL REDUCESUM_ll(ZCOUNT,IINFO_ll)
-!
XEXNTOP = XEXNTOP / ZCOUNT
!JUAN REALZ
@@ -445,11 +450,12 @@ IF (HFILE=='ATM ') THEN
!
IF (NVERB>=1 .AND. ANY(XZHAT>=5000.) ) THEN
IK4000 = COUNT(XZHAT(:)<4000.)
- IJCOUNT(IIB:IIE,IJB:IJE) = COUNT((ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
- >=MAXVAL(ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01),DIM=3 )
- IIJ = MAXLOC( SUM(ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
- MASK=( IJCOUNT(IIB:IIE,IJB:IJE) >=1 ) ) &
- + JPHEXT
+ IK4000 = COUNT(XZHAT(:)<4000.)
+ IIJ = MAXLOC( SUM(ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
+ MASK=COUNT(ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
+ >=MAXVAL(ZHU_MX(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
+ >=1 ) &
+ + JPHEXT
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'Altitude and humidity on large-scale grid (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=1,ILU
diff --git a/src/MNH/ver_prep_mesonh_case.f90 b/src/MNH/ver_prep_mesonh_case.f90
index 8ff112327174148d2ec7adaff2f2ce0fc11bbde0..f214972241a06695b306510da73a6b4e96a3d20d 100644
--- a/src/MNH/ver_prep_mesonh_case.f90
+++ b/src/MNH/ver_prep_mesonh_case.f90
@@ -82,6 +82,7 @@ END MODULE MODI_VER_PREP_MESONH_CASE
!! Jun, 10 1997 (V. Masson) add non-hydrostatic pressure
!! Jul, 10 1997 (V. Masson) add epsilon
!! Jul, 11 1997 (V. Masson) add scalar variables
+!! 2014 (M.Faivre) parallelization
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -108,6 +109,12 @@ USE MODD_PREP_REAL
USE MODI_SECOND_MNH
USE MODE_ll
!
+!20131104 check on 3D VARS
+USE MODE_MPPDB
+!20131112 add update_halo_ll
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -133,6 +140,9 @@ REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNFLUX_MX! hyd. pressure function
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNMASS_MX! hyd. pressure function
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPMASS_MX ! pressure
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK ! work array
+!20131105 add vars related to ADD3DFIELD and UPDATE_HALO
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
!
INTEGER :: IIB,IJB,IIE,IJE
!-------------------------------------------------------------------------------
@@ -155,18 +165,39 @@ ALLOCATE(XZMASS_LS(IIU,IJU,ILU))
!
XTHV_LS(:,:,:)=XTH_LS(:,:,:)*(1.+XRV/XRD*XR_LS(:,:,:,1))/(1.+WATER_SUM(XR_LS(:,:,:,:)))
!
+!20131112 add update_halo for this type of calculation
+CALL ADD3DFIELD_ll(TZFIELDS_ll, XTHV_LS)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(XTHV_LS,"ver_prep_mesonh_case1.1::XTHV_LS",PRECISION)
+!
!* 1.2 Altitudes
! ---------
!
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(:,:,:))
+!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)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(XZMASS_LS,"ver_prep_mesonh_case1.2b::XZMASS_LS",PRECISION)
+!
XZMASS_LS(:,:,SIZE(XZMASS_LS,3))=1.5*XZFLUX_LS(:,:,SIZE(XZFLUX_LS,3) ) &
-0.5*XZFLUX_LS(:,:,SIZE(XZFLUX_LS,3)-1)
!
!* 1.3 Winds on Arakawa A grid
! -----------------------
!
+!20131104 check XU_LS calculated in read_prc_fmfile before any changes in
+!ver_prep_mesonh_case
+CALL MPPDB_CHECK3D(XU_LS,"ver_prep_mesonh_case1.3::XU_LS",PRECISION)
+!
ALLOCATE(ZWORK(IIU,IJU,ILU))
ZWORK = XU_LS
XU_LS(1:IIU-1,:,:)=0.5*ZWORK(2:IIU,:,:)+0.5*ZWORK(1:IIU-1,:,:)
@@ -200,11 +231,35 @@ ALLOCATE(ZHEXNFLUX_LS(IIU,IJU,ILU))
ALLOCATE(XPMHP_LS(IIU,IJU,ILU))
ZHEXNSURF2D(:,:)=(XPS_LS(:,:)/XP00)**(XRD/XCPD)
!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK2D(ZHEXNSURF2D,"ver_prep_mesonh_case1.5::ZHEXNSURF2D",PRECISION)
+CALL ADD2DFIELD_ll(TZFIELDS_ll, ZHEXNSURF2D)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check2d
+CALL MPPDB_CHECK2D(ZHEXNSURF2D,"ver_prep_mesonh_case1.5::ZHEXNSURF2D",PRECISION)
+!
CALL COMPUTE_EXNER_FROM_GROUND(XTHV_LS,XZFLUX_LS,ZHEXNSURF2D,ZHEXNFLUX_LS,ZHEXNMASS_LS)
ZHPMASS_LS(:,:,:)=XP00*(ZHEXNMASS_LS(:,:,:))**(XCPD/XRD)
!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(ZHPMASS_LS,"ver_prep_mesonh_case1.5a::ZHPMASS_LS",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZHPMASS_LS)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZHPMASS_LS,"ver_prep_mesonh_case1.5b::ZHPMASS_LS",PRECISION)
+!
XPMHP_LS(:,:,:)=XPMASS_LS(:,:,:)-ZHPMASS_LS(:,:,:)
!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(XPMHP_LS,"ver_prep_mesonh_case1.5c::XPMHP_LS",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XPMHP_LS)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(XPMHP_LS,"ver_prep_mesonh_case1.5d::XPMHP_LS",PRECISION)
+!
DEALLOCATE(ZHPMASS_LS)
DEALLOCATE(ZHEXNSURF2D)
DEALLOCATE(ZHEXNFLUX_LS)
@@ -220,14 +275,34 @@ ZES_LS(:,:,:)=SM_FOES( XTHV_LS(:,:,:) &
*(1.+WATER_SUM(XR_LS(:,:,:,:))) &
/(1.+XRV/XRD*XR_LS(:,:,:,1)) &
*(XPMASS_LS(:,:,:)/XP00)**(XRD/XCPD) )
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(ZES_LS,"ver_prep_mesonh_case1.6a::ZES_LS",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZES_LS)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZES_LS,"ver_prep_mesonh_case1.6b::ZES_LS",PRECISION)
+!
XHU_LS(:,:,:)=100.*XPMASS_LS(:,:,:)/(XRD/XRV/MAX(XR_LS(:,:,:,1),1.E-12)+1.)/ZES_LS(:,:,:)
!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(XHU_LS,"ver_prep_mesonh_case1.6c::XHU_LS",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XHU_LS)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(XHU_LS,"ver_prep_mesonh_case1.6d::XHU_LS",PRECISION)
+!
DEALLOCATE(ZES_LS)
!-------------------------------------------------------------------------------
!
!* 2. INTERPOLATION TO MIXED GRID AND DIAGNOSTIC VARIABLES
! ----------------------------------------------------
!
+!20131104 add check on XU_LS : IN arg of ver_interp_to_mixed in calculation of
+!XU_MX
+CALL MPPDB_CHECK3D(XU_LS,"ver_prep_mesonh_case2::XU_LS",PRECISION)
+!
CALL VER_INTERP_TO_MIXED_GRID('ATM ',.FALSE.,XZS_LS,XZSMT_LS, &
XZMASS_LS,XSV_LS,XZFLUX_LS,XPS_LS,XPMHP_LS, &
XTHV_LS,XR_LS,XHU_LS,XTKE_LS, &
@@ -244,6 +319,14 @@ IF (NVERB>=5) THEN
!
ALLOCATE(ZTH_MX(SIZE(XTHV_MX,1),SIZE(XTHV_MX,2),SIZE(XTHV_MX,3)))
ZTH_MX(:,:,:)=XTHV_MX(:,:,:)/(1.+XRV/XRD*XR_MX(:,:,:,1))*(1.+WATER_SUM(XR_MX(:,:,:,:)))
+!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(ZTH_MX,"ver_prep_mesonh_case3a::ZTH_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTH_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZTH_MX,"ver_prep_mesonh_case3b::ZTH_MX",PRECISION)
!
CALL RMS_AT_Z(XTH_LS,XZS_LS,XZMASS_LS,ZTH_MX,XZS_LS,XZMASS_MX, &
'RMS on theta between input Mesonh grid and mixed grid (K): ')
@@ -253,6 +336,14 @@ IF (NVERB>=5) THEN
ALLOCATE(ZHEXNFLUX_MX(SIZE(XTHV_MX,1),SIZE(XTHV_MX,2),SIZE(XTHV_MX,3)))
CALL COMPUTE_EXNER_FROM_TOP(XTHV_MX,XZFLUX_MX,XEXNTOP2D,ZHEXNFLUX_MX,ZHEXNMASS_MX)
ZPMASS_MX(:,:,:)=XP00*(ZHEXNMASS_MX(:,:,:))**(XCPD/XRD) + XPMHP_MX(:,:,:)
+!
+!20131112 add update_halo for this type of calculation
+CALL MPPDB_CHECK3D(ZPMASS_MX,"ver_prep_mesonh_case3c::ZPMASS_MX",PRECISION)
+CALL ADD3DFIELD_ll(TZFIELDS_ll,ZPMASS_MX)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!20131112 check3d
+CALL MPPDB_CHECK3D(ZPMASS_MX,"ver_prep_mesonh_case3d::ZPMASS_MX",PRECISION)
!
CALL RMS_AT_Z(XPMASS_LS,XZS_LS,XZMASS_LS,ZPMASS_MX,XZS_LS,XZMASS_MX, &
'RMS on pressure between input Mesonh grid and mixed grid (Pa): ')
diff --git a/src/MNH/ver_thermo.f90 b/src/MNH/ver_thermo.f90
index 7cfff4243073c6f2551813697795df95cff4ca88..29fbd754d42f20aba2675b1348881ae5f94aa1f7 100644
--- a/src/MNH/ver_thermo.f90
+++ b/src/MNH/ver_thermo.f90
@@ -145,6 +145,10 @@ END MODULE MODI_VER_THERMO
!! Jun. 06, 2006 (Mallet) replace DRY_MASS by TOTAL_DMASS
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 2014 (M.Faivre)
+!! 08/2015 (M.Moge) removing UPDATE_HALO_ll on
+!! XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ
+!! because we now do it in SET_REF
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-------------------------------------------------------------------------------
!
@@ -179,6 +183,8 @@ USE MODE_MPPDB
USE MODE_ll
USE MODE_EXTRAPOL
!
+!20131113
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
IMPLICIT NONE
!
@@ -271,6 +277,12 @@ END IF
!
XTHT(:,:,:)=ZTHV(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
!
+!20131113 add update_halo here
+CALL ADD3DFIELD_ll(TZFIELDS_ll,XTHT )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+CALL MPPDB_CHECK3D(XTHT,"PGDFILTER9:XTHT",PRECISION)
+!
ZTHV(:,:,1)=ZTHV(:,:,2)
XTHT(:,:,1)=XTHT(:,:,2)
XRT(:,:,1,:)=XRT(:,:,2,:)
@@ -299,10 +311,13 @@ END IF
!* 2. COMPUTATION OF 1D REFERENCE STATE VARIABLES
! -------------------------------------------
!
+CALL MPPDB_CHECK3D(ZTHV,"VERTHERMO bef set_refz::ZTHV",PRECISION)
+CALL MPPDB_CHECK3D(XRT(:,:,:,1),"VERTHERMO bef set_refz::XRT",PRECISION)
+!
CALL SET_REFZ(ZTHV,XRT(:,:,:,1))
-CALL MPPDB_CHECK3D(ZTHV,"VERTHERMO::ZTHV",PRECISION)
-CALL MPPDB_CHECK3D(XRT(:,:,:,1),"VERTHERMO::XRT",PRECISION)
+CALL MPPDB_CHECK3D(ZTHV,"VERTHERMO aft set_refz::ZTHV",PRECISION)
+CALL MPPDB_CHECK3D(XRT(:,:,:,1),"VERTHERMO: aft set_refz:XRT",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -314,18 +329,11 @@ ALLOCATE(XTHVREF(IIU,IJU,IKU))
ALLOCATE(XRVREF(IIU,IJU,IKU))
ALLOCATE(XEXNREF(IIU,IJU,IKU))
ALLOCATE(XRHODJ(IIU,IJU,IKU))
+XRVREF(:,:,:) = 0.
CALL SET_REF(0,'NIL',CLUOUT0,XZZ,XZHAT,PJ,PDXX,PDYY,CLBCX,CLBCY, &
XREFMASS,XMASS_O_PHI0,XLINMASS,XRHODREF,XTHVREF,XRVREF, &
XEXNREF,XRHODJ)
-CALL ADD3DFIELD_ll(TZFIELDS_ll, XRHODREF)
-CALL ADD3DFIELD_ll(TZFIELDS_ll, XTHVREF)
-CALL ADD3DFIELD_ll(TZFIELDS_ll, XRVREF)
-CALL ADD3DFIELD_ll(TZFIELDS_ll, XEXNREF)
-CALL ADD3DFIELD_ll(TZFIELDS_ll, XRHODJ)
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-
CALL MPPDB_CHECK3D(XRHODREF,"VERTHERMO::XRHODREF",PRECISION)
CALL MPPDB_CHECK3D(XTHVREF,"VERTHERMO::XTHVREF",PRECISION)
CALL MPPDB_CHECK3D(XRVREF,"VERTHERMO::XRVREF",PRECISION)
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index a4026bf578b511470afef378d316e3e0a9c951d5..1eab31e1fa42816fec3b92b20eda87d75dc0153a 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -155,6 +155,7 @@ END MODULE MODI_WRITE_LFIFM_n
!! J. Escobar Mars 2014 , missing YDIR="XY" in 1.6 for tendencies fields
!! J.escobar & M.Leriche 23/06/2014 Pb with JSA increment versus ini_nsv order initialization
!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! M.Faivre 2014
!! C.Lac Dec.2014 writing past wind fields for centred advection
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!!
@@ -235,6 +236,9 @@ USE MODN_NCOUT
USE MODE_UTIL
#endif
!
+!20131128
+USE MODE_MPPDB
+USE MODE_EXTRAPOL
! Modif Eddy fluxes
USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
@@ -636,12 +640,23 @@ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,YDIR,LCOUPLING,IGRID,ILENCH,YCOMMENT,IRESP)
YDIR='XY'
!
!* 1.4.1 Time t:
-!
+!
+!20131128 check XUT-> X_Y_W_U wind component for PRC
+! CALL EXTRAPOL('W',XUT)
+! CALL EXTRAPOL('E',XUT)
+! CALL EXTRAPOL('N',XUT)
+! CALL EXTRAPOL('S',XUT)
+CALL MPPDB_CHECK3D(XUT,"write_lfifmn before FMWRIT::XUT",PRECISION)
+!
YRECFM='UT'
YCOMMENT='X_Y_Z_U component of wind (m/s)'
IGRID=2
ILENCH=LEN(YCOMMENT)
CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,YDIR,XUT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL MPPDB_CHECK3D(XUT,"write_lfifmn after FMWRIT::XUT",PRECISION)
+!
+!20131128 check XVT-> X_Y_W_V wind component for PRC
+CALL MPPDB_CHECK3D(XVT,"write_lfifmn::XVT",PRECISION)
!
YRECFM='VT'
YCOMMENT='X_Y_Z_V component of wind (m/s)'
diff --git a/src/MNH/write_surf_mnh.f90 b/src/MNH/write_surf_mnh.f90
index 2606414dac90136bc9620ba34962bb987274ace8..b0e0d736916551010fc59f0aea57bc0cf28c6e99 100644
--- a/src/MNH/write_surf_mnh.f90
+++ b/src/MNH/write_surf_mnh.f90
@@ -47,6 +47,8 @@
!! YY, XY, DX, DY in 1D or 2D configuration
!! 03/09, G.Tanguy : add write_surft1_mnh
!! replace ZUNDEF(surfex) by XUNDEF(MNH)
+!! 08/2015 M.Moge write the COVERS as 2D fields because SURFEX cannot write/read 3D fields
+!! with Z-splitting using NB_PROC_IO_W / NB_PROC_IO_W
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!----------------------------------------------------------------------------
!
@@ -485,7 +487,10 @@ ELSE
IMASK = NMASK
END IF
!
-GCOVER_PACKED = ( NB_PROCIO_W /= 1 )
+! we write the COVERS as 2D fields because SURFEX cannot write/read 3D fields
+! with Z-splitting using NB_PROC_IO_W / NB_PROC_IO_W, so we do not use GCOVER_PACKED
+!GCOVER_PACKED = ( NB_PROCIO_W /= 1 )
+GCOVER_PACKED = .FALSE.
IGRID=0
YREC='COVER_PACKED'
YCOMMENT=''
diff --git a/src/SURFEX/alloc_surfex.F90 b/src/SURFEX/alloc_surfex.F90
index 2de7b55786a8d624e8a65e1bc3d171e3c7a3d61a..80ec4cf02e7de621f34ebad6c90a29332c85ba8a 100644
--- a/src/SURFEX/alloc_surfex.F90
+++ b/src/SURFEX/alloc_surfex.F90
@@ -91,6 +91,7 @@ USE MODD_WATFLUX_SBL_n, ONLY : WATFLUX_SBL_ALLOC
USE MODD_DIAG_TRIP_n, ONLY : DIAG_TRIP_ALLOC
USE MODD_TRIP_GRID_n, ONLY : TRIP_GRID_ALLOC
USE MODD_TRIP_n, ONLY : TRIP_ALLOC
+USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_ALLOC
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -186,6 +187,7 @@ IF (LHOOK) CALL DR_HOOK('ALLOC_SURFEX',0,ZHOOK_HANDLE)
CALL DIAG_TRIP_ALLOC(KMODEL)
CALL TRIP_GRID_ALLOC(KMODEL)
CALL TRIP_ALLOC(KMODEL)
+ CALL GRID_CONF_PROJ_ALLOC(KMODEL)
IF (LHOOK) CALL DR_HOOK('ALLOC_SURFEX',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/get_surf_grid_dimn.F90 b/src/SURFEX/get_surf_grid_dimn.F90
index 77145c23d7acb93b977dbdebf1881b4548940eb8..6f0a98ada5eaf6cffd2bf40e920713470fafe271 100644
--- a/src/SURFEX/get_surf_grid_dimn.F90
+++ b/src/SURFEX/get_surf_grid_dimn.F90
@@ -3,7 +3,11 @@
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
! #######################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE GET_SURF_GRID_DIM_n(HGRID,ORECT,KDIM1,KDIM2,KGRID_PAR,PGRID_PAR)
+#else
SUBROUTINE GET_SURF_GRID_DIM_n(HGRID,ORECT,KDIM1,KDIM2)
+#endif
! #######################################################
!
!!**** *GET_SURF_GRID_DIM_n* get the grid mesh dimensions
@@ -26,13 +30,18 @@
!! ------------
!!
!! Original 03/2004
+!! M.Moge 02/2015 Passing KGRID_PAR,PGRID_PAR as input parameters, instead of using XGRID_PAR, NGRID_PAR from MODD_SURF_ATM_GRID_n
!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+#ifdef MNH_PARALLEL
+USE MODD_SURF_ATM_GRID_n, ONLY : CGRID
+#else
USE MODD_SURF_ATM_GRID_n, ONLY : CGRID, XGRID_PAR, NGRID_PAR
+#endif
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -48,6 +57,10 @@ IMPLICIT NONE
LOGICAL, INTENT(OUT) :: ORECT ! T if rectangular grid
INTEGER, INTENT(OUT) :: KDIM1 ! 1st dimension
INTEGER, INTENT(OUT) :: KDIM2 ! 2nd dimension
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+#endif
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declaration of other local variables
@@ -58,7 +71,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GET_SURF_GRID_DIM_N',0,ZHOOK_HANDLE)
HGRID = CGRID
!
+#ifdef MNH_PARALLEL
+ CALL GET_GRID_DIM(CGRID,KGRID_PAR,PGRID_PAR,ORECT,KDIM1,KDIM2)
+#else
CALL GET_GRID_DIM(CGRID,NGRID_PAR,XGRID_PAR,ORECT,KDIM1,KDIM2)
+#endif
IF (LHOOK) CALL DR_HOOK('GET_SURF_GRID_DIM_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/get_teb_depths.F90 b/src/SURFEX/get_teb_depths.F90
index 00eca92e4fef71ad93c396bacacc4dc1c4c32197..60c13cfe63a01626e5ee994295b9d0c197b59f3d 100644
--- a/src/SURFEX/get_teb_depths.F90
+++ b/src/SURFEX/get_teb_depths.F90
@@ -52,6 +52,8 @@ USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+USE MODI_READ_COVERS_AND_AV_PGD_1D_ON_LAYERS
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -175,6 +177,9 @@ ELSE
ALLOCATE(ZPAR_D(ILU,IDATA_LAYER))
!* reading of the cover to obtain the thickness of layers
CALL OLD_NAME(HFILEPGDTYPE,'COVER_LIST ',YRECFM)
+#ifdef MNH_PARALLEL
+ CALL READ_COVERS_AND_AV_PGD_1D_ON_LAYERS( HFILEPGDTYPE, YRECFM, ILU, IDATA_LAYER, ZPAR_D, ZDATA, YAREA,'ARI' )
+#else
CALL READ_SURF(HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
!* reading of the cover fractions
ALLOCATE(ZCOVER(ILU,JPCOVER))
@@ -186,6 +191,7 @@ ELSE
CALL AV_PGD (ZPAR_D(:,JLAYER), ZCOVER, ZDATA(:,JLAYER),YAREA,'ARI')
END DO
DEALLOCATE(ZCOVER)
+#endif
ENDIF
!
!* recomputes the grid from the available data
diff --git a/src/SURFEX/grid_from_file.F90 b/src/SURFEX/grid_from_file.F90
index 4e6cdfbeb953a830b1810e09a6a1d6745a50ffa2..5ebc48c02e81713fe04d96199bde892c2407b839 100644
--- a/src/SURFEX/grid_from_file.F90
+++ b/src/SURFEX/grid_from_file.F90
@@ -33,6 +33,8 @@
!! ------------
!!
!! Original 01/2004
+!! M.Moge 02/2015 Parallelization of spawning
+!! M.Moge 04/2015 Parallelization of prep_pgd on son model
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -50,6 +52,11 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_GET_LUOUT
+USE MODD_SURF_ATM_n, ONLY : NDIM_FULL, NSIZE_FULL, NIMAX_SURF_ll, NJMAX_SURF_ll
+!
+#ifdef MNH_PARALLEL
+USE MODE_TOOLS_ll, ONLY : GET_DIM_PHYS_ll
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -71,6 +78,10 @@ INTEGER, INTENT(OUT) :: KL ! number of points on processor
INTEGER :: ILUOUT ! listing file logical unit
INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: IRESP ! return code
+INTEGER :: IIMAX
+INTEGER :: IJMAX
+INTEGER :: IIMAX_LOC
+INTEGER :: IJMAX_LOC
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.3 Declaration of namelists
@@ -97,6 +108,7 @@ IF (LHOOK) CALL DR_HOOK('GRID_FROM_FILE',0,ZHOOK_HANDLE)
! -----------------------------
!
CALL READ_SURF(HFILETYPE,'DIM_FULL ',KL,IRESP)
+ NDIM_FULL = KL
!
!---------------------------------------------------------------------------
!
@@ -110,10 +122,24 @@ IF (LHOOK) CALL DR_HOOK('GRID_FROM_FILE',0,ZHOOK_HANDLE)
!* 5. Reading parameters of the grid
! ------------------------------
!
+ CALL READ_SURF(HPROGRAM,'IMAX ',IIMAX, IRESP,HDIR='H')
+ CALL READ_SURF(HPROGRAM,'JMAX ',IJMAX, IRESP,HDIR='H')
+ NIMAX_SURF_ll = IIMAX
+ NJMAX_SURF_ll = IJMAX
+#ifdef MNH_PARALLEL
+ CALL GET_DIM_PHYS_ll('B',IIMAX_LOC,IJMAX_LOC)
+ NSIZE_FULL = IIMAX_LOC*IJMAX_LOC
+ KL = NSIZE_FULL
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,NSIZE_FULL,.FALSE.,HDIR='H')
+!
+ALLOCATE(PGRID_PAR(KGRID_PAR))
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,NSIZE_FULL,.TRUE.,PGRID_PAR,IRESP,HDIR='H')
+#else
CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,KL,.FALSE.,HDIR='A')
!
ALLOCATE(PGRID_PAR(KGRID_PAR))
CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,KL,.TRUE.,PGRID_PAR,IRESP,HDIR='A')
+#endif
!
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/grid_modif_cartesian.F90 b/src/SURFEX/grid_modif_cartesian.F90
index 39fe8bda4ca9e6c350f13115a2a5af490dbc6a6e..39eb9fae72e0b78d2fcd857705fe2affe363aa94 100644
--- a/src/SURFEX/grid_modif_cartesian.F90
+++ b/src/SURFEX/grid_modif_cartesian.F90
@@ -33,12 +33,16 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 06/2015 Initialization of MODD_SPAWN variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_SURF_PAR, ONLY : NUNDEF
+#ifdef MNH
+USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
+#endif
USE MODE_POS_SURF
USE MODE_GRIDTYPE_CARTESIAN
@@ -112,6 +116,15 @@ NAMELIST/NAM_INIFILE_CARTESIAN/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
IF (LHOOK) CALL DR_HOOK('GRID_MODIF_CARTESIAN',0,ZHOOK_HANDLE)
CALL POSNAM(KLUNAM,'NAM_INIFILE_CARTESIAN',GFOUND,KLUOUT)
IF (GFOUND) READ(UNIT=KLUNAM,NML=NAM_INIFILE_CARTESIAN)
+#ifdef MNH
+! store the parameter in MODD_SPAWN
+NXOR = IXOR
+NYOR = IYOR
+NXSIZE = IXSIZE
+NYSIZE = IYSIZE
+NDXRATIO = IDXRATIO
+NDYRATIO = IDYRATIO
+#endif
!
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/grid_modif_conf_proj.F90 b/src/SURFEX/grid_modif_conf_proj.F90
index ccbed2a8748f819793c5ee0367d6628f9bfb8d19..f56443a58caf1fc02b57cf8b4685a5386ff73673 100644
--- a/src/SURFEX/grid_modif_conf_proj.F90
+++ b/src/SURFEX/grid_modif_conf_proj.F90
@@ -33,12 +33,16 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 06/2015 Initialization of MODD_SPAWN variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_SURF_PAR, ONLY : NUNDEF
+#ifdef MNH
+USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
+#endif
USE MODE_POS_SURF
USE MODE_GRIDTYPE_CONF_PROJ
@@ -121,6 +125,15 @@ NAMELIST/NAM_INIFILE_CONF_PROJ/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
IF (LHOOK) CALL DR_HOOK('GRID_MODIF_CONF_PROJ',0,ZHOOK_HANDLE)
CALL POSNAM(KLUNAM,'NAM_INIFILE_CONF_PROJ',GFOUND,KLUOUT)
IF (GFOUND) READ(UNIT=KLUNAM,NML=NAM_INIFILE_CONF_PROJ)
+#ifdef MNH
+! store the parameter in MODD_SPAWN
+NXOR = IXOR
+NYOR = IYOR
+NXSIZE = IXSIZE
+NYSIZE = IYSIZE
+NDXRATIO = IDXRATIO
+NDYRATIO = IDYRATIO
+#endif
!
!---------------------------------------------------------------------------
!
@@ -152,15 +165,15 @@ IF (IYSIZE==-999) IYSIZE=IJMAX1
!
!* number of points
!
-IIMAX2=IXSIZE*IDXRATIO
-IJMAX2=IYSIZE*IDYRATIO
+IIMAX2=IXSIZE*IDXRATIO !this is the global size of the son grid
+IJMAX2=IYSIZE*IDYRATIO !the local size is computed in REGULAR_GRID_SPAWN, and stored in IIMAX2, IJMAX2
!
KL2 = IIMAX2 * IJMAX2
!
-ALLOCATE(ZX2 (IIMAX2*IJMAX2))
-ALLOCATE(ZY2 (IIMAX2*IJMAX2))
-ALLOCATE(ZDX2(IIMAX2*IJMAX2))
-ALLOCATE(ZDY2(IIMAX2*IJMAX2))
+!ALLOCATE(ZX2 (IIMAX2*IJMAX2))
+!ALLOCATE(ZY2 (IIMAX2*IJMAX2))
+!ALLOCATE(ZDX2(IIMAX2*IJMAX2))
+!ALLOCATE(ZDY2(IIMAX2*IJMAX2))
!
CALL REGULAR_GRID_SPAWN(KLUOUT, &
KL, IIMAX1,IJMAX1,ZX1,ZY1,ZDX1,ZDY1, &
diff --git a/src/SURFEX/hor_interpol_conf_proj.F90 b/src/SURFEX/hor_interpol_conf_proj.F90
index daf85e6d7f7199cccfa61b2f18c132de976e6933..d735d7861d76c5c436b1ef7fb0ea3dd4cb87e9bd 100644
--- a/src/SURFEX/hor_interpol_conf_proj.F90
+++ b/src/SURFEX/hor_interpol_conf_proj.F90
@@ -32,6 +32,7 @@ SUBROUTINE HOR_INTERPOL_CONF_PROJ(KLUOUT,PFIELDIN,PFIELDOUT)
!! not bug in case 2D (this is not the more beautiful
!! method; the BILIN routine should better be adapted)
!! Search ! Ajout MT
+!! 10/02/15 M.Moge using SIZE(PFIELDOUT,1) instead of SIZE(XLAT_OUT)
!-------------------------------------------------------------------------------
!
!
@@ -65,8 +66,8 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN ! input field
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN_DUPLIQUE ! input field ! Ajout MT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELDOUT_DUPLIQUE ! interpolated output field ! Ajout MT
!
-INTEGER :: INO ! output number of points
-INTEGER :: JI,JJ,JL ! loop index
+INTEGER :: INO ! output number of points
+INTEGER :: JI,JJ,JL ! loop index
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -76,7 +77,7 @@ LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_DUPLIQUE ! .true. where physical v
!* 1. Allocations
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CONF_PROJ',0,ZHOOK_HANDLE)
-INO = SIZE(XLAT_OUT)
+INO = SIZE(PFIELDOUT,1)
!
ALLOCATE(ZX (INO))
ALLOCATE(ZY (INO))
@@ -90,7 +91,7 @@ END IF
!* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
!
CALL XY_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATORI,XLONORI, &
- ZX,ZY,XLAT_OUT,XLON_OUT )
+ ZX,ZY,XLAT_OUT,XLON_OUT )
!
!* 3. Put input field on its squared grid
!
diff --git a/src/SURFEX/init_isban.F90 b/src/SURFEX/init_isban.F90
index 2bb3f96a0afd0e97476cc12ac55b3319ebd55b54..031241ccdf6aa0aa51afabf1b3f2ec6624bea9eb 100644
--- a/src/SURFEX/init_isban.F90
+++ b/src/SURFEX/init_isban.F90
@@ -67,7 +67,9 @@ USE MODD_ISBA_n, ONLY : CROUGH ,CISBA, CPHOTO, CRUNOFF, CALBEDO, CSCOND, &
CCPSURF, CHORT, XCGMAX, XCDRAG, CKSAT, &
CSOC, CTOPREG, CRAIN, LSPINUPCARBS, &
LSPINUPCARBW, NNBYEARSOLD, NSPINS, NSPINW, &
- XSPINMAXS, XSPINMAXW, NNBYEARSPINS, NNBYEARSPINW
+ XSPINMAXS, XSPINMAXW, NNBYEARSPINS, NNBYEARSPINW, &
+ XSOILGRID, XDG, NWG_LAYER, LECOCLIMAP, XCOVER, &
+ NGROUND_LAYER
!
USE MODD_CH_ISBA_n, ONLY : LCH_BIO_FLUX, CCH_DRY_DEP
@@ -102,6 +104,7 @@ USE MODI_PREP_CTRL_ISBA
USE MODI_READ_ISBA_DATE
USE MODI_READ_PGD_ISBA_n
USE MODI_COMPUTE_ISBA_PARAMETERS
+USE MODI_CONVERT_COVER_ISBA
USE MODI_READ_NAM_PREP_ISBA_n
!
USE MODI_SET_SURFEX_FILEIN
@@ -326,6 +329,17 @@ ENDIF
!-----------------------------------------------------------------------------------------------------
!
IF (OLAND_USE .OR. HINIT=='PGD') THEN
+ ! ISBA diagnostic PGD fields to improve efficiency in further PREP steps
+ IF (LECOCLIMAP) THEN
+ ALLOCATE(XDG(KI,NGROUND_LAYER,NPATCH))
+ IF (CISBA=='DIF') THEN
+ ALLOCATE(NWG_LAYER(KI,NPATCH))
+ ELSE
+ ALLOCATE(NWG_LAYER(0,0))
+ END IF
+ CALL CONVERT_COVER_ISBA(CISBA,NUNDEF,XCOVER,' ','NAT',PSOILGRID=XSOILGRID,PDG=XDG,KWG_LAYER=NWG_LAYER)
+ END IF
+! end of initialization
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_N',1,ZHOOK_HANDLE)
RETURN
END IF
diff --git a/src/SURFEX/init_surf_atmn.F90 b/src/SURFEX/init_surf_atmn.F90
index c83cdf3de294ac49813f98b345a6f9d198566968..71a3d5bac34b8d33bc288e99a1273f57bbcc2d9f 100644
--- a/src/SURFEX/init_surf_atmn.F90
+++ b/src/SURFEX/init_surf_atmn.F90
@@ -378,10 +378,10 @@ NGRID_PAR=SIZE(XGRID_PAR)
IF (HPROGRAM/='AROME '.AND.NRANK==NPIO) THEN
!
IF (.NOT.ASSOCIATED(XGRID_FULL_PAR)) THEN
- CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.FALSE.,HDIR='A')
+ CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NSIZE_FULL,.FALSE.,HDIR='H')
ALLOCATE(XGRID_FULL_PAR(NGRID_PAR))
- CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.TRUE.,&
- XGRID_FULL_PAR,IRESP,HDIR='A')
+ CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NSIZE_FULL,.TRUE.,&
+ XGRID_FULL_PAR,IRESP,HDIR='H')
ENDIF
!
ENDIF
diff --git a/src/SURFEX/modd_grid_conf_proj.F90 b/src/SURFEX/modd_grid_conf_proj.F90
index b3e1cf7d97c1b9d7f397c62bffe1a16a350c1e0c..b57e4f217966dfb2d959b6f179fe995e32f8a5b0 100644
--- a/src/SURFEX/modd_grid_conf_proj.F90
+++ b/src/SURFEX/modd_grid_conf_proj.F90
@@ -27,24 +27,99 @@
!! MODIFICATIONS
!! -------------
!! Original 20/09/02
+!! M.Faivre 2014
+!! M.Moge 10/2015 fixing bugs from M.Faivre
!
!* 0. DECLARATIONS
! ------------
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-!
+
REAL, DIMENSION(:), ALLOCATABLE :: XX ! X coordinate (meters)
-REAL, DIMENSION(:), ALLOCATABLE :: XY ! Y coordinate (meters)
-INTEGER :: NX ! number of points in X direction
-INTEGER :: NY ! number of points in Y direction
-!
-REAL :: XLAT0 ! reference latitude
-REAL :: XLON0 ! reference longitude
-REAL :: XLATORI! origin latitude
-REAL :: XLONORI! origin longitude
-REAL :: XRPK ! projection parameter for the conformal projection
-REAL :: XBETA ! rotation parameter for the conformal projection
-REAL :: XLATC ! centre latitude
-REAL :: XLONC ! centre longitude
+REAL, DIMENSION(:), ALLOCATABLE :: XY ! Y coordinate (meters)
+
+TYPE GRID_CONF_PROJ_t
+!
+!!REAL, DIMENSION(:), POINTER :: XX=>NULL() ! X coordinate (meters)
+!!REAL, DIMENSION(:), POINTER :: XY=>NULL() ! Y coordinate (meters)
+INTEGER :: NX ! number of points in X direction
+INTEGER :: NY ! number of points in Y direction
+!
+REAL :: XLAT0 ! reference latitude
+REAL :: XLON0 ! reference longitude
+REAL :: XLATORI! origin latitude
+REAL :: XLONORI! origin longitude
+REAL :: XRPK ! projection parameter for the conformal projection
+REAL :: XBETA ! rotation parameter for the conformal projection
+REAL :: XLATC ! centre latitude
+REAL :: XLONC ! centre longitude
+!
+END type GRID_CONF_PROJ_t
+
+
+TYPE(GRID_CONF_PROJ_t), ALLOCATABLE, TARGET, SAVE :: GRID_CONF_PROJ_MODEL(:)
+!
+!!!!!!!!!!!!!!!!!!!! LOCAL VARIABLE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!REAL, DIMENSION(:), POINTER :: XX=>NULL() ! X coordinate (meters)
+!!REAL, DIMENSION(:), POINTER :: XY=>NULL() ! Y coordinate (meters)
+INTEGER ,POINTER :: NX=>NULL() ! number of points in X direction
+INTEGER ,POINTER :: NY=>NULL() ! number of points in Y direction
+!
+REAL ,POINTER :: XLAT0=>NULL() ! reference latitude
+REAL ,POINTER :: XLON0=>NULL() ! reference longitude
+REAL ,POINTER :: XLATORI=>NULL()! origin latitude
+REAL ,POINTER :: XLONORI=>NULL()! origin longitude
+REAL ,POINTER :: XRPK=>NULL() ! projection parameter for the conformal projection
+REAL ,POINTER :: XBETA=>NULL() ! rotation parameter for the conformal projection
+REAL ,POINTER :: XLATC=>NULL() ! centre latitude
+REAL ,POINTER :: XLONC=>NULL() ! centre longitude
+
+CONTAINS
+
+SUBROUTINE GRID_CONF_PROJ_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+! Save current state for allocated arrays
+!leave out of structure XX nd XY since aloocated and deallocatd in PGCP
+!!GRID_CONF_PROJ_MODEL(KFROM)%XX=>XX
+!!GRID_CONF_PROJ_MODEL(KFROM)%XY=>XY
+!
+! Current model is set to model KTO
+!!XX=>GRID_CONF_PROJ_MODEL(KTO)%XX
+!!XY=>GRID_CONF_PROJ_MODEL(KTO)%XY
+NX=>GRID_CONF_PROJ_MODEL(KTO)%NX
+NY=>GRID_CONF_PROJ_MODEL(KTO)%NY
+XLAT0=>GRID_CONF_PROJ_MODEL(KTO)%XLAT0
+XLON0=>GRID_CONF_PROJ_MODEL(KTO)%XLON0
+XLATORI=>GRID_CONF_PROJ_MODEL(KTO)%XLATORI
+XLONORI=>GRID_CONF_PROJ_MODEL(KTO)%XLONORI
+XRPK=>GRID_CONF_PROJ_MODEL(KTO)%XRPK
+XBETA=>GRID_CONF_PROJ_MODEL(KTO)%XBETA
+XLATC=>GRID_CONF_PROJ_MODEL(KTO)%XLATC
+XLONC=>GRID_CONF_PROJ_MODEL(KTO)%XLONC
+!
+END SUBROUTINE GRID_CONF_PROJ_GOTO_MODEL
+!
+SUBROUTINE GRID_CONF_PROJ_ALLOC(KMODEL)
+INTEGER, INTENT(IN) :: KMODEL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_GRID_CONF_PROJ_N:GRID_CONF_PROJ_ALLOC",0,ZHOOK_HANDLE)
+ALLOCATE(GRID_CONF_PROJ_MODEL(KMODEL))
+IF( KMODEL > 0 ) THEN
+ GRID_CONF_PROJ_MODEL(:)%NX = 0
+ GRID_CONF_PROJ_MODEL(:)%NY = 0
+ GRID_CONF_PROJ_MODEL(:)%XLAT0 = 0.
+ GRID_CONF_PROJ_MODEL(:)%XLON0 = 0.
+ GRID_CONF_PROJ_MODEL(:)%XLATORI = 0.
+ GRID_CONF_PROJ_MODEL(:)%XLONORI = 0.
+ GRID_CONF_PROJ_MODEL(:)%XRPK = 0.
+ GRID_CONF_PROJ_MODEL(:)%XBETA = 0.
+ GRID_CONF_PROJ_MODEL(:)%XLATC = 0.
+ GRID_CONF_PROJ_MODEL(:)%XLONC = 0.
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_WATFLUX_N:WATFLUX_ALLOC",1,ZHOOK_HANDLE)
+END SUBROUTINE GRID_CONF_PROJ_ALLOC
!
END MODULE MODD_GRID_CONF_PROJ
diff --git a/src/SURFEX/modd_surf_atmn.F90 b/src/SURFEX/modd_surf_atmn.F90
index f49023d54739ee9e162738542a46288e50ce4d46..e6d56fa36c14b404944138e0d63b4d31b31fb718 100644
--- a/src/SURFEX/modd_surf_atmn.F90
+++ b/src/SURFEX/modd_surf_atmn.F90
@@ -121,6 +121,16 @@ TYPE SURF_ATM_t
INTEGER :: NSIZE_FULL ! total number of grid points by proc (-)
INTEGER :: NDIM_FULL ! total number of grid points (-)
!
+! global sizes of the physical domain
+!
+ INTEGER :: NIMAX_SURF_ll
+ INTEGER :: NJMAX_SURF_ll
+!
+! local sizes of the physical domain
+!
+ INTEGER :: NIMAX_SURF_LOC
+ INTEGER :: NJMAX_SURF_LOC
+!
!-----------------------------------------------------------------------------------------------------
!
! Surface fields (only 1 horizontal dimension)
@@ -202,6 +212,14 @@ INTEGER, POINTER :: NSIZE_FULL=>NULL()
!$OMP THREADPRIVATE(NSIZE_FULL)
INTEGER, POINTER :: NDIM_FULL=>NULL()
!$OMP THREADPRIVATE(NDIM_FULL)
+INTEGER, POINTER :: NIMAX_SURF_ll=>NULL()
+!$OMP THREADPRIVATE(NIMAX_SURF_ll)
+INTEGER, POINTER :: NJMAX_SURF_ll=>NULL()
+!$OMP THREADPRIVATE(NJMAX_SURF_ll)
+INTEGER, POINTER :: NIMAX_SURF_LOC=>NULL()
+!$OMP THREADPRIVATE(NIMAX_SURF_LOC)
+INTEGER, POINTER :: NJMAX_SURF_LOC=>NULL()
+!$OMP THREADPRIVATE(NJMAX_SURF_LOC)
REAL, POINTER, DIMENSION(:,:) :: XCOVER=>NULL()
!$OMP THREADPRIVATE(XCOVER)
LOGICAL, POINTER, DIMENSION(:):: LCOVER=>NULL()
@@ -266,6 +284,10 @@ NDIM_NATURE=>SURF_ATM_MODEL(KTO)%NDIM_NATURE
NR_NATURE=>SURF_ATM_MODEL(KTO)%NR_NATURE
NSIZE_FULL=>SURF_ATM_MODEL(KTO)%NSIZE_FULL
NDIM_FULL=>SURF_ATM_MODEL(KTO)%NDIM_FULL
+NIMAX_SURF_ll=>SURF_ATM_MODEL(KTO)%NIMAX_SURF_ll
+NJMAX_SURF_ll=>SURF_ATM_MODEL(KTO)%NJMAX_SURF_ll
+NIMAX_SURF_LOC=>SURF_ATM_MODEL(KTO)%NIMAX_SURF_LOC
+NJMAX_SURF_LOC=>SURF_ATM_MODEL(KTO)%NJMAX_SURF_LOC
XCOVER=>SURF_ATM_MODEL(KTO)%XCOVER
LCOVER=>SURF_ATM_MODEL(KTO)%LCOVER
XZS=>SURF_ATM_MODEL(KTO)%XZS
@@ -314,6 +336,10 @@ SURF_ATM_MODEL(:)%NSIZE_NATURE=0
SURF_ATM_MODEL(:)%NDIM_NATURE=0
SURF_ATM_MODEL(:)%NSIZE_FULL=0
SURF_ATM_MODEL(:)%NDIM_FULL=0
+SURF_ATM_MODEL(:)%NIMAX_SURF_ll=0
+SURF_ATM_MODEL(:)%NJMAX_SURF_ll=0
+SURF_ATM_MODEL(:)%NIMAX_SURF_LOC=0
+SURF_ATM_MODEL(:)%NJMAX_SURF_LOC=0
SURF_ATM_MODEL(:)%XOUT_TSTEP=0.
SURF_ATM_MODEL(:)%LINIT_PRECIP=.FALSE.
IF (LHOOK) CALL DR_HOOK("MODD_SURF_ATM_N:SURF_ATM_ALLOC",1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/modd_teb_gardenn.F90 b/src/SURFEX/modd_teb_gardenn.F90
index a4ec64776d7bf9e3afd4f719d19e26351d2866dd..5a5b6e26fa190876c2b027e8f3f690785fea3667 100644
--- a/src/SURFEX/modd_teb_gardenn.F90
+++ b/src/SURFEX/modd_teb_gardenn.F90
@@ -644,7 +644,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Current model is set to model KTO
IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_GOTO_MODEL',0,ZHOOK_HANDLE)
IF (LKFROM) THEN
-TEB_GARDEN_OPTIONS_MODEL(KTO)%XSOILGRID=>XSOILGRID
+TEB_GARDEN_OPTIONS_MODEL(KFROM)%XSOILGRID=>XSOILGRID
ENDIF
LPAR_GARDEN=>TEB_GARDEN_OPTIONS_MODEL(KTO)%LPAR_GARDEN
NGROUND_LAYER=>TEB_GARDEN_OPTIONS_MODEL(KTO)%NGROUND_LAYER
diff --git a/src/SURFEX/mode_gridtype_conf_proj.F90 b/src/SURFEX/mode_gridtype_conf_proj.F90
index eb019e1bac6d71a1fe37cd8e07bce9639acd282b..6949a32e95cb065c580d0e2ca7318886281a9ccb 100644
--- a/src/SURFEX/mode_gridtype_conf_proj.F90
+++ b/src/SURFEX/mode_gridtype_conf_proj.F90
@@ -32,12 +32,18 @@ CONTAINS
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 06/2015 broadcast the space step to all MPI processes (necessary for reproductibility)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+#ifdef MNH_PARALLEL
+USE MODD_VAR_ll, ONLY : NPROC, IP, MPI_PRECISION, NMNH_COMM_WORLD, YSPLITTING
+USE MODD_MPIF
+USE MODE_TOOLS_ll, ONLY : GET_OR_ll
+#endif
!
IMPLICIT NONE
!
@@ -72,6 +78,12 @@ LOGICAL :: GFULL ! T : entire grid is stored
INTEGER :: IL ! number of points
INTEGER :: JJ ! loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+#ifdef MNH
+INTEGER :: IINFO_ll
+INTEGER :: IXOR, IYOR
+INTEGER :: IXORMIN, IYORMIN
+INTEGER :: IROOT, IROOTPROC
+#endif
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:PUT_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
!
@@ -98,7 +110,41 @@ PGRID_PAR(8) = FLOAT(KJMAX)
IF (IL>0) THEN
PGRID_PAR(9) = PDX(1)
PGRID_PAR(10)= PDY(1)
-ELSE
+END IF
+#ifdef MNH_PARALLEL
+!get the index of the process with IL>0 that own the southmost and the westmost point
+!then broadcast the value of PDX and PDY at these points
+IF ( NPROC > 1 ) THEN
+! we need to determine wich processes own the southmost and the westmost point
+ CALL GET_OR_ll( YSPLITTING, IXOR, IYOR )
+ IF ( IL==0 ) THEN ! we don't consider processes with IL==0
+ IXOR = NUNDEF
+ IYOR = NUNDEF
+ ENDIF
+ ! get the processes with IL>0 with the westmost points
+ CALL MPI_ALLREDUCE(IXOR, IXORMIN, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ IF ( IXOR == IXORMIN ) THEN
+ IROOT = IP-1
+ ELSE
+ IROOT = NPROC
+ ENDIF
+ CALL MPI_ALLREDUCE(IROOT, IROOTPROC, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+! Then this process broadcasts the space steps in X direction in order to have the same space steps on all processes
+ CALL MPI_BCAST(PGRID_PAR(9), 1, MPI_PRECISION, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
+ !
+ ! get the processes with IL>0 with the southmost points
+ CALL MPI_ALLREDUCE(IYOR, IYORMIN, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ IF ( IYOR == IYORMIN ) THEN
+ IROOT = IP-1
+ ELSE
+ IROOT = NPROC
+ ENDIF
+ CALL MPI_ALLREDUCE(IROOT, IROOTPROC, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+! Then this process broadcasts the space steps in Y direction in order to have the same space steps on all processes
+ CALL MPI_BCAST(PGRID_PAR(10), 1, MPI_PRECISION, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
+ENDIF
+#endif
+IF (IL<=0) THEN
PGRID_PAR(9) = XUNDEF
PGRID_PAR(10)= XUNDEF
END IF
diff --git a/src/SURFEX/mode_modeln_surfex_handler.F90 b/src/SURFEX/mode_modeln_surfex_handler.F90
index 2255cfb2ae0c4ab5096e220107b39decc17b0567..51cb8240879522c16a98cef0c9f2e83079a15e4d 100644
--- a/src/SURFEX/mode_modeln_surfex_handler.F90
+++ b/src/SURFEX/mode_modeln_surfex_handler.F90
@@ -34,6 +34,7 @@ USE MODI_GOTO_WRAPPER_SEAFLUX
USE MODI_GOTO_WRAPPER_SURFATM
USE MODI_GOTO_WRAPPER_TEB
USE MODI_GOTO_WRAPPER_WATFLUX
+USE MODD_GRID_CONF_PROJ
!
LOGICAL, INTENT(IN) :: LKFROM
INTEGER, INTENT(IN) :: KMI
@@ -55,6 +56,9 @@ IF (LKFROM) THEN
CALL GOTO_WRAPPER_OCEAN (ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_WATFLUX(ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_FLAKE (ICURRENT_MODEL, KMI, LKFROM)
+ !
+ CALL GRID_CONF_PROJ_GOTO_MODEL(ICURRENT_MODEL,KMI)
+ !
ICURRENT_MODEL = KMI
ELSE
@@ -67,6 +71,9 @@ IF (LKFROM) THEN
CALL GOTO_WRAPPER_OCEAN (ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_WATFLUX(ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_FLAKE (ICURRENT_MODEL, KMI, LKFROM)
+ !
+ CALL GRID_CONF_PROJ_GOTO_MODEL(ICURRENT_MODEL,KMI)
+ !
ICURRENT_MODEL = KMI
END IF
@@ -82,6 +89,9 @@ ELSE
CALL GOTO_WRAPPER_OCEAN (ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_WATFLUX(ICURRENT_MODEL, KMI, LKFROM)
CALL GOTO_WRAPPER_FLAKE (ICURRENT_MODEL, KMI, LKFROM)
+ !
+ CALL GRID_CONF_PROJ_GOTO_MODEL(ICURRENT_MODEL,KMI)
+ !
ICURRENT_MODEL = KMI
diff --git a/src/SURFEX/mode_read_extern.F90 b/src/SURFEX/mode_read_extern.F90
index 5f459a4720610d549db5117a1a477e9ce300f23e..7f5fcb52465ba341a3088a02ecf0250d3d3460fa 100644
--- a/src/SURFEX/mode_read_extern.F90
+++ b/src/SURFEX/mode_read_extern.F90
@@ -100,6 +100,13 @@ ELSE
GECOCLIMAP = .NOT. GPAR_GARDEN
END IF
!
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+!
!------------------------------------------------------------------------------
!
ALLOCATE(ZDG (KNI,KLAYER,KPATCH))
@@ -108,6 +115,8 @@ IWG_LAYER(:,:) = NUNDEF
IHYDRO_LAYER = KLAYER
!
IF (GECOCLIMAP) THEN
+
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=3) THEN
!
!* reading of the cover to obtain the depth of inter-layers
!
@@ -121,18 +130,69 @@ IF (GECOCLIMAP) THEN
!* computes soil layers
!
CALL CONVERT_COVER_ISBA(HISBA,NUNDEF,ZCOVER,' ',HNAT,PSOILGRID=PSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)
- IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
!
DEALLOCATE(ZCOVER)
+ ELSE
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, 'MODE_READ_EXTERN : ==> ON NE LIT PAS LES COVERS'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+#ifdef MNH_PARALLEL
+DO JPATCH=1,SIZE(ZDG,3)
+ DO JLAYER=1,SIZE(ZDG,2)
+ IF (JLAYER<10) THEN
+ IF (HNAT=='NAT') THEN
+ WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'ECO_DG',JLAYER,JPATCH
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I1,I4.4)') 'GD_ECO_DG',JLAYER,JPATCH
+ END IF
+ ELSE
+ IF (HNAT=='NAT') THEN
+ WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'ECO_DG',JLAYER,JPATCH
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I2,I4.4)') 'GD_ECO_DG',JLAYER,JPATCH
+ END IF
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZDG(:,JLAYER,JPATCH),IRESP,HDIR='A')
+ END DO
+END DO
+#else
+ DO JLAYER=1,SIZE(ZDG,2)
+ IF (JLAYER<10) THEN
+ IF (HNAT=='NAT') THEN
+ WRITE(YRECFM,FMT='(A6,I1)') 'ECO_DG',JLAYER
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I1)') 'GD_ECO_DG',JLAYER
+ END IF
+ ELSE
+ IF (HNAT=='NAT') THEN
+ WRITE(YRECFM,FMT='(A6,I2)') 'ECO_DG',JLAYER
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I2)') 'GD_ECO_DG',JLAYER
+ END IF
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZDG(:,JLAYER,:),IRESP,HDIR='A')
+ END DO
+#endif
+ IF (HISBA=='DIF') THEN
+ YRECFM='ECO_WG_L'
+ IF (HNAT=='GRD') YRECFM='GD_ECO_WG_L'
+ ALLOCATE(ZWORK(KNI,KPATCH))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HDIR='A')
+ WHERE (ZWORK==XUNDEF) ZWORK=NUNDEF
+ IWG_LAYER=NINT(ZWORK)
+ DEALLOCATE(ZWORK)
+ END IF
+ END IF
!
+ IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
ENDIF
-!
-YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
+
!-------------------------------------------------------------------
IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
!
@@ -312,6 +372,9 @@ REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer
!
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=4) :: YLVL
+#ifdef MNH_PARALLEL
+ CHARACTER(LEN=8) :: YPATCH
+#endif
CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme
CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden)
CHARACTER(LEN=4) :: YPEDOTF ! type of pedo-transfert function
@@ -502,11 +565,21 @@ ENDIF
!
DO JLAYER=1,ILAYER
WRITE(YLVL,'(I4)') JLAYER
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,IPATCH
+ IF (JLAYER >= 10) WRITE(YPATCH,'(I2,I4.4)') JLAYER,JPATCH
+ IF (JLAYER < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JLAYER,JPATCH
+ YRECFM=TRIM(HNAME)//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HFILETYPE,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR='A')
+ ZVAR(:,JLAYER,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
YRECFM=TRIM(HNAME)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HFILETYPE,YRECFM,ZWORK(:,:),IRESP,HDIR='A')
DO JPATCH=1,IPATCH
ZVAR(:,JLAYER,JPATCH)=ZWORK(:,JPATCH)
END DO
+#endif
END DO
!
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
diff --git a/src/SURFEX/mode_split_grid_parameter.F90 b/src/SURFEX/mode_split_grid_parameter.F90
index 21b577e3a2aa1b51ca1ba3636f64401e6aa774e0..72b7b32457de0be851e85192888fad60a7f8b596 100644
--- a/src/SURFEX/mode_split_grid_parameter.F90
+++ b/src/SURFEX/mode_split_grid_parameter.F90
@@ -9,7 +9,11 @@ MODULE MODE_SPLIT_GRID_PARAMETER
CONTAINS
!
! #############################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_PARAMETERX1(HPROGRAM,HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
+#else
SUBROUTINE SPLIT_GRID_PARAMETERX1(HPROGRAM,HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
+#endif
! #############################################################
!
!!**** * - routine to split a real array on the splitted grid
@@ -33,6 +37,11 @@ IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
INTEGER, INTENT(IN) :: KDIM ! size of PFIELD
INTEGER, INTENT(IN) :: KSIZE ! size of PFIELD_SPLIT
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KIMAX_ll !(global) dimension of the domain - X direction
+INTEGER, INTENT(IN) :: KJMAX_ll !(global) dimension of the domain - Y direction
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
REAL, DIMENSION(KDIM ), INTENT(IN) :: PFIELD ! real field for complete grid
REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for splitted grid
!
@@ -43,9 +52,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SPLIT_GRID_PARAMETER:SPLIT_GRID_PARAMETERX1',0,ZHOOK_HANDLE)
!
IF (HPROGRAM=='MESONH') THEN
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
+#else
#ifdef MNH
CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
#endif
+#endif
ENDIF
!
!
@@ -62,7 +75,11 @@ END SUBROUTINE SPLIT_GRID_PARAMETERX1
!
!
! #############################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_PARAMETERN0(HPROGRAM,HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
+#else
SUBROUTINE SPLIT_GRID_PARAMETERN0(HPROGRAM,HGRID,HREC,KFIELD,KFIELD_SPLIT)
+#endif
! #############################################################
!
!!**** * - routine to define an integer related to splitted grid
@@ -84,6 +101,9 @@ IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for splitted grid
!* 0.2 Declarations of local variables
@@ -95,9 +115,13 @@ IF (LHOOK) CALL DR_HOOK('MODE_SPLIT_GRID_PARAMETER:SPLIT_GRID_PARAMETERN0',0,ZHO
!-------------------------------------------------------------------------------
!
IF (HPROGRAM=='MESONH') THEN
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
+#else
#ifdef MNH
CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KFIELD,KFIELD_SPLIT)
#endif
+#endif
ENDIF
!
IF (HPROGRAM=='OFFLIN') THEN
diff --git a/src/SURFEX/pack_pgd.F90 b/src/SURFEX/pack_pgd.F90
index 1be09c0f115b144df6ec5a0137556af68db146ca..bce0ca4dff3fc469ad794d2dd3fdc13785f533c4 100644
--- a/src/SURFEX/pack_pgd.F90
+++ b/src/SURFEX/pack_pgd.F90
@@ -37,6 +37,7 @@
!!
!! Original 03/2004
!! Escobar J. 08/02/2005 : bug declare ILU local variable
+!! M.Moge 10/02/2015 parallelization : changes in the calls to GET_COVER_n and GET_ZS_n, use NSIE_FULL instead of NL
!!
!----------------------------------------------------------------------------
!
@@ -63,6 +64,9 @@ USE MODI_GET_SURF_MASK_n
USE MODI_GET_TYPE_DIM_n
!
USE MODI_GET_LUOUT
+!
+USE MODD_SURF_ATM_n, ONLY : NSIZE_FULL
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -92,9 +96,9 @@ INTEGER :: JCOVER
INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
REAL, DIMENSION(SIZE(PLAT)) :: ZDIR
!
-REAL, DIMENSION(NL) :: ZCOVER ! cover on all surface points
+REAL, DIMENSION(NSIZE_FULL) :: ZCOVER ! cover on all surface points
LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! list of existing cover
-REAL, DIMENSION(NL) :: ZZS ! zs on all surface points
+REAL, DIMENSION(NSIZE_FULL) :: ZZS ! zs on all surface points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -131,12 +135,12 @@ IF (PRESENT(PDIR)) PDIR = ZDIR
! -----------------
!
DO JCOVER=1,JPCOVER
- CALL GET_COVER_n(HPROGRAM,NL,JCOVER,ZCOVER)
+ CALL GET_COVER_n(HPROGRAM,NSIZE_FULL,JCOVER,ZCOVER)
CALL PACK_SAME_RANK(IMASK,ZCOVER(:),PCOVER(:,JCOVER))
ENDDO
CALL GET_LCOVER_n(HPROGRAM,JPCOVER,GCOVER)
- CALL GET_ZS_n(HPROGRAM,NL,ZZS)
+ CALL GET_ZS_n(HPROGRAM,NSIZE_FULL,ZZS)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
diff --git a/src/SURFEX/pgd_grid.F90 b/src/SURFEX/pgd_grid.F90
index 9408f3b99b30b861774f330fd77dfe3b1f040e00..3dc55d7c711eccc5329848f6c822f4188a9a5020 100644
--- a/src/SURFEX/pgd_grid.F90
+++ b/src/SURFEX/pgd_grid.F90
@@ -34,6 +34,9 @@
!!
!! Original 01/2004
!! E. Martin 10/2007 IGN grid
+!! M. Moge 05/02/2015 parallelization (using local sizes, GET_MEAN_OF_COORD_SQRT_ll, SET_NAM_GRID_CONF_PROJ_LOCAL) + MPPDB_CHECK
+!! M. Moge 01/03/2015 call SPLIT_GRID if CPROGRAM == 'PGD ' + remove SET_NAM_GRID_CONF_PROJ_LOCAL
+!! M. Moge 01/03/2015 change in the input arguments of PGD_GRID_IO_INIT : passing IDXRATIO, IDYRATIO
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -46,7 +49,7 @@ USE MODD_SURFEX_OMP, ONLY : NINDX2, NWORK, XWORK, XWORK2, XWORK3, &
USE MODD_PGD_GRID, ONLY : NL, XGRID_PAR, NGRID_PAR, XMESHLENGTH
USE MODN_PGD_GRID
USE MODD_SURF_ATM_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, XJPDIR
-USE MODD_SURF_ATM_n, ONLY : NDIM_FULL
+USE MODD_SURF_ATM_n, ONLY : NDIM_FULL, NSIZE_FULL
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
USE MODI_DEFAULT_GRID
@@ -66,6 +69,15 @@ USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+USE MODI_PGD_GRID_IO_INIT
+#ifdef MNH_PARALLEL
+USE MODE_TOOLS_ll, ONLY : GET_MEAN_OF_COORD_SQRT_ll
+!
+USE MODI_GET_SIZE_FULL_n
+USE MODI_SPLIT_GRID
+USE MODD_CONF, ONLY : CPROGRAM
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -87,6 +99,16 @@ INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
LOGICAL :: GFOUND ! Flag true if namelist is present
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IIMAX_ll, IJMAX_ll ! global size of son model
+LOGICAL :: GRECT
+!
+ INTEGER :: IXOR = 1 ! position of modified bottom left point
+ INTEGER :: IYOR = 1 ! according to initial grid
+ INTEGER :: IXSIZE = -999 ! number of grid meshes in initial grid to be
+ INTEGER :: IYSIZE = -999 ! covered by the modified grid
+ INTEGER :: IDXRATIO = 1 ! resolution ratio between modified grid
+ INTEGER :: IDYRATIO = 1 ! and initial grid
+NAMELIST/NAM_INIFILE_CONF_PROJ/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
!
!* 0.3 Declaration of namelists
! ------------------------
@@ -153,9 +175,49 @@ END IF
IF (LEN_TRIM(YFILETYPE)>0 .AND. LEN_TRIM(YINIFILE)>0 ) THEN
IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='LFI ' .OR. YFILETYPE=='ASCII ') THEN
CALL GRID_FROM_FILE(HPROGRAM,YINIFILE,YFILETYPE,OGRID,CGRID,NGRID_PAR,XGRID_PAR,NL)
+ HGRID = CGRID
+ IF ( HGRID == "IGN " .OR. HGRID == "GAUSS " .OR. HGRID == "NONE " ) THEN
+ GRECT = .FALSE.
+ ELSE
+ GRECT = .TRUE.
+ ENDIF
+ ! on lit la taille globale du modele fils dans la namelist
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ CALL POSNAM(ILUNAM,'NAM_INIFILE_CONF_PROJ',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ READ(UNIT=ILUNAM,NML=NAM_INIFILE_CONF_PROJ)
+ IIMAX_ll = IXSIZE*IDXRATIO
+ IJMAX_ll = IYSIZE*IDYRATIO
+ ENDIF
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+
+ !* 3. Additional actions for I/O
+ !
+ IF (GFOUND) THEN
+#ifdef MNH_PARALLEL
+ CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR, HGRID, GRECT, IIMAX_ll, IJMAX_ll, IDXRATIO, IDYRATIO)
+#else
+ CALL PGD_GRID_IO_INIT(HPROGRAM)
+#endif
+ NDIM_FULL = NL
+ ELSE
+#ifdef MNH_PARALLEL
+ CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR, HGRID, GRECT)
+#else
+ CALL PGD_GRID_IO_INIT(HPROGRAM)
+#endif
+ ENDIF
+ NSIZE = NDIM_FULL
+#ifdef MNH_PARALLEL
+ CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL)
+ NL = NSIZE_FULL
+#else
+ NSIZE_FULL = NL
+#endif
ELSE
CALL ABOR1_SFX('PGD_GRID: FILE TYPE NOT SUPPORTED '//HFILETYPE//' FOR FILE '//HFILE)
END IF
+ !we don't need to call SPLIT_GRID, the grid has been splitted in GRID_FROM_FILE
!
ELSE
!
@@ -172,14 +234,33 @@ ELSE
ELSE
!
CALL READ_NAM_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,XGRID_PAR,NL)
-!
+ HGRID = CGRID
+ !* 3. Additional actions for I/O
+ !
+#ifdef MNH_PARALLEL
+ CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR)
+#else
+ CALL PGD_GRID_IO_INIT(HPROGRAM)
+#endif
+ NDIM_FULL = NL
+ NSIZE = NDIM_FULL
+#ifdef MNH_PARALLEL
+ CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL)
+ NL = NSIZE_FULL
+#else
+ NSIZE_FULL = NL
+#endif
END IF
+#ifdef MNH_PARALLEL
+ ! IF we are in PREP_PGD, we need to split the grid. Otherwise, the grid was read in parallel and is already splitted
+ IF ( CPROGRAM == 'PGD ') THEN
+ CALL SPLIT_GRID('MESONH',NGRID_PAR,XGRID_PAR)
+ ENDIF
+#endif
END IF
!
-HGRID = CGRID
-NDIM_FULL = NL
-NSIZE = NDIM_FULL
+!
IF (.NOT.ALLOCATED(NINDEX)) THEN
ALLOCATE(NINDEX(NDIM_FULL))
NINDEX(:) = 0
@@ -208,11 +289,11 @@ PGRID_PAR = XGRID_PAR
!* 6. Latitude and longitude
! ----------------------
!
-ALLOCATE(XLAT (NL))
-ALLOCATE(XLON (NL))
-ALLOCATE(XMESH_SIZE (NL))
-ALLOCATE(XJPDIR (NL))
- CALL LATLON_GRID(CGRID,NGRID_PAR,NL,ILUOUT,XGRID_PAR,XLAT,XLON,XMESH_SIZE,XJPDIR)
+ALLOCATE(XLAT (NSIZE_FULL))
+ALLOCATE(XLON (NSIZE_FULL))
+ALLOCATE(XMESH_SIZE (NSIZE_FULL))
+ALLOCATE(XJPDIR (NSIZE_FULL))
+ CALL LATLON_GRID(CGRID,NGRID_PAR,NSIZE_FULL,ILUOUT,XGRID_PAR,XLAT,XLON,XMESH_SIZE,XJPDIR)
!
!------------------------------------------------------------------------------
!
@@ -220,7 +301,11 @@ ALLOCATE(XJPDIR (NL))
! --------------------------------
!
!* in meters
+#ifdef MNH_PARALLEL
+CALL GET_MEAN_OF_COORD_SQRT_ll(XMESH_SIZE,NSIZE_FULL,NDIM_FULL,XMESHLENGTH)
+#else
XMESHLENGTH = SUM ( SQRT(XMESH_SIZE) ) / NL
+#endif
!
!* in degrees (of latitude)
XMESHLENGTH = XMESHLENGTH *180. / XPI / XRADIUS
diff --git a/src/SURFEX/pgd_grid_io_init.F90 b/src/SURFEX/pgd_grid_io_init.F90
index 00f7d8d9eddb048b057fdf16a529af117ec1d5db..594e1ba39c4973aa934b7a58c730e2a1ec17ffb3 100644
--- a/src/SURFEX/pgd_grid_io_init.F90
+++ b/src/SURFEX/pgd_grid_io_init.F90
@@ -2,8 +2,91 @@
!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
+#if 0
+!#######################
+MODULE MODI_PGD_GRID_IO_INIT
+ !#######################
+ !
+ INTERFACE
+ ! #########
+#ifdef MNH_PARALLEL
+ SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+#else
+ SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM)
+#endif
+ ! ######################################
+ !!
+ !! PURPOSE
+ !! -------
+ !!
+ !!
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !!
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! V. Masson Meteo-France
+ !!
+ !! MODIFICATION
+ !! ------------
+ !!
+ !! Original 13/10/03
+ !! M.Moge 11/02/15 adding MODULE MODI_PGD_GRID_IO_INIT and INTERFACE + modif of the input args
+ !! M.Moge 11/02/15 change in the input arguments : passing KDXRATIO,KDYRATIO
+ !----------------------------------------------------------------------------
+ !
+ !* 0. DECLARATION
+ ! -----------
+ !
+ !
+ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+ USE PARKIND1 ,ONLY : JPRB
+ !
+ #ifdef MNH
+ USE MODI_PGD_GRID_IO_INIT_MNH
+ #endif
+ IMPLICIT NONE
+ !
+ !* 0.1 Declaration of dummy arguments
+ ! ------------------------------
+ !
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling READ_PGD
+#ifdef MNH_PARALLEL
+ INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+ REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+ CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
+ LOGICAL, INTENT(IN), OPTIONAL :: ORECT
+! if KIMAX,KJMAX,KDXRATIO,KDYRATIO present, this means we are in PREP_PGD, and we only initialise the child model,
+! using a father model read from a file and previously initialized with INI_PARAZ_ll
+ INTEGER, INTENT(IN), OPTIONAL :: KIMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KJMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KDXRATIO
+ INTEGER, INTENT(IN), OPTIONAL :: KDYRATIO
+#endif
+ END SUBROUTINE PGD_GRID_IO_INIT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_PGD_GRID_IO_INIT
+#endif
! #########
+#ifdef MNH_PARALLEL
+ SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+#else
SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM)
+#endif
! ######################################
!!
!! PURPOSE
@@ -33,6 +116,8 @@
!! ------------
!!
!! Original 13/10/03
+!! M.Moge 11/02/15 adding MODULE MODI_PGD_GRID_IO_INIT and INTERFACE + modif of the input args
+!! M.Moge 11/02/15 change in the input arguments : passing KDXRATIO,KDYRATIO
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -51,6 +136,18 @@ IMPLICIT NONE
! ------------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling READ_PGD
+#ifdef MNH_PARALLEL
+ INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+ REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+ CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
+ LOGICAL, INTENT(IN), OPTIONAL :: ORECT
+! if KIMAX,KJMAX,KDXRATIO,KDYRATIO present, this means we are in PREP_PGD, and we only initialise the child model,
+! using a father model read from a file and previously initialized with INI_PARAZ_ll
+ INTEGER, INTENT(IN), OPTIONAL :: KIMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KJMAX
+ INTEGER, INTENT(IN), OPTIONAL :: KDXRATIO
+ INTEGER, INTENT(IN), OPTIONAL :: KDYRATIO
+#endif
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -61,9 +158,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_GRID_IO_INIT',0,ZHOOK_HANDLE)
IF (HPROGRAM=='MESONH') THEN
+#ifdef MNH_PARALLEL
+ IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(ORECT) \
+ .AND. PRESENT(KDXRATIO) .AND. PRESENT(KDYRATIO) ) THEN
+ CALL PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+ ELSE
+ CALL PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR)
+ ENDIF
+#else
#ifdef MNH
CALL PGD_GRID_IO_INIT_MNH
#endif
+#endif
END IF
IF (LHOOK) CALL DR_HOOK('PGD_GRID_IO_INIT',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_grid_surf_atm.F90 b/src/SURFEX/pgd_grid_surf_atm.F90
index 82a30dfd56113728fce78c0409941d1287efa007..1815883387e8100dd5d7502ae203e5653d601497 100644
--- a/src/SURFEX/pgd_grid_surf_atm.F90
+++ b/src/SURFEX/pgd_grid_surf_atm.F90
@@ -33,6 +33,7 @@
!! ------------
!!
!! Original 13/10/03
+!! M.Moge 10/02/15 change in the input parameters of PGD_GRID_IO_INIT
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -50,7 +51,7 @@ USE MODI_INI_CSTS
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODI_PGD_GRID_IO_INIT
+!USE MODI_PGD_GRID_IO_INIT
USE MODI_SURF_VERSION
!
IMPLICIT NONE
@@ -94,7 +95,12 @@ CPROGNAME=HPROGRAM
!
!* 3. Additional actions for I/O
!
- CALL PGD_GRID_IO_INIT(HPROGRAM)
+!#ifdef MNH_PARALLEL
+! CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR)
+!#else
+! CALL PGD_GRID_IO_INIT(HPROGRAM)
+!#endif
+!we already called PGD_GRID_IO_INIT in subroutine PGD_GRID
!
IF (LHOOK) CALL DR_HOOK('PGD_GRID_SURF_ATM',1,ZHOOK_HANDLE)
!_______________________________________________________________________________
diff --git a/src/SURFEX/pgd_isba.F90 b/src/SURFEX/pgd_isba.F90
index f8bf1e945f1344f30a6159237c74775907b65336..687a72d5d61ed9eaa8f0f9bd922221bb6fba9b63 100644
--- a/src/SURFEX/pgd_isba.F90
+++ b/src/SURFEX/pgd_isba.F90
@@ -55,7 +55,8 @@ USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA, &
XZ0EFFJPDIR, CPHOTO, LTR_ML, XRM_PATCH, &
XCLAY, XSAND, XSOC, LSOCP, LNOF, &
XRUNOFFB, XWDRAIN, LECOCLIMAP, &
- XSOILGRID, LPERM, XPERM, XPH, XFERT
+ XSOILGRID, LPERM, XPERM, XPH, XFERT, &
+ XDG, NWG_LAYER
USE MODD_ISBA_GRID_n, ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE
!
USE MODD_ISBA_PAR, ONLY : NOPTIMLAYER, XOPTIMGRID
@@ -75,6 +76,7 @@ USE MODI_WRITE_COVER_TEX_ISBA_PAR
USE MODI_PGD_TOPO_INDEX
USE MODI_PGD_ISBA_PAR
USE MODI_PGD_TOPD
+USE MODI_CONVERT_COVER_ISBA
!
USE MODI_READ_SURF
USE MODI_INIT_IO_SURF_n
@@ -214,6 +216,7 @@ SELECT CASE (CISBA)
!
NGROUND_LAYER = 2
CPEDOTF ='CH78'
+ ALLOCATE(XSOILGRID(0))
WRITE(ILUOUT,*) '*****************************************'
WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 2 *'
@@ -224,6 +227,7 @@ SELECT CASE (CISBA)
!
NGROUND_LAYER = 3
CPEDOTF ='CH78'
+ ALLOCATE(XSOILGRID(0))
WRITE(ILUOUT,*) '*****************************************'
WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 3 *'
@@ -586,12 +590,30 @@ LECOCLIMAP = OECOCLIMAP
CALL PGD_ISBA_PAR(HPROGRAM)
!
!-------------------------------------------------------------------------------
+!
+!* 15. TOPODYN fields
+! --------------
!
CALL PGD_TOPD(HPROGRAM)
!
!-------------------------------------------------------------------------------
!
-!* 15. Prints of cover parameters in a tex file
+!* 16. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
+! ----------------------------------------------------------------------------------
+!
+IF (LECOCLIMAP) THEN
+ ALLOCATE(XDG(ILU,NGROUND_LAYER,NPATCH))
+ IF (CISBA=='DIF') THEN
+ ALLOCATE(NWG_LAYER(ILU,NPATCH))
+ ELSE
+ ALLOCATE(NWG_LAYER(0,0))
+ END IF
+ CALL CONVERT_COVER_ISBA(CISBA,NUNDEF,XCOVER,' ','NAT',PSOILGRID=XSOILGRID,PDG=XDG,KWG_LAYER=NWG_LAYER)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. Prints of cover parameters in a tex file
! ----------------------------------------
!
IF (OECOCLIMAP) THEN
diff --git a/src/SURFEX/pgd_teb_veg.F90 b/src/SURFEX/pgd_teb_veg.F90
index 921eaebaacd840c72ca0de8bf82e8c21976330c3..09de1ba223623f7f9b880defc24ff784478a5ec8 100644
--- a/src/SURFEX/pgd_teb_veg.F90
+++ b/src/SURFEX/pgd_teb_veg.F90
@@ -48,7 +48,8 @@ USE MODD_TEB_n, ONLY : XCOVER, LCOVER, XZS, &
USE MODD_TEB_VEG_n, ONLY : NNBIOMASS, &
CISBA, CPHOTO, CPEDOTF, LTR_ML
USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, XSOILGRID, &
- XCLAY, XSAND, XRUNOFFB, XWDRAIN
+ XCLAY, XSAND, XRUNOFFB, XWDRAIN, &
+ XDG, NWG_LAYER
USE MODD_TEB_GRID_n, ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE, NDIM
USE MODD_DATA_TEB_GARDEN_n, ONLY : NTIME
!
@@ -61,6 +62,7 @@ USE MODI_PGD_FIELD
USE MODI_TEST_NAM_VAR_SURF
!
USE MODI_PGD_TEB_GARDEN_PAR
+USE MODI_CONVERT_COVER_ISBA
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -112,6 +114,9 @@ LOGICAL :: LIMP_CLAY ! Imposed maps of Clay
LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics
REAL, DIMENSION(150) :: ZSOILGRID ! Soil layer thickness for DIF
!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDG ! ground layers
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER ! number of layers for DIF option
+!
! Not used in TEB garden
!
CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon
@@ -325,6 +330,25 @@ IF (LHYDRO) print*," CALL PGD_TEB_URBHYDRO(HPROGRAM,LECOCLIMAP)"
!
!-------------------------------------------------------------------------------
!
+!* 10. GARDEN diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
+! ------------------------------------------------------------------------------------
+!
+IF (LECOCLIMAP) THEN
+ ALLOCATE(ZDG(NDIM,NGROUND_LAYER,1))
+ ALLOCATE(IWG_LAYER(NDIM,1))
+ CALL CONVERT_COVER_ISBA(CISBA,NUNDEF,XCOVER,' ','GRD',PSOILGRID=XSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)
+ !
+ ALLOCATE(XDG(NDIM,NGROUND_LAYER))
+ XDG(:,:) = ZDG(:,:,1)
+ IF (CISBA=='DIF') THEN
+ ALLOCATE(NWG_LAYER(NDIM))
+ NWG_LAYER(:) = IWG_LAYER(:,1)
+ ELSE
+ ALLOCATE(NWG_LAYER(0))
+ END IF
+END IF
+!-------------------------------------------------------------------------------
+!
IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_isba_extern.F90 b/src/SURFEX/prep_isba_extern.F90
index 1d97d1e023a4c0367872cbf1fe7b842effba948f..e71125a665771876015594b3af043896b176b1c4 100644
--- a/src/SURFEX/prep_isba_extern.F90
+++ b/src/SURFEX/prep_isba_extern.F90
@@ -25,6 +25,7 @@ SUBROUTINE PREP_ISBA_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 08/2015 reading 'WR' one patch at a time for Z-parallel splitting with MNH
!!------------------------------------------------------------------
!
@@ -155,7 +156,14 @@ SELECT CASE(HSURF)
ALLOCATE(ZFIELD(INI,1,IPATCH))
YRECFM = 'WR'
CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,IPATCH
+ WRITE(YRECFM,'(A2,I4.4)') 'WR',JPATCH
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
+ END DO
+#else
CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
+#endif
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
DEALLOCATE(ZFIELD)
diff --git a/src/SURFEX/prep_snow_extern.F90 b/src/SURFEX/prep_snow_extern.F90
index e3254439b01d09cb2ad7f3d3c85d53af3348558d..b742a7a3eacd6f1148194a7f96d2ba030dd92545 100644
--- a/src/SURFEX/prep_snow_extern.F90
+++ b/src/SURFEX/prep_snow_extern.F90
@@ -37,6 +37,7 @@ SUBROUTINE PREP_SNOW_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE
!! -------------
!! Original ?
!! 02/2014 E. Martin : cor. for passing from from multilayer to a single layer
+!! 2014 M.Faivre
!-------------------------------------------------------------------------------
!
!
@@ -193,8 +194,10 @@ ELSE
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
ENDIF
!
-IF (TZSNOW%NLAYER.LT.KLAYER) THEN
- CALL ABOR1_SFX("PREP_SNOW_EXTERN: SNOW NLAYER IN EXTERN FILE MUST BE HIGHER THAN CURRENT NLAYER")
+IF (TZSNOW%NLAYER.GT.KLAYER) THEN
+ TZSNOW%NLAYER=KLAYER
+ELSEIF (TZSNOW%NLAYER.LT.KLAYER) THEN
+ CALL ABOR1_SFX("PREP_SNOW_EXTERN: SNOW NLAYER IN EXTERN FILE MUST BE GROWER THAN CURRENT NLAYER")
ENDIF
!
!
@@ -215,8 +218,7 @@ SELECT CASE (HSURF(1:3))
ZFIELD = 0.
DO JLAYER=1,TZSNOW%NLAYER
ZFIELD(:,1,:) = ZFIELD(:,1,:) + TZSNOW%WSNOW(:,JLAYER,:)
- END DO
- WHERE ( ZFIELD(:,1,:)>XUNDEF ) ZFIELD(:,1,:)=XUNDEF
+ END DO
ALLOCATE(PFIELD(INI,1,IVEGTYPE))
CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZFIELD,PFIELD)
ENDIF
diff --git a/src/SURFEX/prep_teb_garden_extern.F90 b/src/SURFEX/prep_teb_garden_extern.F90
index 2427c086c0c1289c22677ef298a1e83ea42ce5ca..772ce57287a312e72f12227199b21d8009752aa0 100644
--- a/src/SURFEX/prep_teb_garden_extern.F90
+++ b/src/SURFEX/prep_teb_garden_extern.F90
@@ -25,6 +25,7 @@ SUBROUTINE PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEP
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
!!------------------------------------------------------------------
!
@@ -67,7 +68,7 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
INTEGER :: INI ! total 1D dimension
INTEGER :: IPATCH ! number of patch
@@ -85,6 +86,7 @@ INTEGER :: IBUGFIX ! SURFEX bug version
LOGICAL :: GOLD_NAME ! old name flag for temperatures
CHARACTER(LEN=12) :: YSURF ! type of field
CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+ CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
LOGICAL :: GTEB ! flag if TEB fields are present
LOGICAL :: GGARDEN ! T if gardens are present in the file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -208,7 +210,15 @@ SELECT CASE(HSURF)
YRECFM=ADJUSTL(YRECFM)
ALLOCATE(ZFIELD(INI,1,IPATCH))
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,IPATCH
+ WRITE(YPATCH2,'(I4.4)') JPATCH
+ YRECFM=ADJUSTL(YRECFM)//YPATCH2
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
+ END DO
+#else
CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
+#endif
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
DEALLOCATE(ZFIELD)
diff --git a/src/SURFEX/prep_teb_greenroof_extern.F90 b/src/SURFEX/prep_teb_greenroof_extern.F90
index 7377409b2365ec0846429363cd141cebe437adbd..12677620e0873fbe80dded510ffc768185ebc447 100644
--- a/src/SURFEX/prep_teb_greenroof_extern.F90
+++ b/src/SURFEX/prep_teb_greenroof_extern.F90
@@ -26,6 +26,7 @@ SUBROUTINE PREP_TEB_GREENROOF_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFI
!! MODIFICATIONS
!! -------------
!! Original 07/2011
+!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
!!------------------------------------------------------------------
!
@@ -87,6 +88,7 @@ INTEGER :: IVERSION ! SURFEX version
INTEGER :: IBUGFIX ! SURFEX bug version
LOGICAL :: GOLD_NAME ! old name flag for temperatures
CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+ CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
LOGICAL :: GGREENROOF ! T if gardens are present in the file
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -207,7 +209,15 @@ SELECT CASE(HSURF)
END IF
YRECFM=ADJUSTL(YRECFM)
ALLOCATE(ZFIELD(INI,1,IPATCH))
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,IPATCH
+ WRITE(YPATCH2,'(I4.4)') JPATCH
+ YRECFM=ADJUSTL(YRECFM)//YPATCH2
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
+ END DO
+#else
CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
+#endif
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
DEALLOCATE(ZFIELD)
diff --git a/src/SURFEX/read_gr_snow.F90 b/src/SURFEX/read_gr_snow.F90
index 23f921f982ffb66a95fdc42849147d2788e9b601..7e7a9760e36ff75cd488dda95f74338a082cae5a 100644
--- a/src/SURFEX/read_gr_snow.F90
+++ b/src/SURFEX/read_gr_snow.F90
@@ -40,6 +40,7 @@
! F.solmon 06/00 adaptation for patch
! V.Masson 01/03 new version of ISBA
! B. Decharme 2008 If no WSNOW, WSNOW = XUNDEF
+!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -83,6 +84,8 @@ INTEGER :: IRESP ! Error code after redding
INTEGER :: ISURFTYPE_LEN !
LOGICAL :: GSNOW ! snow written in the file
INTEGER :: JLAYER ! loop counter
+INTEGER :: JPATCH ! loop counter
+CHARACTER(LEN=4) :: YPATCH ! number of the patch
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
CHARACTER(LEN=1) :: YDIR ! type of reading
CHARACTER(LEN=4) :: YNLAYER !Format depending on the number of layers
@@ -193,7 +196,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YRECFM,YFMT) 'WSN_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%WSNOW(:,JLAYER,:)=ZWORK
END IF
!
@@ -210,7 +221,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YRECFM,YFMT) 'RSN_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%RHO(:,JLAYER,:)=ZWORK
WHERE(TPSNOW%WSNOW(:,JLAYER,:)==0.0)TPSNOW%RHO(:,JLAYER,:)=XUNDEF
END IF
@@ -227,7 +246,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YRECFM,YFMT) 'TSN_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%T(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
END IF
@@ -243,8 +270,16 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
WRITE(YRECFM,YFMT) 'HSN_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
+ ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%HEAT(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
END IF
@@ -260,8 +295,16 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
WRITE(YRECFM,YFMT) 'SG1_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
+ ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%GRAN1(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
END IF
@@ -277,8 +320,16 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
WRITE(YRECFM,YFMT) 'SG2_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
+ ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%GRAN2(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
END IF
@@ -294,8 +345,16 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
WRITE(YRECFM,YFMT) 'SHI_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
+ ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%HIST(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
END IF
@@ -312,7 +371,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
WRITE(YRECFM,YFMT) 'SAG_',HSURFTYPE,JLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+#endif
TPSNOW%AGE(:,JLAYER,:)=ZWORK
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
END IF
@@ -336,7 +403,15 @@ IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR
WRITE(YRECFM,YFMT) 'ASN_',HSURFTYPE
YRECFM=ADJUSTL(HPREFIX//YRECFM)
ENDIF
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%ALB,2)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%ALB,2)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,JPATCH),IRESP,HDIR=YDIR)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,:),IRESP,HDIR=YDIR)
+#endif
WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
END IF
IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_gridtype_conf_proj.F90 b/src/SURFEX/read_gridtype_conf_proj.F90
index 575a57679408b21844d19764a1d42990f58d0cf8..aa902f34154109f2a3657d6c32dea9b7b17cba22 100644
--- a/src/SURFEX/read_gridtype_conf_proj.F90
+++ b/src/SURFEX/read_gridtype_conf_proj.F90
@@ -32,6 +32,7 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 02/2015 parallelization : using local fields
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -47,6 +48,10 @@ USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+#ifdef MNH_PARALLEL
+USE MODE_TOOLS_ll, ONLY : GET_DIM_PHYS_ll
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -83,6 +88,11 @@ REAL, DIMENSION(KLU) :: ZX ! X conformal coordinate of grid m
REAL, DIMENSION(KLU) :: ZY ! Y conformal coordinate of grid mesh
REAL, DIMENSION(KLU) :: ZDX ! X grid mesh size
REAL, DIMENSION(KLU) :: ZDY ! Y grid mesh size
+#ifdef MNH
+INTEGER :: IIMAX_LOC ! number of points in I direction local
+INTEGER :: IJMAX_LOC ! number of points in J direction local
+INTEGER :: IINFO
+#endif
!
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
@@ -109,6 +119,11 @@ IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
CALL READ_SURF(HPROGRAM,'LONORI',ZLONORI,KRESP,HDIR=HDIR)
CALL READ_SURF(HPROGRAM,'IMAX ',IIMAX, KRESP,HDIR=HDIR)
CALL READ_SURF(HPROGRAM,'JMAX ',IJMAX, KRESP,HDIR=HDIR)
+!
+#ifdef MNH_PARALLEL
+ CALL GET_DIM_PHYS_ll('B',IIMAX_LOC,IJMAX_LOC)
+#endif
+!
!
CALL READ_SURF(HPROGRAM,'XX',ZX,KRESP,HDIR=HDIR)
CALL READ_SURF(HPROGRAM,'YY',ZY,KRESP,HDIR=HDIR)
@@ -118,12 +133,18 @@ IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
!
!---------------------------------------------------------------------------
!
-!* 4. All this information stored into pointer PGRID_PAR
+!* 3. All this information stored into pointer PGRID_PAR
! --------------------------------------------------
!
+#ifdef MNH_PARALLEL
+ CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
+ ZLATORI,ZLONORI,IIMAX_LOC,IJMAX_LOC, &
+ ZX,ZY,ZDX,ZDY )
+#else
CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
ZLATORI,ZLONORI,IIMAX,IJMAX, &
ZX,ZY,ZDX,ZDY )
+#endif
!
!---------------------------------------------------------------------------
IF (OREAD) THEN
diff --git a/src/SURFEX/read_isban.F90 b/src/SURFEX/read_isban.F90
index 965c3fbcb18f4d1d494e24dee1cad614a50700b4..5fe79ab659ea16c0cdad49839772c214d45985bb 100644
--- a/src/SURFEX/read_isban.F90
+++ b/src/SURFEX/read_isban.F90
@@ -41,6 +41,7 @@
!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
+!! M.Moge 08/2015 reading SURFEX 3D fields one patch at a time for Z-parallel splitting with MNH
!!
!-------------------------------------------------------------------------------
!
@@ -87,12 +88,14 @@ INTEGER :: IRESP ! Error code after redding
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
!
CHARACTER(LEN=4) :: YLVL
+ CHARACTER(LEN=8) :: YPATCH
!
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
!
INTEGER :: IWORK ! Work integer
!
INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on layers
+INTEGER :: JPATCH ! loop counter on patches
!
INTEGER :: IVERSION ! surface version
INTEGER :: IBUGFIX
@@ -124,10 +127,20 @@ ENDIF
ALLOCATE(XTG(ILU,IWORK,NPATCH))
!
DO JL=1,IWORK
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
+ IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
+ YRECFM='TG'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XTG(:,JL,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I4)') JL
YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XTG(:,JL,:)=ZWORK
+#endif
END DO
!
!
@@ -140,17 +153,37 @@ XWG (:,:,:)=XUNDEF
XWGI(:,:,:)=XUNDEF
!
DO JL=1,NGROUND_LAYER
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
+ IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
+ YRECFM='WG'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XWG(:,JL,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I4)') JL
YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XWG(:,JL,:)=ZWORK
+#endif
END DO
!
DO JL=1,NGROUND_LAYER
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
+ IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
+ YRECFM='WGI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XWGI(:,JL,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I4)') JL
YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XWGI(:,JL,:)=ZWORK
+#endif
END DO
!
!* water intercepted on leaves
@@ -158,21 +191,42 @@ END DO
ALLOCATE(XWR(ILU,NPATCH))
!
YRECFM = 'WR'
+#ifdef MNH_PARALLEL
+DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A2,I4.4)') 'WR',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,JPATCH),IRESP)
+END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP)
+#endif
!
!* roughness length of Flood water
!
IF(LFLOOD)THEN
ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
YRECFM = 'Z0_FLOOD'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A8,I4.4)') 'Z0_FLOOD',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP)
+#endif
ENDIF
!
!* Leaf Area Index
!
IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
YRECFM = 'LAI'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A3,I4.4)') 'LAI',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP)
+#endif
END IF
!
!* snow mantel
@@ -189,7 +243,14 @@ IF(LGLACIER)THEN
ALLOCATE(XICE_STO(ILU,NPATCH))
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
YRECFM = 'ICE_STO'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A7,I4.4)') 'ICE_STO',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP)
+#endif
ELSE
XICE_STO(:,:) = 0.0
ENDIF
@@ -218,7 +279,14 @@ END IF
!
YRECFM = 'RESA'
XRESA(:,:) = 100.
+#ifdef MNH_PARALLEL
+DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A4,I4.4)') 'RESA',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,JPATCH),IRESP)
+END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP)
+#endif
!
!* patch averaged radiative temperature (K)
!
@@ -241,19 +309,47 @@ XLE(:,:) = XUNDEF
IF (CPHOTO/='NON') THEN
YRECFM = 'AN'
XAN(:,:) = 0.
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A2,I4.4)') 'AN',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP)
+#endif
!
YRECFM = 'ANDAY'
XANDAY(:,:) = 0.
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A5,I4.4)') 'ANDAY',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP)
+#endif
!
YRECFM = 'ANFM'
XANFM(:,:) = XANFMINIT
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A4,I4.4)') 'ANFM',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP)
+#endif
!
YRECFM = 'LE_AGS'
XLE(:,:) = 0.
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YRECFM,'(A6,I4.4)') 'LE_AGS',JPATCH
+ CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,JPATCH),IRESP)
+ END DO
+#else
CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP)
+#endif
END IF
!
IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
@@ -270,6 +366,18 @@ ELSEIF (CPHOTO=='NIT') THEN
!
XBIOMASS(:,:,:) = 0.
DO JNBIOMASS=1,NNBIOMASS
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='BIOMA'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ELSE
+ YRECFM='BIOMASS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XBIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -278,10 +386,23 @@ ELSEIF (CPHOTO=='NIT') THEN
ENDIF
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XBIOMASS(:,JNBIOMASS,:)=ZWORK
+#endif
END DO
XRESP_BIOMASS(:,:,:) = 0.
DO JNBIOMASS=2,NNBIOMASS
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ELSE
+ YRECFM='RESP_BIOM'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XRESP_BIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -290,12 +411,25 @@ ELSEIF (CPHOTO=='NIT') THEN
ENDIF
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
+#endif
END DO
ELSEIF (CPHOTO=='NCB') THEN
!
XBIOMASS(:,:,:) = 0.
DO JNBIOMASS=1,NNBIOMASS
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='BIOMA'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ELSE
+ YRECFM='BIOMASS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XBIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -304,10 +438,23 @@ ELSEIF (CPHOTO=='NCB') THEN
ENDIF
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XBIOMASS(:,JNBIOMASS,:)=ZWORK
+#endif
END DO
XRESP_BIOMASS(:,:,:) = 0.
DO JNBIOMASS=2,NNBIOMASS-2
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ELSE
+ YRECFM='RESP_BIOM'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XRESP_BIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -316,6 +463,7 @@ ELSEIF (CPHOTO=='NCB') THEN
ENDIF
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
+#endif
END DO
!
ENDIF
@@ -334,27 +482,54 @@ IF (CRESPSL=='CNT') THEN
XLITTER(:,:,:,:) = 0.
DO JNLITTER=1,NNLITTER
DO JNLITTLEVS=1,NNLITTLEVS
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I1,A1,I1,I4.4)') JNLITTER,'_',JNLITTLEVS,JPATCH
+ YRECFM='LITTER'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XLITTER(:,JNLITTER,JNLITTLEVS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
+#endif
END DO
END DO
XSOILCARB(:,:,:) = 0.
DO JNSOILCARB=1,NNSOILCARB
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I4,I4.4)') JNSOILCARB,JPATCH
+ YRECFM='SOILCARB'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XSOILCARB(:,JNSOILCARB,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I4)') JNSOILCARB
YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XSOILCARB(:,JNSOILCARB,:)=ZWORK
+#endif
END DO
!
XLIGNIN_STRUC(:,:,:) = 0.
DO JNLITTLEVS=1,NNLITTLEVS
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,NPATCH
+ WRITE(YPATCH,'(I4,I4.4)') JNLITTLEVS,JPATCH
+ YRECFM='LIGNIN_STR'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
+ XLIGNIN_STRUC(:,JNLITTLEVS,JPATCH)=ZWORK(:,JPATCH)
+ END DO
+#else
WRITE(YLVL,'(I4)') JNLITTLEVS
YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
XLIGNIN_STRUC(:,JNLITTLEVS,:)=ZWORK
+#endif
END DO
!
ENDIF
diff --git a/src/SURFEX/read_lcover.F90 b/src/SURFEX/read_lcover.F90
index ffbfb36f131cfe5ae8a68dd025db5c545b41f912..57d0b2e971d426711dad785a533d71951614ed50 100644
--- a/src/SURFEX/read_lcover.F90
+++ b/src/SURFEX/read_lcover.F90
@@ -36,6 +36,7 @@
!! MODIFICATIONS
!! -------------
!! Original 10/2008
+!! M. Moge 02/2015 parallelization
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -51,6 +52,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifndef NOMPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -65,6 +70,7 @@ INTEGER :: IRESP ! Error code after redding
INTEGER :: IVERSION ! version of surfex file being read
LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! cover list in the file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IINFO
!-------------------------------------------------------------------------------
!
!
@@ -80,9 +86,11 @@ END IF
CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
!
-OCOVER=.FALSE.
-OCOVER(:SIZE(GCOVER))=GCOVER(:)
+#ifndef NOMPI
+CALL MPI_ALLREDUCE(GCOVER, OCOVER, SIZE(GCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
+#endif
DEALLOCATE(GCOVER)
+!
IF (LHOOK) CALL DR_HOOK('READ_LCOVER',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_pgd_isban.F90 b/src/SURFEX/read_pgd_isban.F90
index 206194fd7b7fd24e6d1910ef8af56d06ed169976..b4564c818ab4d9b12a45f03b1b2510105df7df94 100644
--- a/src/SURFEX/read_pgd_isban.F90
+++ b/src/SURFEX/read_pgd_isban.F90
@@ -37,6 +37,7 @@
!! B. Decharme 06/2009 : add topographic index statistics
!! A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
!! B. Decharme 07/2012 : files of data for permafrost area and for SOC top and sub soil
+!! M. Moge 02/2015 READ_SURF
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -223,7 +224,7 @@ ALLOCATE(LCOVER(JPCOVER))
CALL READ_LCOVER(HPROGRAM,LCOVER)
!
ALLOCATE(XCOVER(NDIM,JPCOVER))
- CALL READ_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP)
+ CALL READ_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HDIR='H')
!
!* 3.2 Orography :
! ---------
diff --git a/src/SURFEX/read_pgd_tebn.F90 b/src/SURFEX/read_pgd_tebn.F90
index f848997e26ece06c822544bca3031e7ad4a92f49..db3d20aa61dc3c51d78cc0f9cce02d4db5ecc798 100644
--- a/src/SURFEX/read_pgd_tebn.F90
+++ b/src/SURFEX/read_pgd_tebn.F90
@@ -33,6 +33,7 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2003
+!! M. Moge 02/2015 READ_SURF
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -161,7 +162,7 @@ ALLOCATE(LCOVER(JPCOVER))
CALL READ_LCOVER(HPROGRAM,LCOVER)
!
ALLOCATE(XCOVER(NDIM,JPCOVER))
- CALL READ_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP)
+ CALL READ_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HDIR='H')
!
!* orography
!
diff --git a/src/SURFEX/regular_grid_spawn.F90 b/src/SURFEX/regular_grid_spawn.F90
index 362cd306deb72ee8900e57eb76a9b249d4978c04..f88bd968bb382e151debbcf3ca1ba2f2c5d6307d 100644
--- a/src/SURFEX/regular_grid_spawn.F90
+++ b/src/SURFEX/regular_grid_spawn.F90
@@ -7,7 +7,7 @@
KL1, KIMAX1,KJMAX1,PX1,PY1,PDX1,PDY1, &
KXOR, KYOR, KDXRATIO, KDYRATIO, &
KXSIZE, KYSIZE, &
- KL2, KIMAX2,KJMAX2,PX2,PY2,PDX2,PDY2 )
+ KL2, KIMAX_C_ll,KJMAX_C_ll,PX2,PY2,PDX2,PDY2 )
! ################################################################
!
!!**** *REGULAR_GRID_SPAWN* - routine to read in namelist the horizontal grid
@@ -36,6 +36,8 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! M.Moge 04/2015 Parallelization using routines from MNH/SURCOUCHE
+!! M.Moge 06/2015 bug fix for reproductibility using UPDATE_NHALO1D
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -46,8 +48,21 @@ USE MODD_SURF_PAR, ONLY : NUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODD_SURF_ATM_n, ONLY : NIMAX_SURF_ll, NJMAX_SURF_ll
!
USE MODI_ABOR1_SFX
+#ifdef MNH_PARALLEL
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+
+USE MODE_SPLITTING_ll, ONLY : SPLIT2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll, CRSPD_ll
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODE_TOOLS_ll, ONLY : INTERSECTION
+USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_FIELD
+USE MODI_UPDATE_NHALO1D
+#endif
!
IMPLICIT NONE
!
@@ -68,36 +83,77 @@ INTEGER, INTENT(IN) :: KXSIZE ! number of grid meshe
INTEGER, INTENT(IN) :: KYSIZE ! covered by the modified grid
INTEGER, INTENT(IN) :: KDXRATIO ! resolution ratio between modified grid
INTEGER, INTENT(IN) :: KDYRATIO ! and initial grid
-INTEGER, INTENT(IN) :: KL2 ! total number of points KIMAX2 * KJMAX2
-INTEGER, INTENT(IN) :: KIMAX2 ! number of points in x direction
-INTEGER, INTENT(IN) :: KJMAX2 ! number of points in y direction
+INTEGER, INTENT(IN) :: KL2 ! total number of points KIMAX_C_ll * KJMAX_C_ll
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(INOUT) :: KIMAX_C_ll ! number of points in x direction (glb on entry, lcl on exit)
+INTEGER, INTENT(INOUT) :: KJMAX_C_ll ! number of points in y direction (glb on entry, lcl on exit)
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PX2 ! X coordinate of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PY2 ! Y coordinate of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDX2 ! X mesh size of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDY2 ! Y mesh size of all points
+#else
+INTEGER, INTENT(IN) :: KIMAX_C_ll ! number of points in x direction
+INTEGER, INTENT(IN) :: KJMAX_C_ll ! number of points in y direction
REAL, DIMENSION(KL2), INTENT(OUT) :: PX2 ! X coordinate of all points
REAL, DIMENSION(KL2), INTENT(OUT) :: PY2 ! Y coordinate of all points
REAL, DIMENSION(KL2), INTENT(OUT) :: PDX2 ! X mesh size of all points
REAL, DIMENSION(KL2), INTENT(OUT) :: PDY2 ! Y mesh size of all points
+#endif
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-!* initial grid
+!* coarse/father grid
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXM1 ! X coordinate of center of mesh (IIMAX1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYM1 ! Y coordinate of center of mesh (IJMAX1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT1 ! X coordinate of left side (IIMAX1+1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT1 ! Y coordinate of bottom side (IJMAX1+1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZXM1 ! X coordinate of center of mesh (IIMAX1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYM1 ! Y coordinate of center of mesh (IJMAX1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT1 ! X coordinate of left side (IIMAX1+1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT1 ! Y coordinate of bottom side (IJMAX1+1 points)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT1_3D, ZYHAT1_3D ! ZXHAT1 and ZXHAT1 copied in a 3D field for the communications
!
-!* new grid
+!* fine/son grid
!
REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2 ! X coordinate of left side (IIMAX2 points)
REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2 ! Y coordinate of bottom side (IJMAX2 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2_F_TMP
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2_F_TMP
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT2_F, ZYHAT2_F ! temporary 3D fields to communicate the values on the father grid to the local son subgrid
!
!* other variables
!
INTEGER :: JL ! loop counter
INTEGER :: JI,JJ ! loop controls relatively to modified grid
-INTEGER :: JIBOX,JJBOX ! grid mesh relatively to initial grid
-REAL :: ZCOEF ! ponderation coefficient for linear interpolation
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IMI
+INTEGER :: IINFO_ll
+INTEGER :: IXOR_F_ll, IYOR_F_ll ! origin of local father subdomain in global coordinates
+INTEGER :: IXDIM_C, IYDIM_C ! size of local son subdomain (in coarse/father grid)
+INTEGER :: IXOR_C_ll, IYOR_C_ll ! origin of local son subdomain (in global fine/son grid)
+INTEGER :: IXEND_C_ll, IYEND_C_ll ! end of local son subdomain (in global fine/son grid)
+INTEGER :: IXOR_C_COARSE_ll, IYOR_C_COARSE_ll ! origin of local son subdomain (in global coarse/father grid)
+INTEGER :: IIMAX_C ! number of points in x direction in local portion of son model (in fine grid)
+INTEGER :: IJMAX_C ! number of points in y direction in local portion of son model (in fine grid)
+REAL, DIMENSION(KDXRATIO) :: ZCOEFX ! ponderation coefficients for linear interpolation
+REAL, DIMENSION(KDYRATIO) :: ZCOEFY ! ponderation coefficients for linear interpolation
+!
+! structures for the partitionning
+!
+#ifdef MNH_PARALLEL
+TYPE(ZONE_ll), DIMENSION(NPROC) :: TZSPLITTING_C !splitting of child model
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSEFATHER ! Coarse father grid splitting
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSESONSPLIT ! coarse son grid intersection with local father subdomain : coordinates in the father grid
+!
+! structures for the communications
+!
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZSEND, TZRECV
+TYPE(CRSPD_ll), POINTER :: TZCRSPDSEND, TZCRSPDRECV
+TYPE(CRSPD_ll), ALLOCATABLE, DIMENSION(:), TARGET :: TZCRSPDSENDTAB, TZCRSPDRECVTAB
+#endif
+!
+INTEGER :: J
+INTEGER :: INBMSG
+INTEGER :: ICARD
+INTEGER :: ICARDDIF
!
!------------------------------------------------------------------------------
!
@@ -107,30 +163,266 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* tests
!
IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',0,ZHOOK_HANDLE)
-IF ( KXOR+KXSIZE-1 > KIMAX1 ) THEN
+IF ( KXOR+KXSIZE-1 > NIMAX_SURF_ll ) THEN
WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
WRITE(KLUOUT,*) 'IXOR = ', KXOR, ' IXSIZE = ', KXSIZE,&
- ' with NIMAX(file) = ', KIMAX1
+ ' with NIMAX(file) = ', NIMAX_SURF_ll
CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (1) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
END IF
-IF ( KYOR+KYSIZE-1 > KJMAX1 ) THEN
+IF ( KYOR+KYSIZE-1 > NJMAX_SURF_ll ) THEN
WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
WRITE(KLUOUT,*) 'IYOR = ', KYOR, ' IYSIZE = ', KYSIZE,&
- ' with NJMAX(file) = ', KJMAX1
+ ' with NJMAX(file) = ', NJMAX_SURF_ll
CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (2) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
END IF
!
!------------------------------------------------------------------------------
!
-!* 2. Center of mesh coordinate arrays for each direction separately
+!* 2. Partitionning of the son subdomain
! --------------------------------------------------------------
!
+#ifdef MNH_PARALLEL
+! get origin of local father subdomain in global coordinates
+!
+CALL GET_OR_ll( "B", IXOR_F_ll, IYOR_F_ll )
+!
+! origin of local son subdomain in global father coordinates
+!
+!IXOR_C_COARSE_ll = MAX( IXOR_F_ll, KXOR+1 )
+!IYOR_C_COARSE_ll = MAX( IYOR_F_ll, KYOR+1 )
+IXOR_C_COARSE_ll = MAX( IXOR_F_ll-1, KXOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
+IYOR_C_COARSE_ll = MAX( IYOR_F_ll-1, KYOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
+!
+ALLOCATE(TZCOARSEFATHER(NPROC))
+ALLOCATE(TZCOARSESONSPLIT(NPROC))
+!
+! compute father partitioning
+!
+CALL SPLIT2(NIMAX_SURF_ll, NJMAX_SURF_ll, 1, NPROC,TZCOARSEFATHER, YSPLITTING)
+! we don't want the halo
+DO J = 1, NPROC
+ TZCOARSEFATHER(J)%NXOR = TZCOARSEFATHER(J)%NXOR - JPHEXT
+ TZCOARSEFATHER(J)%NYOR = TZCOARSEFATHER(J)%NYOR - JPHEXT
+ TZCOARSEFATHER(J)%NXEND = TZCOARSEFATHER(J)%NXEND - JPHEXT
+ TZCOARSEFATHER(J)%NYEND = TZCOARSEFATHER(J)%NYEND - JPHEXT
+ENDDO
+!
+! partition son domain on father grid (with global coordinates on father grid)
+!
+! we have to add one point on the west and south sides -> hence the "- 1"
+CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING)
+! compute the local size of son grid
+! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
+IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
+IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
+! get the coordinates of the son domain partition on father grid
+DO J = 1, NPROC
+ TZCOARSESONSPLIT(J)%NXOR = TZCOARSESONSPLIT(J)%NXOR + KXOR - JPHEXT - 1
+ TZCOARSESONSPLIT(J)%NYOR = TZCOARSESONSPLIT(J)%NYOR + KYOR - JPHEXT - 1
+ TZCOARSESONSPLIT(J)%NXEND = TZCOARSESONSPLIT(J)%NXEND + KXOR - JPHEXT
+ TZCOARSESONSPLIT(J)%NYEND = TZCOARSESONSPLIT(J)%NYEND + KYOR - JPHEXT
+ENDDO
+!
+! compute the local size of son grid
+! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
+!
+!CALL SPLIT2 ( KIMAX_C_ll, KJMAX_C_ll, 1, NPROC, TZSPLITTING_C, YSPLITTING )
+!IXOR_C_ll = TZSPLITTING_C(IP)%NXOR - JPHEXT
+!IXEND_C_ll = TZSPLITTING_C(IP)%NXEND - JPHEXT
+!IYOR_C_ll = TZSPLITTING_C(IP)%NYOR - JPHEXT
+!IYEND_C_ll = TZSPLITTING_C(IP)%NYEND - JPHEXT
+!!
+!IIMAX_C = IXEND_C_ll - IXOR_C_ll + 1
+!IJMAX_C = IYEND_C_ll - IYOR_C_ll + 1
+!IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
+!IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
+!
+!------------------------------------------------------------------------------
+!
+!* 3. Preparing the structures for the communications for the initialization of son fields using father fields
+! --------------------------------------------------------------
+!
+ !
+ ! ######## initializing the structures for the SEND ########
+ !
+ ALLOCATE(TZSEND(NPROC))
+ CALL INTERSECTION( TZCOARSESONSPLIT, NPROC, TZCOARSEFATHER(IP), TZSEND)
+ ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
+ ! on concatene le num du proc qui envoie et le num du proc qui recoit
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ IF (TZSEND(J)%NUMBER == 1) THEN
+ TZSEND(J)%MSSGTAG = IP * 10 + 1
+ ELSE
+ TZSEND(J)%MSSGTAG = IP * 10**(CEILING(LOG10(real(TZSEND(J)%NUMBER)))) + TZSEND(J)%NUMBER
+ ENDIF
+ ENDIF
+ ENDDO
+ ! switching to local coordinates
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ TZSEND(J)%NXOR = TZSEND(J)%NXOR - IXOR_F_ll + 1
+ TZSEND(J)%NXEND = TZSEND(J)%NXEND - IXOR_F_ll + 1
+ TZSEND(J)%NYOR = TZSEND(J)%NYOR - IYOR_F_ll + 1
+ TZSEND(J)%NYEND = TZSEND(J)%NYEND - IYOR_F_ll + 1
+ ENDIF
+ ENDDO
+ ! we do not need the Z dimension
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ TZSEND(J)%NZOR = 1
+ TZSEND(J)%NZEND = 1
+ ENDIF
+ ENDDO
+ ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
+ INBMSG = 0
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ INBMSG = INBMSG+1
+ ENDIF
+ ENDDO
+ IF ( INBMSG > 0 ) THEN
+ ALLOCATE( TZCRSPDSENDTAB(INBMSG) )
+ ICARD = 0
+ ICARDDIF = 0
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ ICARD = ICARD+1
+ IF ( TZSEND(ICARD)%NUMBER /= IP ) THEN
+ ICARDDIF = ICARDDIF+1
+ ENDIF
+ TZCRSPDSENDTAB(ICARD)%TELT = TZSEND(J)
+ IF ( ICARD == INBMSG ) THEN
+ TZCRSPDSENDTAB(ICARD)%TNEXT => NULL()
+ ELSE
+ TZCRSPDSENDTAB(ICARD)%TNEXT => TZCRSPDSENDTAB(ICARD+1)
+ ENDIF
+ ENDIF
+ ENDDO
+ DO J = 1, ICARD
+ TZCRSPDSENDTAB(J)%NCARD = ICARD
+ TZCRSPDSENDTAB(J)%NCARDDIF = ICARDDIF
+ ENDDO
+ ELSE
+ !il faut tout de meme mettre un element de taille 0 dans TZCRSPDSENDTAB
+ !sinon SEND_RECV_FIELD plante en 02
+ ALLOCATE( TZCRSPDSENDTAB(1) )
+ ICARD = 0
+ ICARDDIF = 0
+ TZCRSPDSENDTAB(1)%TELT = TZSEND(1)
+ TZCRSPDSENDTAB(1)%TNEXT => NULL()
+ TZCRSPDSENDTAB(1)%NCARD = 0
+ TZCRSPDSENDTAB(1)%NCARDDIF = 0
+ ENDIF
+! IF (ICARD > 0) THEN
+ TZCRSPDSEND => TZCRSPDSENDTAB(1)
+! ELSE
+! TZCRSPDSEND => NULL()
+! ENDIF
+ !
+ ! ######## initializing the structures for the RECV ########
+ !
+ ALLOCATE(TZRECV(NPROC))
+ CALL INTERSECTION( TZCOARSEFATHER, NPROC, TZCOARSESONSPLIT(IP), TZRECV )
+ ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
+ ! on concatene le num du proc qui envoie et le num du proc qui recoit
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ IF (IP == 1) THEN
+ TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10 + 1
+ ELSE
+ TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10**(CEILING(LOG10(real(IP)))) + IP
+ ENDIF
+ ENDIF
+ ENDDO
+ ! switching to local coordinates
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ TZRECV(J)%NXOR = TZRECV(J)%NXOR - TZCOARSESONSPLIT(IP)%NXOR + 1
+ TZRECV(J)%NXEND = TZRECV(J)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1
+ TZRECV(J)%NYOR = TZRECV(J)%NYOR - TZCOARSESONSPLIT(IP)%NYOR + 1
+ TZRECV(J)%NYEND = TZRECV(J)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1
+ ENDIF
+ ENDDO
+ ! we do not need the Z dimension
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ TZRECV(J)%NZOR = 1
+ TZRECV(J)%NZEND = 1
+ ENDIF
+ ENDDO
+ ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
+ INBMSG = 0
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ INBMSG = INBMSG+1
+ ENDIF
+ ENDDO
+ IF ( INBMSG > 0 ) THEN
+ ALLOCATE( TZCRSPDRECVTAB(INBMSG) )
+ ICARD = 0
+ ICARDDIF = 0
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ ICARD = ICARD+1
+ IF ( TZRECV(ICARD)%NUMBER /= IP ) THEN
+ ICARDDIF = ICARDDIF+1
+ ENDIF
+ TZCRSPDRECVTAB(ICARD)%TELT = TZRECV(J)
+ IF ( ICARD == INBMSG ) THEN
+ TZCRSPDRECVTAB(ICARD)%TNEXT => NULL()
+ ELSE
+ TZCRSPDRECVTAB(ICARD)%TNEXT => TZCRSPDRECVTAB(ICARD+1)
+ ENDIF
+ ENDIF
+ ENDDO
+ DO J = 1, ICARD
+ TZCRSPDRECVTAB(J)%NCARD = ICARD
+ TZCRSPDRECVTAB(J)%NCARDDIF = ICARDDIF
+ ENDDO
+ ELSE
+ !il faut tout de meme mettre un element de taille 0 dans TZCRSPDRECVTAB
+ !sinon SEND_RECV_FIELD plante en 02
+ ALLOCATE( TZCRSPDRECVTAB(1) )
+ ICARD = 0
+ ICARDDIF = 0
+ TZCRSPDRECVTAB(1)%TELT = TZSEND(1)
+ TZCRSPDRECVTAB(1)%TNEXT => NULL()
+ TZCRSPDRECVTAB(1)%NCARD = 0
+ TZCRSPDRECVTAB(1)%NCARDDIF = 0
+ ENDIF
+! IF (ICARD > 0) THEN
+ TZCRSPDRECV => TZCRSPDRECVTAB(1)
+! ELSE
+! TZCRSPDRECV => NULL()
+! ENDIF
+#else
+IIMAX_C = KIMAX_C_ll
+IJMAX_C = KJMAX_C_ll
+#endif
+!
+!------------------------------------------------------------------------------
+!
+!* 4. Center of mesh coordinate arrays for each direction separately
+! --------------------------------------------------------------
+!
+! allocate the fields on the local son grid
+!
+#ifdef MNH_PARALLEL
+ALLOCATE(PX2(IIMAX_C*IJMAX_C))
+ALLOCATE(PY2(IIMAX_C*IJMAX_C))
+ALLOCATE(PDX2(IIMAX_C*IJMAX_C))
+ALLOCATE(PDY2(IIMAX_C*IJMAX_C))
+#endif
+ALLOCATE(ZXHAT2(IIMAX_C+1))
+ALLOCATE(ZYHAT2(IJMAX_C+1))
+!
+! allocate the fields on the local father grid
+!
ALLOCATE(ZXM1 (KIMAX1))
ALLOCATE(ZYM1 (KJMAX1))
ALLOCATE(ZXHAT1(KIMAX1+1))
ALLOCATE(ZYHAT1(KJMAX1+1))
-ALLOCATE(ZXHAT2(KIMAX2+1))
-ALLOCATE(ZYHAT2(KJMAX2+1))
!
ZXM1(:) = PX1(1:KIMAX1)
DO JL=1,KL1
@@ -139,7 +431,7 @@ END DO
!
!------------------------------------------------------------------------------
!
-!* 3. side of mesh coordinate arrays for each direction separately
+!* 5. side of mesh coordinate arrays for each direction separately
! ------------------------------------------------------------
!
!
@@ -164,51 +456,125 @@ ELSE
END DO
ZYHAT1(KJMAX1+1) = 1.5 * ZYM1(KJMAX1) - 0.5 * ZYM1(KJMAX1-1)
END IF
+#ifdef MNH_PARALLEL
+ !
+ ! do the communication
+ !
+ IXDIM_C = TZCOARSESONSPLIT(IP)%NXEND-TZCOARSESONSPLIT(IP)%NXOR+1
+ IYDIM_C = TZCOARSESONSPLIT(IP)%NYEND-TZCOARSESONSPLIT(IP)%NYOR+1
+ ALLOCATE(ZXHAT2_F(IXDIM_C,IYDIM_C,1))
+ ALLOCATE(ZYHAT2_F(IXDIM_C,IYDIM_C,1))
+ ALLOCATE(ZXHAT1_3D(KIMAX1,KJMAX1,1))
+ ALLOCATE(ZYHAT1_3D(KIMAX1,KJMAX1,1))
+ ZXHAT1_3D(:,:,:) = 0
+ ZYHAT1_3D(:,:,:) = 0
+ ZXHAT2_F(:,:,:) = 0
+ ZYHAT2_F(:,:,:) = 0
+ DO J=1, KJMAX1
+ ZXHAT1_3D(:,J,1) = ZXHAT1(1:KIMAX1)
+ ENDDO
+ DO J=1, KIMAX1
+ ZYHAT1_3D(J,:,1) = ZYHAT1(1:KJMAX1)
+ ENDDO
+ CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZXHAT1_3D, ZXHAT2_F, IINFO_ll)
+ CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZYHAT1_3D, ZYHAT2_F, IINFO_ll)
+!
+! We have to copy the entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process,
+! and that are therefore not communicated in SEND_RECV_FIELD, in ZXHAT2_F and ZYHAT2_F
+!
+ IF ( TZSEND(IP)%NUMBER /= 0 ) THEN !if there are entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process
+! DO J=TZSEND(IP)%NXOR-KXOR,TZSEND(IP)%NXEND-KXOR
+ ZXHAT2_F( TZRECV(IP)%NXOR:TZRECV(IP)%NXEND, 1, 1) = ZXHAT1_3D( TZSEND(IP)%NXOR:TZSEND(IP)%NXEND, 1, 1)
+! ENDDO
+! DO J=TZSEND(IP)%NYOR-KYOR,TZSEND(IP)%NYEND-KYOR
+ ZYHAT2_F( 1,TZRECV(IP)%NYOR:TZRECV(IP)%NYEND, 1) = ZYHAT1_3D( 1,TZSEND(IP)%NYOR:TZSEND(IP)%NYEND, 1)
+! ENDDO
+ ENDIF
+ !
+ ! We need one halo point on the east and north sides of each local subdomain to do a proper interpolation
+ !
+ ALLOCATE( ZXHAT2_F_TMP(IXDIM_C+1) )
+ ALLOCATE( ZYHAT2_F_TMP(IYDIM_C+1) )
+ ZXHAT2_F_TMP(:) = 0.
+ ZYHAT2_F_TMP(:) = 0.
+ ZXHAT2_F_TMP(1:IXDIM_C) = ZXHAT2_F(:,1,1)
+ ZYHAT2_F_TMP(1:IYDIM_C) = ZYHAT2_F(1,:,1)
+ CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING)
+ CALL UPDATE_NHALO1D( 1, ZXHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
+ TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'XX ')
+ CALL UPDATE_NHALO1D( 1, ZYHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
+ TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'YY ')
+#endif
!
!------------------------------------------------------------------------------
!
-!* 5. Interpolation of coordinate arrays for each direction separately
+!* 6. Interpolation of coordinate arrays for each direction separately
! ----------------------------------------------------------------
!
!* X coordinate array
!
-DO JI=1,KIMAX2
- JIBOX=(JI-1)/KDXRATIO + KXOR
- ZCOEF= FLOAT(MOD(JI-1,KDXRATIO))/FLOAT(KDXRATIO)
- ZXHAT2(JI)=(1.-ZCOEF)*ZXHAT1(JIBOX)+ZCOEF*ZXHAT1(JIBOX+1)
-END DO
-IF (KIMAX2==1) THEN
- ZXHAT2(KIMAX2+1) = ZXHAT2(KIMAX2) + ZXHAT1(JIBOX+1) - ZXHAT1(JIBOX)
+DO J=0,KDXRATIO-1
+ ZCOEFX(J+1) = FLOAT(J)/FLOAT(KDXRATIO)
+ENDDO
+DO JI=1,IXDIM_C-1
+ DO JJ=1,KDXRATIO
+ ZXHAT2((JI-1)*KDXRATIO+JJ)=(1.-ZCOEFX(JJ))*ZXHAT2_F(JI,1,1)+ZCOEFX(JJ)*ZXHAT2_F(JI+1,1,1)
+ ENDDO
+ENDDO
+IF (IIMAX_C==1) THEN
+ ZXHAT2(IIMAX_C+1) = ZXHAT2(IIMAX_C) + ZXHAT2_F(JI,1,1) - ZXHAT2_F(JI,1,1)
ELSE
- ZXHAT2(KIMAX2+1) = 2. * ZXHAT2(KIMAX2) - ZXHAT2(KIMAX2-1)
+#ifdef MNH_PARALLEL
+ IF ( LEAST_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
+ ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
+ ELSE
+ ZXHAT2(IIMAX_C+1)=(1.-ZCOEFX(1))*ZXHAT2_F_TMP(IXDIM_C)+ZCOEFX(1)*ZXHAT2_F_TMP(IXDIM_C+1)
+ ENDIF
+#else
+ ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
+#endif
END IF
!
-!
!* Y coordinate array
!
-DO JJ=1,KJMAX2
- JJBOX=(JJ-1)/KDYRATIO + KYOR
- ZCOEF= FLOAT(MOD(JJ-1,KDYRATIO))/FLOAT(KDYRATIO)
- ZYHAT2(JJ)=(1.-ZCOEF)*ZYHAT1(JJBOX)+ZCOEF*ZYHAT1(JJBOX+1)
-END DO
-IF (KJMAX2==1) THEN
- ZYHAT2(KJMAX2+1) = ZYHAT2(KJMAX2) + ZYHAT1(JJBOX+1) - ZYHAT1(JJBOX)
+DO J=0,KDYRATIO-1
+ ZCOEFY(J+1) = FLOAT(J)/FLOAT(KDYRATIO)
+ENDDO
+DO JI=1,IYDIM_C-1
+ DO JJ=1,KDYRATIO
+ ZYHAT2((JI-1)*KDYRATIO+JJ)=(1.-ZCOEFY(JJ))*ZYHAT2_F(1,JI,1)+ZCOEFY(JJ)*ZYHAT2_F(1,JI+1,1)
+ ENDDO
+ENDDO
+IF (IJMAX_C==1) THEN
+ ZYHAT2(IJMAX_C+1) = ZYHAT2(IJMAX_C) + ZYHAT2_F(1,JI,1) - ZYHAT2_F(1,JI,1)
ELSE
- ZYHAT2(KJMAX2+1) = 2. * ZYHAT2(KJMAX2) - ZYHAT2(KJMAX2-1)
+#ifdef MNH_PARALLEL
+ IF ( LNORTH_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
+ ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
+ ELSE
+ ZYHAT2(IJMAX_C+1)=(1.-ZCOEFY(1))*ZYHAT2_F_TMP(IYDIM_C)+ZCOEFY(1)*ZYHAT2_F_TMP(IYDIM_C+1)
+ ENDIF
+#else
+ ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
+#endif
END IF
!---------------------------------------------------------------------------
DEALLOCATE(ZXM1)
DEALLOCATE(ZYM1)
DEALLOCATE(ZXHAT1)
DEALLOCATE(ZYHAT1)
+#ifdef MNH_PARALLEL
+DEALLOCATE(ZXHAT1_3D)
+DEALLOCATE(ZYHAT1_3D)
+#endif
!------------------------------------------------------------------------------
!
-!* 5. Coordinate arrays of all points
+!* 7. Coordinate arrays of all points
! -------------------------------
!
-DO JJ=1,KJMAX2
- DO JI=1,KIMAX2
- JL = (JJ-1) * KIMAX2 + JI
+DO JJ=1,IJMAX_C
+ DO JI=1,IIMAX_C
+ JL = (JJ-1) * IIMAX_C + JI
PX2 (JL) = 0.5 * ZXHAT2(JI) + 0.5 * ZXHAT2(JI+1)
PDX2(JL) = ZXHAT2(JI+1) - ZXHAT2(JI)
PY2 (JL) = 0.5 * ZYHAT2(JJ) + 0.5 * ZYHAT2(JJ+1)
@@ -216,7 +582,21 @@ DO JJ=1,KJMAX2
END DO
END DO
!
+#ifdef MNH_PARALLEL
+KIMAX_C_ll = IIMAX_C
+KJMAX_C_ll = IJMAX_C
+#endif
!---------------------------------------------------------------------------
+#ifdef MNH_PARALLEL
+DEALLOCATE(ZXHAT2_F)
+DEALLOCATE(ZYHAT2_F)
+DEALLOCATE(TZCRSPDSENDTAB)
+DEALLOCATE(TZCRSPDRECVTAB)
+DEALLOCATE(TZSEND)
+DEALLOCATE(TZRECV)
+DEALLOCATE(TZCOARSEFATHER)
+DEALLOCATE(TZCOARSESONSPLIT)
+#endif
DEALLOCATE(ZXHAT2)
DEALLOCATE(ZYHAT2)
IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/split_grid.F90 b/src/SURFEX/split_grid.F90
index e8e4428d1708214e6865e6793f5d46c9e4b4a7e0..ebf8c726386a720f12102479472b214e804dda70 100644
--- a/src/SURFEX/split_grid.F90
+++ b/src/SURFEX/split_grid.F90
@@ -3,7 +3,11 @@
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
! ###########################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID(HPROGRAM,KGRID_PAR,PGRID_PAR,KHALO)
+#else
SUBROUTINE SPLIT_GRID(HPROGRAM)
+#endif
! ###########################################################
!!
!! PURPOSE
@@ -33,12 +37,17 @@
!! ------------
!!
!! Original 08/11
+!! Modification 01/03/2015 pass KGRID_PAR,PGRID_PAR,KHALO as arguments (M.Moge)
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+#ifdef MNH_PARALLEL
+USE MODD_SURF_ATM_GRID_n, ONLY : CGRID
+#else
USE MODD_SURF_ATM_GRID_n, ONLY : CGRID, XGRID_PAR, NGRID_PAR
+#endif
USE MODD_SURF_ATM_n, ONLY : NDIM_FULL, NSIZE_FULL
!
USE MODI_SPLIT_GRID_CONF_PROJ
@@ -55,6 +64,11 @@ IMPLICIT NONE
! ------------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
+REAL, DIMENSION(:), POINTER, INTENT(INOUT) :: PGRID_PAR ! parameters defining this grid
+INTEGER, INTENT(IN), OPTIONAL :: KHALO ! size of the Halo
+#endif
!
!
!* 0.2 Declaration of local variables
@@ -63,17 +77,36 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IRESP ! error return code
+INTEGER :: IHALO
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SPLIT_GRID',0,ZHOOK_HANDLE)
+#ifdef MNH_PARALLEL
+IF (PRESENT(KHALO)) THEN
+ IHALO = KHALO
+ELSE
+ IHALO = 0
+ENDIF
+#else
+IHALO = 0
+#endif
!
SELECT CASE(CGRID)
+#ifdef MNH_PARALLEL
+ CASE('CONF PROJ ')
+ CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,NDIM_FULL,NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
+ CASE('CARTESIAN ')
+ CALL SPLIT_GRID_CARTESIAN(HPROGRAM,NDIM_FULL,NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
+ CASE DEFAULT
+ CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL)
+#else
CASE('CONF PROJ ')
CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,NDIM_FULL,NSIZE_FULL,NGRID_PAR,XGRID_PAR)
CASE('CARTESIAN ')
CALL SPLIT_GRID_CARTESIAN(HPROGRAM,NDIM_FULL,NSIZE_FULL,NGRID_PAR,XGRID_PAR)
CASE DEFAULT
CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL)
+#endif
END SELECT
!
diff --git a/src/SURFEX/split_grid_cartesian.F90 b/src/SURFEX/split_grid_cartesian.F90
index 315f581b67df7701690dc9c27b18d009022ed443..0fa983c441ae6583c22b077795e86f9c3080907c 100644
--- a/src/SURFEX/split_grid_cartesian.F90
+++ b/src/SURFEX/split_grid_cartesian.F90
@@ -3,7 +3,11 @@
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
! ###########################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_CARTESIAN(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR,KHALO)
+#else
SUBROUTINE SPLIT_GRID_CARTESIAN(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR)
+#endif
! ###########################################################
!!
!! PURPOSE
@@ -33,6 +37,7 @@
!! ------------
!!
!! Original 08/11
+!! Modification 01/03/2015 KHALO as arguments (M.Moge)
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -56,6 +61,9 @@ INTEGER, INTENT(IN) :: KDIM_FULL ! total number of points
INTEGER, INTENT(OUT) :: KSIZE_FULL! number of points on this processor
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
!
!
!* 0.2 Declaration of local variables
@@ -84,8 +92,13 @@ IF (LHOOK) CALL DR_HOOK('SPLIT_GRID_CARTESIAN',0,ZHOOK_HANDLE)
!
!* 2. Splits the (pertinent) parameters of the grid
!
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',KHALO,IIMAX,IIMAX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',KHALO,IJMAX,IJMAX_SPLIT)
+#else
CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',IIMAX,IIMAX_SPLIT)
CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',IJMAX,IJMAX_SPLIT)
+#endif
!
KSIZE_FULL = IIMAX_SPLIT * IJMAX_SPLIT
!
@@ -93,10 +106,17 @@ ALLOCATE(ZX_SPLIT (KSIZE_FULL))
ALLOCATE(ZY_SPLIT (KSIZE_FULL))
ALLOCATE(ZDX_SPLIT(KSIZE_FULL))
ALLOCATE(ZDY_SPLIT(KSIZE_FULL))
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZX,ZX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZY,ZY_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDX,ZDX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDY,ZDY_SPLIT)
+#else
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
+#endif
!
!
!* 3. Stores Parameters of the Grid in grid pointer
diff --git a/src/SURFEX/split_grid_conf_proj.F90 b/src/SURFEX/split_grid_conf_proj.F90
index f81a0d5605cb436490f45f50266f9ce0932afb0c..9c19c33a157425f0f611e3e5d588bd24e7edc5ae 100644
--- a/src/SURFEX/split_grid_conf_proj.F90
+++ b/src/SURFEX/split_grid_conf_proj.F90
@@ -3,7 +3,11 @@
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
! ###########################################################
+#ifdef MNH_PARALLEL
+ SUBROUTINE SPLIT_GRID_CONF_PROJ(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR,KHALO)
+#else
SUBROUTINE SPLIT_GRID_CONF_PROJ(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR)
+#endif
! ###########################################################
!!
!! PURPOSE
@@ -33,6 +37,7 @@
!! ------------
!!
!! Original 08/11
+!! M.Moge 02/15 using PGRID_PAR(11) instead of KDIM_FULL
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -56,6 +61,9 @@ INTEGER, INTENT(IN) :: KDIM_FULL ! total number of points
INTEGER, INTENT(OUT) :: KSIZE_FULL! number of points on this processor
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(IN) :: KHALO ! size of the Halo
+#endif
!
!
!* 0.2 Declaration of local variables
@@ -66,7 +74,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* original grid
REAL :: ZLAT0, ZLON0, ZRPK, ZBETA, ZLATOR, ZLONOR
INTEGER :: IIMAX, IJMAX
-REAL, DIMENSION(KDIM_FULL) :: ZX, ZY, ZDX, ZDY
+REAL, DIMENSION(PGRID_PAR(11)) :: ZX, ZY, ZDX, ZDY
!
!* splitted grid on processor
INTEGER :: IIMAX_SPLIT, IJMAX_SPLIT
@@ -78,14 +86,19 @@ IF (LHOOK) CALL DR_HOOK('SPLIT_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
!* 1. Gets Parameters of the Grid
!
CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
- ZLATOR,ZLONOR,IIMAX,IJMAX, &
- ZX,ZY,ZDX,ZDY )
+ ZLATOR,ZLONOR,IIMAX,IJMAX, &
+ ZX,ZY,ZDX,ZDY )
!
!
!* 2. Splits the (pertinent) parameters of the grid
!
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',KHALO,IIMAX,IIMAX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',KHALO,IJMAX,IJMAX_SPLIT)
+#else
CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',IIMAX,IIMAX_SPLIT)
CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',IJMAX,IJMAX_SPLIT)
+#endif
!
KSIZE_FULL = IIMAX_SPLIT * IJMAX_SPLIT
!
@@ -93,10 +106,17 @@ ALLOCATE(ZX_SPLIT (KSIZE_FULL))
ALLOCATE(ZY_SPLIT (KSIZE_FULL))
ALLOCATE(ZDX_SPLIT(KSIZE_FULL))
ALLOCATE(ZDY_SPLIT(KSIZE_FULL))
+#ifdef MNH_PARALLEL
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',SIZE(ZX),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZX,ZX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',SIZE(ZY),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZY,ZY_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',SIZE(ZDX),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDX,ZDX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',SIZE(ZDY),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDY,ZDY_SPLIT)
+#else
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
+#endif
!
!
!* 3. Stores Parameters of the Grid in grid pointer
diff --git a/src/SURFEX/surf_version.F90 b/src/SURFEX/surf_version.F90
index 45f8a89ee877fca2790c9b29829824a581030257..0aa259c77a88d9d1ccee464bd51dd0a8969636cf 100644
--- a/src/SURFEX/surf_version.F90
+++ b/src/SURFEX/surf_version.F90
@@ -40,7 +40,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('SURF_VERSION',0,ZHOOK_HANDLE)
NVERSION = 7
-NBUGFIX = 3
+NBUGFIX = 4
IF (LHOOK) CALL DR_HOOK('SURF_VERSION',1,ZHOOK_HANDLE)
!
END SUBROUTINE SURF_VERSION
diff --git a/src/SURFEX/writesurf_covern.F90 b/src/SURFEX/writesurf_covern.F90
index f73369913519cc125504c5afcbff56a094058da7..76a652a815741b43b4c8928435d49244d9a7e289 100644
--- a/src/SURFEX/writesurf_covern.F90
+++ b/src/SURFEX/writesurf_covern.F90
@@ -28,6 +28,7 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2003
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -39,6 +40,7 @@ USE MODD_SURF_ATM_n, ONLY : XSEA, XWATER, XNATURE, XTOWN, XCOVER, LCOVER, &
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
!
USE MODI_WRITE_SURF
+USE MODI_WRITE_LCOVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -57,6 +59,8 @@ INTEGER :: IRESP ! IRESP : return-code if a problem appears
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IINFO
+LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! tmp list of covers
!
!-------------------------------------------------------------------------------
!
@@ -71,12 +75,10 @@ YCOMMENT = '(-)'
CALL WRITE_SURF(HPROGRAM,'FRAC_WATER ',XWATER, IRESP,HCOMMENT=YCOMMENT)
CALL WRITE_SURF(HPROGRAM,'FRAC_TOWN ',XTOWN, IRESP,HCOMMENT=YCOMMENT)
!
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
- CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT,HDIR='H')
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/writesurf_gr_snow.F90 b/src/SURFEX/writesurf_gr_snow.F90
index 33651b71a64909f35b9b3aba4d056e8c08bf71ba..8f7edd0eaee01f084cc82c4cb30f16ca3b092c2a 100644
--- a/src/SURFEX/writesurf_gr_snow.F90
+++ b/src/SURFEX/writesurf_gr_snow.F90
@@ -37,6 +37,7 @@
!! -------------
!! Original 02/2003
!! A. Bogatchev 09/2005 EBA snow option
+!! M. Moge 09/2015 writing SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -75,6 +76,8 @@ INTEGER :: IRESP ! IRESP : return-code if a problem appear
LOGICAL :: GSNOW ! T --> snow exists somewhere
!
INTEGER :: JLAYER ! loop counter
+INTEGER :: JPATCH ! loop counter
+CHARACTER(LEN=4) :: YPATCH ! number of the patch
CHARACTER(LEN=4) :: YNLAYER ! String depending on the number of layer : less
!than 10 or more
!
@@ -153,7 +156,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_WSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%WSNOW(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%WSNOW(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* 7. Snow density
! ------------
@@ -163,7 +174,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_RSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%RHO,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%RHO,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%RHO(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%RHO(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
@@ -177,7 +196,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_TSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%T,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%T,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%T(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%T(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
@@ -191,7 +218,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_HSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%HEAT,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%HEAT,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HEAT(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HEAT(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
@@ -205,7 +240,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A11,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_SGRAN1_',HSURFTYPE,JLAYER,' (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%GRAN1,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%GRAN1,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN1(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN1(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* 11. Snow Gran2
! ------------
@@ -215,7 +258,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A11,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_SGRAN2_',HSURFTYPE,JLAYER,' (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%GRAN2,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%GRAN2,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN2(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN2(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* 12. Historical parameter
! -------------------
@@ -225,7 +276,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_SHIST_',HSURFTYPE,JLAYER,' (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%HIST,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%HIST,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HIST(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HIST(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* 13. Age parameter
! ---------------
@@ -235,7 +294,15 @@ DO JLAYER = 1,TPSNOW%NLAYER
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A9)') '(A9,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
WRITE(YCOMMENT,YFMT) 'X_Y_SAGE_',HSURFTYPE,JLAYER,' (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%AGE,3)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%AGE,3)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%AGE(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%AGE(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
@@ -253,7 +320,15 @@ IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR
YRECFM=ADJUSTL(HPREFIX//YRECFM)
WRITE(YFMT,'(A6,I1,A5)') '(A10,A',ISURFTYPE_LEN,',A10)'
WRITE(YCOMMENT,YFMT) 'X_Y_ASNOW_',HSURFTYPE,' (no unit)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(TPSNOW%ALB,2)
+ WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%ALB,2)
+ YRECFM=TRIM(YRECFM)//YPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
diff --git a/src/SURFEX/writesurf_isban.F90 b/src/SURFEX/writesurf_isban.F90
index 32c98c377f15f19b4e83d8340b5310b4de96a16f..2225b7c00bcf2dfbd0a36496c9315104b6e4f604 100644
--- a/src/SURFEX/writesurf_isban.F90
+++ b/src/SURFEX/writesurf_isban.F90
@@ -43,6 +43,8 @@
!! B. Decharme 07/2011 : land_use semi-prognostic variables
!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
!! B. Decharme 09/2012 : write some key for prep_read_external
+!! M.Moge 08/2015 writing SURFEX 3D fields one patch at a time for Z-parallel splitting with MNH
+!! except 'FLX_DSTM'
!!
!-------------------------------------------------------------------------------
!
@@ -88,10 +90,12 @@ LOGICAL, INTENT(IN) :: OLAND_USE !
INTEGER :: IRESP ! IRESP : return-code if a problem appears
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=4 ) :: YLVL
+ CHARACTER(LEN=5 ) :: YPATCH
CHARACTER(LEN=100):: YCOMMENT ! Comment string
CHARACTER(LEN=25) :: YFORM ! Writing format
!
INTEGER :: JJ, JLAYER, JP, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on levels
+INTEGER :: JPATCH ! loop counter
INTEGER :: IWORK ! Work integer
INTEGER :: JSV
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -111,48 +115,86 @@ ELSE
ENDIF
!
DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A6,I1.1,A4)'
IF (JLAYER >= 10) YFORM='(A6,I2.2,A4)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TG',JLAYER,' (K)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XTG,3)
+ IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A2,I2,I4.4)') 'TG',JLAYER,JPATCH
+ IF (JLAYER < 10) WRITE(YRECFM,FMT='(A2,I1,I4.4)') 'TG',JLAYER,JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XTG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
!* soil liquid water contents
!
DO JLAYER=1,NGROUND_LAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A6,I1.1,A8)'
IF (JLAYER >= 10) YFORM='(A6,I2.2,A8)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_WG',JLAYER,' (m3/m3)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XWG,3)
+ IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A2,I2,I4.4)') 'WG',JLAYER,JPATCH
+ IF (JLAYER < 10) WRITE(YRECFM,FMT='(A2,I1,I4.4)') 'WG',JLAYER,JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XWG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
!* soil ice water contents
!
DO JLAYER=1,NGROUND_LAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A7,I1.1,A8)'
IF (JLAYER >= 10) YFORM='(A7,I2.2,A8)'
WRITE(YCOMMENT,YFORM) 'X_Y_WGI',JLAYER,' (m3/m3)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XWGI,3)
+ IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A3,I2,I4.4)') 'WGI',JLAYER,JPATCH
+ IF (JLAYER < 10) WRITE(YRECFM,FMT='(A3,I1,I4.4)') 'WGI',JLAYER,JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWGI(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XWGI(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
!* water intercepted on leaves
!
YRECFM='WR'
YCOMMENT='X_Y_WR (kg/m2)'
+#ifdef MNH_PARALLEL
+DO JPATCH=1,SIZE(XWR,2)
+ WRITE(YRECFM,FMT='(A2,I4.4)') 'WR',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* roughness length of Flood water
!
IF(LFLOOD)THEN
YRECFM='Z0_FLOOD'
YCOMMENT='X_Y_Z0_FLOOD (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XZ0_FLOOD,2)
+ WRITE(YRECFM,FMT='(A8,I4.4)') 'Z0_FLOOD',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
ENDIF
!
!* Glacier ice storage
@@ -160,13 +202,41 @@ ENDIF
IF(LGLACIER)THEN
YRECFM='ICE_STO'
YCOMMENT='X_Y_ICE_STO (kg/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XICE_STO,2)
+ WRITE(YRECFM,FMT='(A7,I4.4)') 'ICE_STO',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XICE_STO(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
ENDIF
!
!* Leaf Area Index
!
IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
!
+#ifdef MNH_PARALLEL
+ YCOMMENT='X_Y_LAI (m2/m2)'
+ DO JPATCH=1,SIZE(XLAI,2)
+ IF(LASSIM) THEN
+ IF(CASSIM=='PLUS ') THEN
+ YRECFM='LAIp'
+ WRITE(YRECFM,FMT='(A4,I4.4)') 'LAIp',JPATCH
+ ELSEIF(CASSIM=='AVERA') THEN
+ YRECFM='LAIa'
+ WRITE(YRECFM,FMT='(A4,I4.4)') 'LAIa',JPATCH
+ ELSEIF(CASSIM=='2DVAR') THEN
+ YRECFM='LAI'
+ WRITE(YRECFM,FMT='(A3,I4.4)') 'LAI',JPATCH
+ ENDIF
+ ELSE
+ YRECFM='LAI'
+ WRITE(YRECFM,FMT='(A3,I4.4)') 'LAI',JPATCH
+ ENDIF
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
IF(LASSIM) THEN
IF(CASSIM=='PLUS ') THEN
YRECFM='LAIp'
@@ -181,6 +251,7 @@ IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
!
YCOMMENT='X_Y_LAI (m2/m2)'
CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
END IF
!
@@ -205,7 +276,14 @@ IF(CISBA=='DIF')THEN
! Fraction for each patch
YRECFM='PATCH'
YCOMMENT='X_Y_PATCH (-) for external prep with SOC'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XPATCH,2)
+ WRITE(YRECFM,FMT='(A5,I4.4)') 'PATCH',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
ENDIF
!
ELSE
@@ -238,7 +316,14 @@ YCOMMENT='X_TSRAD_NAT (K)'
!
YRECFM='RESA'
YCOMMENT='X_Y_RESA (s/m)'
+#ifdef MNH_PARALLEL
+DO JPATCH=1,SIZE(XRESA,2)
+ WRITE(YRECFM,FMT='(A4,I4.4)') 'RESA',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
!* Land use variables
!
@@ -246,7 +331,14 @@ IF(OLAND_USE)THEN
!
YRECFM='OLD_PATCH'
YCOMMENT='X_Y_OLD_PATCH (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XPATCH,2)
+ WRITE(YRECFM,FMT='(A9,I4.4)') 'OLD_PATCH',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
DO JLAYER=1,NGROUND_LAYER
WRITE(YLVL,'(I4)') JLAYER
@@ -254,7 +346,15 @@ IF(OLAND_USE)THEN
YFORM='(A6,I1.1,A8)'
IF (JLAYER >= 10) YFORM='(A6,I2.2,A8)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_OLD_DG',JLAYER,' (m)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XDG,3)
+ IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'OLD_DG',JLAYER,JPATCH
+ IF (JLAYER < 10) WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'OLD_DG',JLAYER,JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
ENDIF
@@ -264,49 +364,101 @@ ENDIF
IF (CPHOTO/='NON') THEN
YRECFM='AN'
YCOMMENT='X_Y_AN (kgCO2/kgair m/s)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XAN,2)
+ WRITE(YRECFM,FMT='(A2,I4.4)') 'AN',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAN(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
YRECFM='ANDAY'
YCOMMENT='X_Y_ANDAY (kgCO2/m2/day)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XANDAY,2)
+ WRITE(YRECFM,FMT='(A5,I4.4)') 'ANDAY',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XANDAY(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
YRECFM='ANFM'
YCOMMENT='X_Y_ANFM (kgCO2/kgair m/s)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XANFM,2)
+ WRITE(YRECFM,FMT='(A4,I4.4)') 'ANFM',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XANFM(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
!
YRECFM='LE_AGS'
YCOMMENT='X_Y_LE_AGS (W/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YRECFM,FMT='(A6,I4.4)') 'LE_AGS',JPATCH
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END IF
!
!
IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
!
DO JNBIOMASS=1,NNBIOMASS
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A11,I1.1,A10)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNBIOMASS,' (kgDM/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ YRECFM='LE_AGS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I1)') JNBIOMASS
+ YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
!
DO JNBIOMASS=2,NNBIOMASS-2
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A16,I1.1,A10)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I1)') JNBIOMASS
+ YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
IF (CPHOTO=='NIT') THEN
!
DO JNBIOMASS=NNBIOMASS-1,NNBIOMASS
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A16,I1.1,A10)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
+ YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I1)') JNBIOMASS
+ YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
ENDIF
@@ -341,28 +493,52 @@ IF (CRESPSL=='CNT') THEN
!
DO JNLITTER=1,NNLITTER
DO JNLITTLEVS=1,NNLITTLEVS
- WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
- YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A10,I1.1,A1,I1.1,A8)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNLITTER,' ',JNLITTLEVS,' (gC/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I1,A1,I1,I4.4)') JNLITTER,'_',JNLITTLEVS,JPATCH
+ YRECFM='LITTER'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XLITTER(:,JNLITTER,JNLITTLEVS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
+ YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XLITTER(:,JNLITTER,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
END DO
DO JNSOILCARB=1,NNSOILCARB
- WRITE(YLVL,'(I4)') JNSOILCARB
- YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A8,I1.1,A8)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_SOILCARB',JNSOILCARB,' (gC/m2)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I4,I4.4)') JNSOILCARB,JPATCH
+ YRECFM='SOILCARB'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILCARB(:,JNSOILCARB,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I4)') JNSOILCARB
+ YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILCARB(:,JNSOILCARB,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
DO JNLITTLEVS=1,NNLITTLEVS
- WRITE(YLVL,'(I4)') JNLITTLEVS
- YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YFORM='(A12,I1.1,A8)'
WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LIGNIN_STRUC',JNLITTLEVS,' (-)'
+#ifdef MNH_PARALLEL
+ DO JPATCH=1,SIZE(XLE,2)
+ WRITE(YPATCH,'(I4,I4.4)') JNLITTLEVS,JPATCH
+ YRECFM='LIGNIN_STR'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XLIGNIN_STRUC(:,JNLITTLEVS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+#else
+ WRITE(YLVL,'(I4)') JNLITTLEVS
+ YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL WRITE_SURF(HPROGRAM,YRECFM,XLIGNIN_STRUC(:,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
+#endif
END DO
!
ENDIF
diff --git a/src/SURFEX/writesurf_pgd_flaken.F90 b/src/SURFEX/writesurf_pgd_flaken.F90
index 228fd94af3e609df3bdda5ee0dac3a99755f4783..64639757b3638831923c8f6cdda60d6ae61c77d7 100644
--- a/src/SURFEX/writesurf_pgd_flaken.F90
+++ b/src/SURFEX/writesurf_pgd_flaken.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original 01/2003
!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using MPI_ALLREDUCE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -42,11 +43,10 @@ USE MODD_FLAKE_n, ONLY : XZS,XCOVER,LCOVER, &
XWATER_DEPTH,XWATER_FETCH,XT_BS,XDEPTH_BS,XEXTCOEF_WATER
USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
!
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-!
USE MODI_WRITE_SURF
USE MODI_WRITE_GRID
!
+USE MODI_WRITE_LCOVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -76,9 +76,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* cover classes
!
IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_FLAKE_N',0,ZHOOK_HANDLE)
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+!
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
diff --git a/src/SURFEX/writesurf_pgd_isban.F90 b/src/SURFEX/writesurf_pgd_isban.F90
index d009d34ef2677498305951d7ccf6e95ebc74ca31..206c503914658323e7309f6d3ee30a2c6a9eae3e 100644
--- a/src/SURFEX/writesurf_pgd_isban.F90
+++ b/src/SURFEX/writesurf_pgd_isban.F90
@@ -37,6 +37,8 @@
!! B. Decharme 06/2009 : add topographic index statistics
!! A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
+!! M. Moge 08/2015 writing ECO_DG fields as 2D fields with WRITE_SURF
!!
!-------------------------------------------------------------------------------
!
@@ -55,17 +57,18 @@ USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA,&
XTI_SKEW, XZS,XCOVER, &
XZ0EFFJPDIR, &
LCOVER, LECOCLIMAP, LCTI, LSOCP, LNOF, &
- XSOILGRID, XPH, XFERT, LPERM, XPERM
+ XSOILGRID, XPH, XFERT, LPERM, XPERM, &
+ XDG, NWG_LAYER
!
USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
!
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-!
USE MODI_WRITE_SURF
USE MODI_WRITE_GRID
USE MODI_WRITESURF_PGD_ISBA_PAR_n
USE MODI_WRITESURF_PGD_TSZ0_PAR_n
!
+USE MODI_WRITE_LCOVER
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -84,6 +87,8 @@ INTEGER :: IRESP ! IRESP : return-code if a problem appears
CHARACTER(LEN=100):: YCOMMENT ! Comment string
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
+INTEGER :: JL ! loop counter
+INTEGER :: JPATCH ! loop counter
!
!-------------------------------------------------------------------------------
!
@@ -157,9 +162,7 @@ YCOMMENT=YRECFM
!
!* cover classes
!
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
@@ -314,6 +317,38 @@ YCOMMENT='X_Y_TI_SKEW'
!
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 3. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
+! ----------------------------------------------------------------------------------
+!
+IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
+ ! note XDG is not associated only in the zoom_pgd step. This is not a
+ ! problem because an initialization of the model is redone just after.
+ ! In all other cases, the fileds are associated and initialized.
+!
+!* Soil depth for each patch
+!
+DO JPATCH = 1,SIZE(XDG,3)
+ DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'ECO_DG',JL,JPATCH
+ ELSE
+ WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'ECO_DG',JL,JPATCH
+ ENDIF
+ YCOMMENT='soil depth from ecoclimap'//' (M)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JL,JPATCH),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+END DO
+!* Total soil depth for moisture
+!
+ IF (CISBA=='DIF') THEN
+ YRECFM='ECO_WG_L'
+ YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,FLOAT(NWG_LAYER(:,:)),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+END IF
+!
!-------------------------------------------------------------------------------
CALL WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
IF (CNATURE=='TSZ0') CALL WRITESURF_PGD_TSZ0_PAR_n(HPROGRAM)
diff --git a/src/SURFEX/writesurf_pgd_seafluxn.F90 b/src/SURFEX/writesurf_pgd_seafluxn.F90
index b37b2f8e8313e0c41cb675f4e381329511c795dc..0ef721e9212e34490183d3f1f11490345f7ff734 100644
--- a/src/SURFEX/writesurf_pgd_seafluxn.F90
+++ b/src/SURFEX/writesurf_pgd_seafluxn.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original 01/2003
!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -42,12 +43,11 @@ USE MODD_SEAFLUX_n, ONLY : XZS,XSEABATHY,XCOVER,LCOVER
USE MODD_SEAFLUX_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
USE MODD_DATA_SEAFLUX_n, ONLY : LSST_DATA
!
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-!
USE MODI_WRITE_SURF
USE MODI_WRITE_GRID
USE MODI_WRITESURF_PGD_SEAF_PAR_n
!
+USE MODI_WRITE_LCOVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -77,9 +77,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* cover classes
!
IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_SEAFLUX_N',0,ZHOOK_HANDLE)
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+!
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
diff --git a/src/SURFEX/writesurf_pgd_teb_vegn.F90 b/src/SURFEX/writesurf_pgd_teb_vegn.F90
index 9041b0d1c98e31b12cf86fab33c1f4214ab188d3..2dcf2084f5d363adfd5b09f3d5dbaba098ae849d 100644
--- a/src/SURFEX/writesurf_pgd_teb_vegn.F90
+++ b/src/SURFEX/writesurf_pgd_teb_vegn.F90
@@ -38,9 +38,12 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_TEB_n, ONLY : LECOCLIMAP, XGARDEN
USE MODD_TEB_VEG_n, ONLY : CISBA
USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, XSOILGRID, &
- XCLAY, XSAND, XRUNOFFB, XWDRAIN
+ XCLAY, XSAND, XRUNOFFB, XWDRAIN, &
+ XDG, NWG_LAYER
USE MODD_DATA_TEB_GARDEN_n, ONLY : NTIME
!
USE MODI_WRITE_SURF
@@ -63,7 +66,10 @@ INTEGER :: IRESP ! IRESP : return-code if a problem appears
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
!
+INTEGER :: JL ! loop counter
+
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
!
!-------------------------------------------------------------------------------
!
@@ -119,6 +125,44 @@ YRECFM='GD_WDRAIN'
YCOMMENT='X_Y_GD_WDRAIN'
CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
!
+!-------------------------------------------------------------------------------
+!
+!* 3. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
+! ----------------------------------------------------------------------------------
+!
+IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
+ ALLOCATE(ZWORK(SIZE(XDG,1)))
+!
+!* Soil depth for each patch
+!
+ DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A9,I1)') 'GD_ECO_DG',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I2)') 'GD_ECO_DG',JL
+ ENDIF
+ YCOMMENT='soil depth from ecoclimap'//' (M)'
+ ZWORK(:) = XDG(:,JL)
+ IF (ASSOCIATED(XGARDEN)) THEN ! in PGD step, XGARDEN is not associated. In other steps, it is.
+ WHERE (XGARDEN==0.) ZWORK=XUNDEF
+ END IF
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+!* Number of soil layers for moisture
+!
+ IF (CISBA=='DIF') THEN
+ YRECFM='GD_ECO_WG_L'
+ YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
+ ZWORK=FLOAT(NWG_LAYER(:))
+ IF (ASSOCIATED(XGARDEN)) THEN
+ WHERE (XGARDEN==0.) ZWORK=FLOAT(NUNDEF)
+ END IF
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+
+ DEALLOCATE(ZWORK)
+END IF
+
!
IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_TEB_VEG_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/writesurf_pgd_tebn.F90 b/src/SURFEX/writesurf_pgd_tebn.F90
index 4ec007416b9ac275ce8a5e1c44d6028700d8e00a..5831db9b542a22aac227fc70b27966997f315599 100644
--- a/src/SURFEX/writesurf_pgd_tebn.F90
+++ b/src/SURFEX/writesurf_pgd_tebn.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original 01/2003
!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -45,12 +46,12 @@ USE MODD_TEB_n, ONLY : CBEM, NROOF_LAYER, NROAD_LAYER, NWALL_LAYER, &
NTEB_PATCH, CBLD_ATYPE
USE MODD_BEM_n, ONLY : NFLOOR_LAYER, CCOOL_COIL, CHEAT_COIL, LAUTOSIZE
USE MODD_TEB_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODD_TEB_VEG_n, ONLY : CISBA, CPEDOTF, CPHOTO, LTR_ML
!
USE MODI_WRITE_SURF
USE MODI_WRITE_GRID
!
+USE MODI_WRITE_LCOVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -203,9 +204,7 @@ ENDIF
!
!* cover classes
!
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
diff --git a/src/SURFEX/writesurf_pgd_watfluxn.F90 b/src/SURFEX/writesurf_pgd_watfluxn.F90
index 038ccf25ab5d98c401a90530cce3960ae7fb2b30..b4afb41b68e4b7a8bba75d47399d52bab2537b6d 100644
--- a/src/SURFEX/writesurf_pgd_watfluxn.F90
+++ b/src/SURFEX/writesurf_pgd_watfluxn.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original 01/2003
!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -41,11 +42,9 @@
USE MODD_WATFLUX_n, ONLY : XZS,XCOVER,LCOVER
USE MODD_WATFLUX_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
!
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-!
USE MODI_WRITE_SURF
USE MODI_WRITE_GRID
-!
+USE MODI_WRITE_LCOVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -63,7 +62,6 @@ IMPLICIT NONE
INTEGER :: IRESP ! IRESP : return-code if a problem appears
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
-INTEGER :: JCOVER ! loop index
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -75,9 +73,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* cover classes
!
IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_WATFLUX_N',0,ZHOOK_HANDLE)
-YRECFM='COVER_LIST'
-YCOMMENT='(LOGICAL LIST)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+!
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
!
YCOMMENT='COVER FIELDS'
CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
diff --git a/src/SURFEX/zoom_pgd_cover.F90 b/src/SURFEX/zoom_pgd_cover.F90
index 32dbe56455f799eca78ddcd5eb58781ec3d5e0ea..67f25764d669a4b8486eea2f54ae1c72b948e7a1 100644
--- a/src/SURFEX/zoom_pgd_cover.F90
+++ b/src/SURFEX/zoom_pgd_cover.F90
@@ -37,6 +37,7 @@
! Modification 17/04/12 M.Tomasini All COVER physiographic fields are now
!! interpolated for spawning =>
!! ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
+! Modification 05/02/15 M.Moge : use NSIZE_FULL instead of SIZE(XLAT) (for clarity)
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -57,6 +58,7 @@ USE MODI_READ_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_PREP_GRID_EXTERN
USE MODI_HOR_INTERPOL
+USE MODI_HOR_INTERPOL_1COV
USE MODI_PREP_OUTPUT_GRID
USE MODI_OLD_NAME
USE MODI_SUM_ON_ALL_PROCS
@@ -87,11 +89,16 @@ INTEGER :: INI ! total 1D dimension (input grid)
INTEGER :: IL ! total 1D dimension (output grid)
INTEGER :: JCOVER ! loop counter
INTEGER :: IVERSION ! surface version
+#ifdef MNH_PARALLEL
+REAL, DIMENSION(:), POINTER :: ZCOVER
+#else
REAL, DIMENSION(:,:), POINTER :: ZCOVER
+#endif
REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
REAL, DIMENSION(:), ALLOCATABLE :: ZSUM
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100) :: YCOMMENT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
@@ -123,15 +130,9 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
! ----------------
!
YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
ALLOCATE(LCOVER(JPCOVER))
- CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
-!
-ALLOCATE(ZCOVER(INI,JPCOVER))
- CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),LCOVER,IRESP,HDIR='A')
-!
ALLOCATE(ZSEA1 (INI,1))
ALLOCATE(ZNATURE1(INI,1))
ALLOCATE(ZWATER1 (INI,1))
@@ -143,20 +144,73 @@ IF (IVERSION>=7) THEN
CALL READ_SURF(HPROGRAM,'FRAC_WATER ',ZWATER1(:,1), IRESP,HDIR='A')
CALL READ_SURF(HPROGRAM,'FRAC_TOWN ',ZTOWN1(:,1), IRESP,HDIR='A')
!
+ CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
+! CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
+ CALL READ_LCOVER(HPROGRAM,LCOVER)
+ !
+#ifdef MNH_PARALLEL
+ ALLOCATE(ZCOVER(INI))
+#else
+ ALLOCATE(ZCOVER(INI,JPCOVER))
+#endif
+ !
ELSE
+#ifdef MNH_PARALLEL
+ ! we assume that IVERSION>=7
+#else
+ CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
+! CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
+ CALL READ_LCOVER(HPROGRAM,LCOVER)
+ !
+ ALLOCATE(ZCOVER(INI,JPCOVER))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),LCOVER,IRESP,HDIR='A')
+ !
CALL CONVERT_COVER_FRAC(ZCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
+#endif
ENDIF
!
- CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
!------------------------------------------------------------------------------
!
-!* 4. Interpolations
+!* 4. Reading of cover & Interpolations
! --------------
!
-IL = SIZE(XLAT)
+IL = NSIZE_FULL
ALLOCATE(XCOVER(IL,JPCOVER))
+ALLOCATE(ZSUM(IL))
+ZSUM = 0.
!
+! on lit les cover une apres l'autre, et on appelle hor_interpol sur chaque cover separement
+!
+#ifdef MNH_PARALLEL
+IF ( HPROGRAM == 'MESONH' ) THEN
+ DO JCOVER=1,JPCOVER
+ IF ( LCOVER( JCOVER ) ) THEN
+ CALL READ_SURFX2COV_1COV_MNH(YRECFM,INI,JCOVER,ZCOVER(:),IRESP,YCOMMENT,'A')
+ ELSE
+ ZCOVER(:) = 0.
+ ENDIF
+ !
+ CALL HOR_INTERPOL_1COV(ILUOUT,ZCOVER,XCOVER(:,JCOVER))
+ !
+ ZSUM(:) = ZSUM(:) + XCOVER(:,JCOVER)
+ !
+ ENDDO
+ELSE
+
+ENDIF
+#else
CALL HOR_INTERPOL(ILUOUT,ZCOVER,XCOVER)
+#endif
+!
+! Coherence check
+!
+DO JCOVER=1,JPCOVER
+ XCOVER(:,JCOVER) = XCOVER(:,JCOVER)/ZSUM(:)
+ IF (ALL(XCOVER(:,JCOVER)==0.)) LCOVER(JCOVER) = .FALSE.
+END DO
+!
+CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
+!
!
DEALLOCATE(ZCOVER)
!
@@ -193,24 +247,6 @@ DEALLOCATE(ZTOWN2)
CALL CLEAN_PREP_OUTPUT_GRID
!------------------------------------------------------------------------------
!
-!* 5. Coherence check
-! ---------------
-!
-ALLOCATE(ZSUM(IL))
-ZSUM = 0.
-DO JCOVER=1,JPCOVER
- ZSUM(:) = ZSUM(:) + XCOVER(:,JCOVER)
-END DO
-!
-DO JCOVER=1,JPCOVER
- XCOVER(:,JCOVER) = XCOVER(:,JCOVER)/ZSUM(:)
-END DO
-!
-DO JCOVER=1,JPCOVER
- IF (ALL(XCOVER(:,JCOVER)==0.)) LCOVER(JCOVER) = .FALSE.
-END DO
-!------------------------------------------------------------------------------
-!
!* 6. Fractions
! ---------
!
diff --git a/src/SURFEX/zoom_pgd_orography.F90 b/src/SURFEX/zoom_pgd_orography.F90
index 026b3023046e587c41a6b4f777697891a41f501d..aad3c4060715177cbcb6417242235399874a0a8a 100644
--- a/src/SURFEX/zoom_pgd_orography.F90
+++ b/src/SURFEX/zoom_pgd_orography.F90
@@ -40,7 +40,7 @@
! -----------
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-USE MODD_SURF_ATM_n, ONLY : XZS
+USE MODD_SURF_ATM_n, ONLY : XZS, NSIZE_FULL!, XSEA, XWATER
USE MODD_SURF_ATM_GRID_n, ONLY : XLAT, XLON, CGRID, XGRID_PAR
USE MODD_SURF_ATM_SSO_n, ONLY : XSSO_STDEV, XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS,&
XSSO_ANIS, XSSO_DIR, XSSO_SLOPE, &
@@ -56,6 +56,7 @@ USE MODI_PREP_GRID_EXTERN
USE MODI_HOR_INTERPOL
USE MODI_PREP_OUTPUT_GRID
!
+USE MODI_GOTO_MODEL_MNH
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -69,8 +70,8 @@ IMPLICIT NONE
! ------------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-REAL, DIMENSION(:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION(:), INTENT(IN) :: PWATER ! inland water fraction
+ REAL, DIMENSION(:), INTENT(IN) :: PSEA ! sea fraction
+ REAL, DIMENSION(:), INTENT(IN) :: PWATER ! inland water fraction
CHARACTER(LEN=28), INTENT(IN) :: HINIFILE ! input atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HINIFILETYPE! input atmospheric file type
!
@@ -101,6 +102,7 @@ REAL, DIMENSION(:), POINTER :: ZHO2JP
REAL, DIMENSION(:), POINTER :: ZHO2JM
CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IINFO_ll
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_OROGRAPHY',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
@@ -112,6 +114,9 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_OROGRAPHY',0,ZHOOK_HANDLE)
! These points will not be used during the horizontal interpolation step.
! Their value must be defined as XUNDEF.
!
+! get the local sizes of model 1
+CALL GOTO_MODEL_MNH(HPROGRAM, 1, IINFO_ll)
+!CALL GOTO_MODEL_SURFEX(1, .TRUE.) ! cette routine plante don je me demerde sans
CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL ')
!
!------------------------------------------------------------------------------
@@ -193,7 +198,7 @@ YRECFM='HO2JM'
!* 4. Interpolations
! --------------
!
-IL = SIZE(XLAT)
+IL = SIZE(XLAT) !size of local child model
!
ALLOCATE(XZS (IL))
!
@@ -277,6 +282,10 @@ WHERE (PWATER(:)==1.)
XAOSJP(:) = 0.
XAOSJM(:) = 0.
END WHERE
+!
+! go back to child model
+!CALL GOTO_MODEL_SURFEX(2, .TRUE.) ! cette routine plante
+CALL GOTO_MODEL_MNH(HPROGRAM, 2, IINFO_ll)
!_______________________________________________________________________________
DEALLOCATE(ZZS )
!
diff --git a/src/SURFEX/zoom_pgd_surf_atm.F90 b/src/SURFEX/zoom_pgd_surf_atm.F90
index 04fe1e5e7e91e5762e1455e928d56613a795458c..c516b20273bcaa3293cc078a1276782f8c37c188 100644
--- a/src/SURFEX/zoom_pgd_surf_atm.F90
+++ b/src/SURFEX/zoom_pgd_surf_atm.F90
@@ -65,6 +65,10 @@ USE MODI_ZOOM_PGD_NATURE
USE MODI_ZOOM_PGD_SEA
USE MODI_ZOOM_PGD_TOWN
USE MODI_READ_COVER_GARDEN
+!USE MODE_MODELN_SURFEX_HANDLER
+USE MODI_GOTO_WRAPPER_SURFATM
+!
+USE MODI_GOTO_MODEL_MNH
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -86,6 +90,7 @@ IMPLICIT NONE
!
INTEGER :: IRESP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IINFO_ll
!------------------------------------------------------------------------------
!
!* 1. Set default constant values
@@ -102,9 +107,15 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_SURF_ATM',0,ZHOOK_HANDLE)
!
!* 2. Initialisation of output grid and schemes
! -----------------------------------------
+!
+! intialization of output (child) grid, so we need to get the local sizes of child model
+ CALL GOTO_MODEL_MNH(HPROGRAM,2,IINFO_ll)
!
CALL PGD_GRID(HPROGRAM,HFILE,HFILETYPE,.TRUE.,CGRID,NGRID_PAR,XGRID_PAR)
!
+! we read fields from father model, so we need to get the local sizes of father model
+ CALL GOTO_MODEL_MNH(HPROGRAM,1,IINFO_ll)
+ !
CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL ')
CALL READ_SURF(HINIFILETYPE,'SEA', CSEA, IRESP)
CALL READ_SURF(HINIFILETYPE,'NATURE',CNATURE,IRESP)
@@ -120,6 +131,8 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_SURF_ATM',0,ZHOOK_HANDLE)
!* 3. surface cover
! -------------
!
+! stay on father model
+! CALL GOTO_MODEL_MNH(HPROGRAM,1,IINFO_ll)
CALL ZOOM_PGD_COVER(HPROGRAM,HINIFILE,HINIFILETYPE,LECOCLIMAP)
!
!-------------------------------------------------------------------------------
@@ -127,6 +140,9 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_SURF_ATM',0,ZHOOK_HANDLE)
!* 4. Orography
! ---------
!
+! stay on father model
+!CALL GOTO_MODEL_SURFEX(1, .TRUE.)
+! CALL GOTO_MODEL_MNH(HPROGRAM,1,IINFO_ll)
CALL ZOOM_PGD_OROGRAPHY(HPROGRAM,XSEA,XWATER,HINIFILE,HINIFILETYPE)
!
!_______________________________________________________________________________
diff --git a/src/SURFEX/zoom_pgd_teb.F90 b/src/SURFEX/zoom_pgd_teb.F90
index 31a49b6c1bd50d67654d42c3a66de457b14d812d..8c84bdb742661da42109f8a5e7576f5ba0e425a4 100644
--- a/src/SURFEX/zoom_pgd_teb.F90
+++ b/src/SURFEX/zoom_pgd_teb.F90
@@ -39,6 +39,7 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODD_TEB_GRID_n, ONLY : XLAT, XLON, CGRID, XGRID_PAR, &
@@ -208,11 +209,13 @@ SUBROUTINE ZOOM_PGD_TEB_GARDEN
!
USE MODI_HOR_INTERPOL
!
-USE MODD_TEB_VEG_n, ONLY : CPHOTO, CISBA, &
+USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
+USE MODD_TEB_VEG_n, ONLY : CPHOTO, CISBA, &
CPEDOTF, NNBIOMASS
-USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, &
- XSAND, XCLAY, &
- XWDRAIN, XRUNOFFB, LPAR_GARDEN
+USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, &
+ XSAND, XCLAY, &
+ XWDRAIN, XRUNOFFB, LPAR_GARDEN,&
+ XSOILGRID
!
IMPLICIT NONE
!
@@ -293,6 +296,19 @@ ENDIF
!
DEALLOCATE(ZIN)
!
+IF(CISBA=='DIF') THEN
+ ALLOCATE(XSOILGRID(NGROUND_LAYER))
+ XSOILGRID=XUNDEF
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
+ CALL READ_SURF(HPROGRAM,'GD_SOILGRID',XSOILGRID,IRESP,HDIR='-')
+ ELSE
+ XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER)
+ ENDIF
+ELSE
+ ALLOCATE(XSOILGRID(0))
+ENDIF
+!
+!
!* other garden parameters
!
CALL READ_SURF(HPROGRAM,'PAR_GARDEN',LPAR_GARDEN,IRESP)