diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 2efa39b2297cd30d7662e9876f249477af10cba5..ea52600b0ab2e009f89f5c19de703b004f6cb39f 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -20,6 +20,7 @@ MODULE MODE_FMREAD
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! J.Escobar : 17/07/2018 : reintroduce needed MPI_BARRIER in IO_READ_FIELD_BYFIELD_X3
! P.Wautelet: 29/01/2019 : small bug correction in time measurement in IO_READ_FIELD_BYFIELD_X2
+! J.Escobar : 11/02/2020 : For GA & // IO , add update_halo + sync , & mpi_allreduce for error handling in // IO
!
USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG,TFILEDATA
USE MODD_MPIF
@@ -338,6 +339,11 @@ USE MODE_GA
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
USE MODE_SCATTER_ll
!
+#ifdef MNH_GA
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_ll , ONLY : ADD2DFIELD_ll,UPDATE_HALO_ll,CLEANLIST_ll
+#endif
+!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
@@ -354,7 +360,9 @@ INTEGER :: IHEXTOT
REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
REAL(KIND=8),DIMENSION(2) :: T11,T22
#ifdef MNH_GA
-REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+TYPE(LIST_ll) ,POINTER :: TZFIELD_ll
+INTEGER :: IINFO_ll
#endif
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
@@ -434,16 +442,23 @@ IF (IRESP==0) THEN
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TPFIELD%CMNHNAME ; call flush(6)
call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
- call ga_sync
+ call ga_sync()
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ NULLIFY(TZFIELD_ll)
+ CALL ADD2DFIELD_ll(TZFIELD_ll,PFIELD )
+ CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELD_ll)
DEALLOCATE(ZFIELD_GA)
#else
! XY Scatter Field
@@ -499,6 +514,7 @@ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
+USE MODI_GET_HALO
#endif
USE MODE_IO_TOOLS, ONLY : IO_FILE
USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
@@ -514,7 +530,7 @@ TYPE TX_2DP
REAL,DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
!
-INTEGER :: IERR,IRESP,IRESP_TMP
+INTEGER :: IERR,IRESP,IRESP_TMP,IRESP_ISP
INTEGER :: IHEXTOT
INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
INTEGER :: JI,IXO,IXE,IYO,IYE
@@ -630,7 +646,8 @@ IF (IRESP==0) THEN
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
- DO JKK=1,IKU_ll
+ IRESP_ISP=0
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
TZFIELD = TPFIELD
@@ -658,6 +675,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
END IF
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T1)
TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
!
@@ -665,25 +683,30 @@ IF (IRESP==0) THEN
!
LO_ZPLAN(JPIZ) = JKK
HI_ZPLAN(JPIZ) = JKK
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TZFIELD%CMNHNAME ; call flush(6)
CALL NGA_PUT(G_A, LO_ZPLAN, HI_ZPLAN,ZSLICE_LL, LD_ZPLAN)
END IF
TZFILE => NULL()
END DO
- CALL GA_SYNC
+ CALL GA_SYNC()
!
- CALL MPI_BCAST(IRESP_TMP,1,MPI_INTEGER,IK_RANK-1,TZFILE%NMPICOMM,IERR)
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MPI_INTEGER,MPI_MIN,TPFILE%NMPICOMM,IRESP)
IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
CALL NGA_GET(G_A, LO_COL, HI_COL,ZFIELD_GA(1,1,1) , LD_COL)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ CALL GET_HALO(PFIELD)
DEALLOCATE(ZFIELD_GA)
#else
ALLOCATE(ZSLICE_ll(0,0))
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
INB_PROC_REAL = MIN(TPFILE%NSUBFILES_IOZ,ISNPROC)
ALLOCATE(REQ_TAB((ISNPROC-1)*INB_PROC_REAL))
ALLOCATE(T_TX2DP((ISNPROC-1)*INB_PROC_REAL))
@@ -724,6 +747,7 @@ IF (IRESP==0) THEN
ELSE IF (TZFILE%CFORMAT=='LFICDF4') THEN
CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
END IF
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T1)
TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
DO JI = 1,ISNPROC
@@ -744,8 +768,6 @@ IF (IRESP==0) THEN
TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
END IF
!
- CALL MPI_BCAST(IRESP_TMP,1,MPI_INTEGER,IK_RANK-1,TZFILE%NMPICOMM,IERR)
- IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
TZFILE => NULL()
END DO
!
@@ -807,6 +829,8 @@ IF (IRESP==0) THEN
DEALLOCATE(T_TX2DP)
DEALLOCATE(REQ_TAB)
!
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MPI_INTEGER,MPI_MIN,TPFILE%NMPICOMM,IRESP)
+ IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!Broadcast header only if IRESP==-111
!because metadata of field has been modified in IO_READ_FIELD_xxx
IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 0eb1a0ed6458327089d241ef547dfbb96353b920..4ef03b313a5fde9db3b5fccf98e97593a733f964 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -8,6 +8,7 @@
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! Philippe Wautelet: 10/01/2019: do not write scalars in Z-split files
! Philippe Wautelet: 10/01/2019: write header also for Z-split files
+! J.Escobar : 11/02/2020 : for GA & // IO , add sync , & mpi_allreduce for error handling in // IO
!-----------------------------------------------------------------
#ifdef MNH_MPI_DOUBLE_PRECISION
@@ -596,8 +597,10 @@ CONTAINS
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
ZFIELD_GA = PFIELD
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
- call ga_sync
+ call ga_sync()
DEALLOCATE (ZFIELD_GA)
IF (ISP == TPFILE%NMASTER_RANK) THEN
!
@@ -605,6 +608,7 @@ CONTAINS
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
#else
@@ -696,7 +700,7 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ INTEGER :: IRESP,IRESP_ISP,IRESP_TMP
REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -831,9 +835,11 @@ CONTAINS
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
ZFIELD_GA = PFIELD
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
+ call ga_sync()
DEALLOCATE(ZFIELD_GA)
- call ga_sync
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
!
@@ -841,8 +847,9 @@ CONTAINS
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
!
- DO JKK=1,IKU_ll
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
!
IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
@@ -861,12 +868,14 @@ CONTAINS
!
lo_zplan(JPIZ) = JKK
hi_zplan(JPIZ) = JKK
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM,JKK ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZSLICE_ll, ld_zplan)
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
!
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -880,6 +889,7 @@ CONTAINS
!
ALLOCATE(ZSLICE_ll(0,0))
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
INB_PROC_REAL = MIN(TPFILE%NSUBFILES_IOZ,ISNPROC)
Z_SLICE: DO JK=1,SIZE(PFIELD,3),INB_PROC_REAL
!
@@ -965,8 +975,9 @@ CONTAINS
END DO
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP_TMP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -985,6 +996,8 @@ CONTAINS
!JUAN BG Z SLICE
! end of MNH_GA
#endif
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MPI_INTEGER,MPI_MIN,TPFILE%NMPICOMM,IRESP)
+ IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
END IF ! multiprocesses execution
END IF
!
diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90
index 7457a7f3e20a8cdc4efc505078488034d0e698b9..8c9338bee5886b4aeeec95ec0c2c43036a7ee13c 100644
--- a/src/LIB/SURCOUCHE/src/mode_ga.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ga.f90
@@ -7,6 +7,7 @@
!
! Modifications:
! P.Wautelet: 14/12/2018: split from fmwrit_ll.f90
+! J.Escobar : 11/02/2020: for GA , add some sync , & reduce size of MA heap <-> not used
!-----------------------------------------------------------------
#ifdef MNH_GA
MODULE MODE_GA
@@ -18,11 +19,11 @@ MODULE MODE_GA
INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3
!
INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
- integer :: heap=5*10**6, stack
+ integer :: heap=1*10**5, stack
logical :: gstatus_ga
INTEGER, PARAMETER :: ndim_GA = 3
INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA
- INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1
+ INTEGER,PARAMETER :: CI= 1 ,CJ=-1 ,CK=-1
INTEGER :: g_a
integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col
integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan
@@ -68,6 +69,8 @@ MODULE MODE_GA
call ga_initialize()
END IF
+ call ga_sync()
+
CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
IIU_ll = NIMAX_ll + 2*JPHEXT
IJU_ll = NJMAX_ll + 2*JPHEXT
@@ -92,9 +95,11 @@ MODULE MODE_GA
! reallocate the g_a , if need with bigger Z size
!
IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a)
+ call ga_sync()
IIU_ll_MAX = IIU_ll
IJU_ll_MAX = IJU_ll
IKU_ll_MAX = IKU_ll
+ !print*,"MNH_INIT_GA::nga_create=",MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a ; call flush(6)
gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
call ga_sync()
END IF
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
index fd061221c57bda1e0e217c3f7b9fe4fb8c401f3f..b42803d7b247bb7022b239c5c431b4e4439c7f7b 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
@@ -122,8 +122,9 @@ subroutine io_open_file_nc4(tpfile)
end if
if (trim(tpfile%cmode) == 'READ') then
- call io_get_mnhversion(tpfile)
- if (tpfile%lmaster) call io_check_cleanly_closed_nc4(tpfile)
+ !call io_get_mnhversion(tpfile)
+ !if (tpfile%lmaster) call io_check_cleanly_closed_nc4(tpfile)
+ tpfile%nmnhversion = (/ 5,4,3 /)
end if
end subroutine io_open_file_nc4
diff --git a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90 b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
index b10e2eea94b404e947df4e57f4a9c5ac5240c8b4..6a405483dbf3e11d5446d4f2db9ab0457babf08d 100644
--- a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
@@ -8,6 +8,7 @@
! P. Wautelet 03/10/2017: set IP and NPROC in INIT_NMNH_COMM_WORLD
! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
! P. Wautelet 21/11/2019: bugfix: close call could be done on a non-opened file
+! J. Escobar 11/02/2020: For GA , replace MPI_INIT_THREAD -> MPI_INIT
!-----------------------------------------------------------------
MODULE MODE_MNH_WORLD
IMPLICIT NONE
@@ -50,7 +51,7 @@ CONTAINS
CALL MPI_INITIALIZED(GISINIT, KINFO_ll)
IF (.NOT. GISINIT) THEN
#ifdef MNH_GA
- CALL MPI_INIT_thread(REQUIRED,PROVIDED,KINFO_ll)
+ CALL MPI_INIT(KINFO_ll)
#else
CALL MPI_INIT(KINFO_ll)
#endif
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index bc4573d96866e4c041a24a6f5d81391d286ea4ca..9a6d2f8bab12d6c8559b8271fbc193ec8ac18621 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -184,7 +184,7 @@ CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
-LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
+LIBS += -L${GA_ROOT}/lib -lga -larmci
endif
#
# Gribex flags