Juan 24/11/2015: modif for PREPLL from M.Mogié
authorJuan Escobar <juan.escobar@aero.obs-mip.fr>
Tue, 24 Nov 2015 09:37:50 +0000 (09:37 +0000)
committerPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Thu, 19 May 2016 14:44:49 +0000 (16:44 +0200)
131 files changed:
src/LIB/SURCOUCHE/src/extern_userio.f90
src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
src/LIB/SURCOUCHE/src/fmread_ll.f90
src/LIB/SURCOUCHE/src/fmwrit_ll.f90
src/LIB/SURCOUCHE/src/modd_structure_ll.f90
src/LIB/SURCOUCHE/src/modd_var_ll.f90
src/LIB/SURCOUCHE/src/mode_allocbuff.f90
src/LIB/SURCOUCHE/src/mode_construct_ll.f90
src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
src/LIB/SURCOUCHE/src/mode_fm.f90
src/LIB/SURCOUCHE/src/mode_gather.f90
src/LIB/SURCOUCHE/src/mode_init_ll.f90
src/LIB/SURCOUCHE/src/mode_io.f90
src/LIB/SURCOUCHE/src/mode_lb_ll.f90
src/LIB/SURCOUCHE/src/mode_ls_ll.f90
src/LIB/SURCOUCHE/src/mode_mppdb.f90
src/LIB/SURCOUCHE/src/mode_nest_ll.f90
src/LIB/SURCOUCHE/src/mode_scatter.f90
src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
src/LIB/SURCOUCHE/src/mode_tools_ll.f90
src/LIB/SURCOUCHE/src/modi_fm.f90
src/LIB/SURCOUCHE/src/modi_fmread.f90
src/LIB/SURCOUCHE/src/modi_io.f90
src/LIB/SURCOUCHE/src/modi_nest_ll.f90
src/MNH/anel_balancen.f90
src/MNH/define_maskn.f90
src/MNH/fill_sonfieldn.f90
src/MNH/fill_zsmtn.f90
src/MNH/goto_model_wrapper.f90
src/MNH/ice_adjust_bis.f90
src/MNH/ini_modeln.f90
src/MNH/ini_segn.f90
src/MNH/ini_size_spawn.f90
src/MNH/init_mnh.f90
src/MNH/mass_leak.f90
src/MNH/metrics.f90
src/MNH/mnhget_size_fulln.f90
src/MNH/mnhinit_io_surfn.f90
src/MNH/mnhopen_aux_io_surf.f90
src/MNH/mnhput_zsn.f90
src/MNH/modd_io_surf_mnh.f90
src/MNH/modd_nesting.f90
src/MNH/mode_extrapol.f90
src/MNH/mode_gridproj.f90
src/MNH/nest_zsmtn.f90
src/MNH/open_nestpgd_files.f90
src/MNH/pgd_grid_io_init_mnh.f90
src/MNH/phys_paramn.f90
src/MNH/prep_ideal_case.f90
src/MNH/prep_nest_pgd.f90
src/MNH/prep_pgd.f90
src/MNH/prep_real_case.f90
src/MNH/pressure_in_prep.f90
src/MNH/pressurez.f90
src/MNH/read_all_data_mesonh_case.f90
src/MNH/read_hgrid.f90
src/MNH/read_hgridn.f90
src/MNH/read_prc_fmfile.f90
src/MNH/read_surf_mnh.f90
src/MNH/retrieve1_nest_infon.f90
src/MNH/retrieve2_nest_infon.f90
src/MNH/set_mass.f90
src/MNH/set_ref.f90
src/MNH/set_refz.f90
src/MNH/spawn_field2.f90
src/MNH/spawn_grid2.f90
src/MNH/spawn_model2.f90
src/MNH/spawn_pressure2.f90
src/MNH/spawn_surf2_rain.f90
src/MNH/spawn_zs.f90
src/MNH/spawning.f90
src/MNH/split_grid_parameter_mnh.f90
src/MNH/ver_dyn.f90
src/MNH/ver_int_thermo.f90
src/MNH/ver_interp_field.f90
src/MNH/ver_interp_to_mixed_grid.f90
src/MNH/ver_prep_mesonh_case.f90
src/MNH/ver_thermo.f90
src/MNH/write_lfin.f90
src/MNH/write_surf_mnh.f90
src/SURFEX/alloc_surfex.F90
src/SURFEX/get_surf_grid_dimn.F90
src/SURFEX/get_teb_depths.F90
src/SURFEX/grid_from_file.F90
src/SURFEX/grid_modif_cartesian.F90
src/SURFEX/grid_modif_conf_proj.F90
src/SURFEX/hor_interpol_conf_proj.F90
src/SURFEX/init_isban.F90
src/SURFEX/init_surf_atmn.F90
src/SURFEX/modd_grid_conf_proj.F90
src/SURFEX/modd_surf_atmn.F90
src/SURFEX/modd_teb_gardenn.F90
src/SURFEX/mode_gridtype_conf_proj.F90
src/SURFEX/mode_modeln_surfex_handler.F90
src/SURFEX/mode_read_extern.F90
src/SURFEX/mode_split_grid_parameter.F90
src/SURFEX/pack_pgd.F90
src/SURFEX/pgd_grid.F90
src/SURFEX/pgd_grid_io_init.F90
src/SURFEX/pgd_grid_surf_atm.F90
src/SURFEX/pgd_isba.F90
src/SURFEX/pgd_teb_veg.F90
src/SURFEX/prep_isba_extern.F90
src/SURFEX/prep_snow_extern.F90
src/SURFEX/prep_teb_garden_extern.F90
src/SURFEX/prep_teb_greenroof_extern.F90
src/SURFEX/read_gr_snow.F90
src/SURFEX/read_gridtype_conf_proj.F90
src/SURFEX/read_isban.F90
src/SURFEX/read_lcover.F90
src/SURFEX/read_pgd_isban.F90
src/SURFEX/read_pgd_tebn.F90
src/SURFEX/regular_grid_spawn.F90
src/SURFEX/split_grid.F90
src/SURFEX/split_grid_cartesian.F90
src/SURFEX/split_grid_conf_proj.F90
src/SURFEX/surf_version.F90
src/SURFEX/writesurf_covern.F90
src/SURFEX/writesurf_gr_snow.F90
src/SURFEX/writesurf_isban.F90
src/SURFEX/writesurf_pgd_flaken.F90
src/SURFEX/writesurf_pgd_isban.F90
src/SURFEX/writesurf_pgd_seafluxn.F90
src/SURFEX/writesurf_pgd_teb_vegn.F90
src/SURFEX/writesurf_pgd_tebn.F90
src/SURFEX/writesurf_pgd_watfluxn.F90
src/SURFEX/zoom_pgd_cover.F90
src/SURFEX/zoom_pgd_orography.F90
src/SURFEX/zoom_pgd_surf_atm.F90
src/SURFEX/zoom_pgd_teb.F90

