From 626f1d3f31450e8210bc86f271b5c19e21912e8d Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 23 May 2024 11:02:18 +0200
Subject: [PATCH] Philippe 23/05/2024: outputs: Z-split files: split main
domain box
---
src/LIB/SURCOUCHE/src/mode_io_field_write.f90 | 137 +++++++++++++-----
1 file changed, 104 insertions(+), 33 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index db0fe5c66..71525031b 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -3982,6 +3982,7 @@ end subroutine IO_Ndimlist_reduce
USE MODD_IO, ONLY: GSMONOPROC, ISP
!
USE MODE_GATHER_ll
+ use mode_io_tools, only: IO_Level2filenumber_get
!
!
!* 0.1 Declarations of arguments
@@ -4002,26 +4003,49 @@ end subroutine IO_Ndimlist_reduce
!
!* 0.2 Declarations of local variables
!
+ integer :: ierr
+ integer :: ik_file
integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer :: iresp_tmp_lfi, iresp_tmp_nc4
+ integer :: ilevel_idx ! Number of the vertical level (starting at 1 for 1st level to write)
+ integer :: ilevels ! Number of vertical levels to write
INTEGER :: IZOBOX, IZEBOX
- REAL, DIMENSION(:,:,:), POINTER :: ZFIELDP
+ integer :: jk
+ integer, dimension(2) :: iresps
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
+ logical :: gsplit ! if true, split the field on vertical levels
+ real, dimension(:,:), pointer :: zfield_slice
+ REAL, DIMENSION(:,:,:), POINTER :: ZFIELDP
+ type(tfiledata), pointer :: tzfile
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
iresp = 0
iresp_lfi = 0
iresp_nc4 = 0
+ iresp_tmp_lfi = 0
+ iresp_tmp_nc4 = 0
GALLOC = .FALSE.
- !
+
+ if ( present( kboxid ) ) then
+ ! Z-split field only for main box (the other boxes are for subdomains and are assumed to be small)
+ if ( kboxid == 0 .and. tpfile%nsubfiles_ioz > 1 .and. tpfield%cdir == 'XY' .and. hbudget /= 'BUDGET' ) then
+ gsplit = .true.
+ else
+ gsplit = .false.
+ end if
+ else
+ gsplit = .false.
+ end if
+
CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X3',IRESP)
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
if ( Present( koffset ) .and. glfi ) then
call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_write_box_byfield_X3', Trim( tpfile%cname ) &
- // ': LFI format not supported' )
+ // ': LFI format not supported (koffset optional argument provided)' )
glfi = .false.
end if
@@ -4038,14 +4062,37 @@ end subroutine IO_Ndimlist_reduce
IZEBOX = UBOUND( PFIELD, 3 )
END IF
- IF (GSMONOPROC) THEN ! sequential execution
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,IZOBOX:IZEBOX)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
+ ilevels = IZEBOX - IZOBOX + 1
+
+ IF ( GSMONOPROC .and. .not. gsplit ) THEN ! sequential execution
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,IZOBOX:IZEBOX)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4, kboxid = kboxid )
+ end if
+ ELSE IF ( .not. gsplit ) THEN ! multiprocesses execution
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ ! Allocate the box
+ ALLOCATE( ZFIELDP(KXEBOX-KXOBOX+1, KYEBOX-KYOBOX+1, ilevels) )
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD(:,:,IZOBOX:IZEBOX),ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
if ( Present( koffset ) ) then
!if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
@@ -4053,29 +4100,53 @@ end subroutine IO_Ndimlist_reduce
if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4, kboxid = kboxid )
end if
- ELSE ! multiprocesses execution
- IF (ISP == TPFILE%NMASTER_RANK) THEN
- ! Allocate the box
- ALLOCATE( ZFIELDP(KXEBOX-KXOBOX+1, KYEBOX-KYOBOX+1, IZEBOX-IZOBOX+1) )
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD(:,:,IZOBOX:IZEBOX),ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TPFILE%NMASTER_RANK) THEN
- if ( Present( koffset ) ) then
- !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
- if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
- else
- if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
- if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4, kboxid = kboxid )
+ END IF
+ ELSE ! parallel I/O (Z-split files)
+ if ( Present( koffset ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_write_box_byfield_X3', Trim( tpfile%cname ) &
+ // ': koffset not supported for Z-split files' )
+
+ ! Write the variable attributes in the non-split file
+ if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ call IO_Field_header_split_write_nc4( tpfile, tpfield, ilevels, kisize=kxebox-kxobox+1, kjsize=kyebox-kyobox+1 )
+
+ allocate( zfield_slice(kxebox-kxobox+1, kyebox-kyobox+1) )
+
+ ! Loop on the vertical levels
+ do jk = izobox, izebox
+ ! Determine the file for this level
+ ilevel_idx = jk - izobox + 1
+ ik_file = IO_Level2filenumber_get( ilevel_idx , tpfile%nsubfiles_ioz )
+ tzfile => tpfile%tfiles_ioz(ik_file+1)%tfile
+
+ ! Gather the data for the current level
+ call Gather_xyfield( pfield(:,:,jk), zfield_slice, tzfile%nmaster_rank, tzfile%nmpicomm, &
+ kxobox, kxebox, kyobox, kyebox, hbudget )
+
+ ! Write the level
+ if ( isp == tzfile%nmaster_rank ) then
+ !Remark: tpfile is provided to these routines and not tzfile (the correct Z-split file is selected from kzfile)
+ if ( glfi ) then
+ call IO_Field_write_lfi( tpfile, tpfield, zfield_slice, iresp_tmp_lfi , &
+ kvertlevel = ilevel_idx, kzfile = ik_file + 1 )
+ if ( iresp_tmp_lfi /= 0 ) iresp_lfi = iresp_tmp_lfi
end if
- END IF
- END IF ! multiprocesses execution
+ if ( gnc4 ) then
+ call IO_Field_write_nc4( tpfile, tpfield, zfield_slice, iresp_tmp_nc4, kboxid = kboxid, &
+ kvertlevel = ilevel_idx, kzfile = ik_file + 1 )
+ if ( iresp_tmp_nc4 /= 0 ) iresp_nc4 = iresp_tmp_nc4
+ end if
+ end if
+ end do
+
+ deallocate( zfield_slice )
+
+ !Not global reduction because a broadcast is done in IO_Field_write_error_check
+ call MPI_REDUCE( -Abs( [ iresp_lfi, iresp_nc4 ] ), iresps(:), 2, MNHINT_MPI, MPI_MIN, &
+ tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+ iresp_lfi = iresps(1)
+ iresp_nc4 = iresps(2)
+ END IF
END IF
call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X3', iresp, iresp_lfi, iresp_nc4, iresp_glob )
--
GitLab