index 96d7acf..85746e3 100644 (file)
@@ -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
 
index 4218ee5..1443c32 100644 (file)
        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
 !
index 05945de..5803897 100644 (file)
@@ -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 
index 219632a..ba87714 100644 (file)
@@ -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)
index 4b0d194..3edf470 100644 (file)
@@ -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)
index 860eaf3..d78105d 100644 (file)
@@ -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
 !
@@ -136,4 +138,6 @@ INTEGER,SAVE      :: NZ_PROC_ll = 0  ! Number of proc to use in the Z splitting
 !
   INTEGER, PARAMETER :: NMODULO_MSSGTAG = 10
 !
+  INTEGER, POINTER, DIMENSION(:,:) :: MNH_STATUSES_IGNORE 
+!
 END MODULE MODD_VAR_ll
index 89de182..c330f23 100644 (file)
@@ -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
index 4f3ba19..b54e1a3 100644 (file)
@@ -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
 !!    ------------------
 !
       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 )
 !     ################################################
index 4f7309a..767482a 100644 (file)
   USE MODD_CONFZ, ONLY : LMNH_MPI_BSEND
 !JUANZ
 !
+  USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+!
   IMPLICIT NONE
 !
 !  INCLUDE 'mpif.h'
@@ -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
index 7597fca..ca137a3 100644 (file)
@@ -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
 ! 
 !-------------------------------------------------------------------------------
 !
 !
       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)
 !     ##########################################
index a204b89..3755b40 100644 (file)
@@ -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)
index 8d4ecf8..a60fb37 100644 (file)
@@ -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
index c49319d..21ce398 100644 (file)
@@ -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)
 !
 !-------------------------------------------------------------------------------
 !
 !
 ! 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)) 
         !
         !     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
         !
         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
         !
         !
         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
index b975014..aeddf6f 100644 (file)
@@ -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)
index 9d4b1e4..67afce2 100644 (file)
 !
       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
index 74b3a72..0626ce6 100644 (file)
       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
 !!    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
 !
 !-------------------------------------------------------------------------------
 !
 !
   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
 !
 !
   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
   TYPE(PROC_COM_DATA_ll), POINTER :: TZCHILD_COMDATA    ! child
   TYPE(PARENT2CHILD_DATA_ll), POINTER :: TZP2C_DATA
   INTEGER :: KINITIALMODEL, KINFO2
+  TYPE(LIST_ll), POINTER :: TZLISTCURRENT
 !
 !-------------------------------------------------------------------------------
 !
 !
   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
index 927d94a..d7b3406 100644 (file)
@@ -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
 
index cb4c8dc..74ea5bf 100644 (file)
 !     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)
 !
 !-------------------------------------------------------------------------------
 !
         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
 
   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
index 8de164e..cc93374 100644 (file)
@@ -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)
index 25b27a7..d017898 100644 (file)
@@ -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)
 !!$    !     #######################################
index 441b525..158d531 100644 (file)
@@ -34,6 +34,7 @@
 !                     (GET_1DGLOBALSLICE_ll, GET_2DGLOBALSLICE_ll),
 !                   GET_SLICE_ll
 !                     (GET_1DSLICE_ll, GET_2DSLICE_ll)
+!                   GET_L2_NORM_ll
 !
 !!    Reference
 !!    ---------
       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
 !*       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
 !
 !
 !*       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
 !
 !
       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)
 !     ###########################################
 !
       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)
 !     ##########################################################################
index f7d81b6..cbcbd10 100644 (file)
@@ -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
index 509eaae..c1d6968 100644 (file)
@@ -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,&
index 3413cdd..1fd0747 100644 (file)
@@ -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)
index ba3fa86..d4fc1b5 100644 (file)
@@ -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
 !
index 8f5101d..f986c94 100644 (file)
@@ -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)
 !
 !
 !-------------------------------------------------------------------------------
index d234f75..4e1e3a8 100644 (file)
@@ -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
index 4e6f7c0..aba16ef 100644 (file)
@@ -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
index 3f19638..fadde4e 100644 (file)
@@ -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
index 69fe137..24127f9 100644 (file)
@@ -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)
index 6944b17..6f84156 100644 (file)
@@ -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) &
index fa4cdb1..e931f14 100644 (file)
@@ -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
index 38743f5..69418af 100644 (file)
@@ -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 
 !-------------------------------------------------------------------------------
 !
@@ -281,18 +282,6 @@ ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL  '.OR. CPROGRAM=='SPEC  ') THEN
   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
 !
 ELSE IF (CPROGRAM=='DIAG  ') THEN
index 0d93684..78be2fd 100644 (file)
@@ -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' 
index 22ab0e6..f6f0790 100644 (file)
@@ -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
 !
index c72f3a8..c5dc3e3 100644 (file)
@@ -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
 !
 !-------------------------------------------------------------------------------
 !
index 3fe2d44..6d292f9 100644 (file)
@@ -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
index 132de54..2b09a15 100644 (file)
@@ -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
 !
 !-------------------------------------------------------------------------------
 !
index fa859ac..29347f4 100644 (file)
@@ -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
index 3743e52..1ecf5dc 100644 (file)
@@ -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
index 133c695..5abb95e 100644 (file)
@@ -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)
 !
index 2c2263e..98f4ac8 100644 (file)
 !!    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
index fad4957..edb8b45 100644 (file)
@@ -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
index 2acd792..1a474e6 100644 (file)
@@ -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
index 3034d43..ac5c13f 100644 (file)
 !!      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
index 977331f..7a25108 100644 (file)
@@ -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)
 !
 !-------------------------------------------------------------------------------
 !
index 8feb065..f369feb 100644 (file)
@@ -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
 !
 !-------------------------------------------------------------------------------
index 6ddd54a..8884f11 100644 (file)
@@ -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
 !!
 !!    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
 !
 !-------------------------------------------------------------------------------
 !
index 8587722..3fa665e 100644 (file)
@@ -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,                                      &
index c1e066e..b104fec 100644 (file)
@@ -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
index 6338c90..a419252 100644 (file)
@@ -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
index c8f76c7..bbd07ad 100644 (file)
 !!    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)
 !
index f629664..8133e5f 100644 (file)
 !!                  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)
 !-------------------------------------------------------------------------------
index 4f5ecf0..f82bc45 100644 (file)
@@ -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
index 03e2935..bc0de8e 100644 (file)
@@ -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)
 !
index fbb2feb..d0bbed6 100644 (file)
@@ -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)
 !
 !-------------------------------------------------------------------------------
 !
index c9aeca7..aff3b67 100644 (file)
@@ -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)
 !
index 0473264..592ea7b 100644 (file)
@@ -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
 !
 !-------------------------------------------------------------------------------
index 47c4a4e..0248ac6 100644 (file)
@@ -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'
index 2b57578..f69ab13 100644 (file)
@@ -698,6 +698,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)
 !     #############################################################
 !
index 17f647d..03b49bc 100644 (file)
@@ -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)
index 0f2da4e..f9c9295 100644 (file)
 !
 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)
index 3fef83e..55aa53f 100644 (file)
@@ -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
index 8b04572..bfe7052 100644 (file)
@@ -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
 !
 !
 !-------------------------------------------------------------------------------