diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 index 21d4f3e9559f681f923be26eb60b0df2b635237f..2daa8afd00fe41f3f3f882d92eb3c67762f8a0df 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 @@ -77,8 +77,9 @@ MODULE MODE_IO_FIELD_WRITE INTERFACE IO_Field_write_box MODULE PROCEDURE & IO_Field_write_box_byfield_N2, IO_Field_write_box_byfield_N3, & - IO_Field_write_box_byfield_X2, IO_Field_write_box_byfield_X3, & - IO_Field_write_box_byfield_X4, IO_Field_write_box_byfield_X5 + IO_Field_write_box_byfield_X1, IO_Field_write_box_byfield_X2, & + IO_Field_write_box_byfield_X3, IO_Field_write_box_byfield_X4, & + IO_Field_write_box_byfield_X5 END INTERFACE INTERFACE IO_Field_write_lb @@ -3725,6 +3726,104 @@ end subroutine IO_Ndimlist_reduce END SUBROUTINE IO_Field_write_box_byfield_N3 + SUBROUTINE IO_Field_write_box_byfield_X1( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KRESP, koffset ) + ! + USE MODD_IO, ONLY: GSMONOPROC, ISP + ! + USE MODE_GATHER_ll + ! + ! + !* 0.1 Declarations of arguments + ! + TYPE(TFILEDATA), INTENT(IN) :: TPFILE + CLASS(TFIELDMETADATA), INTENT(IN) :: TPFIELD + CHARACTER(LEN=*), INTENT(IN) :: HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field) + REAL, DIMENSION(:), TARGET, INTENT(IN) :: PFIELD ! array containing the data field + INTEGER, INTENT(IN) :: KXOBOX ! + INTEGER, INTENT(IN) :: KXEBOX ! Global coordinates of the box + INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code + integer, dimension(2), optional, intent(in) :: koffset + ! + !* 0.2 Declarations of local variables + ! + integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob + REAL, DIMENSION(:), POINTER :: ZFIELDP + LOGICAL :: GALLOC + LOGICAL :: GLFI, GNC4 + CHARACTER(LEN=:), ALLOCATABLE :: YMSG + CHARACTER(LEN=6) :: YRESP + ! + CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME)) + ! + iresp = 0 + iresp_lfi = 0 + iresp_nc4 = 0 + GALLOC = .FALSE. + ! + CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X1',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_X1', Trim( tpfile%cname ) & + // ': LFI format not supported' ) + glfi = .false. + end if + + IF (IRESP==0) THEN + IF (GSMONOPROC) THEN ! sequential execution + IF (HBUDGET /= 'BUDGET') THEN + ! take the sub-section of PFIELD defined by the box + ZFIELDP=>PFIELD(KXOBOX:KXEBOX) + 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 ) + end if + ELSE ! multiprocesses execution + IF (ISP == TPFILE%NMASTER_RANK) THEN + IF ( TPFIELD%CDIR == 'ZZ' ) THEN + ! If 'ZZ', everything is already on master process. No need to communicate, just point to the right section + ZFIELDP => PFIELD(KXOBOX:KXEBOX) + ELSE + ! Allocate the box + ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1)) + GALLOC = .TRUE. + END IF + ELSE + ALLOCATE(ZFIELDP(0)) + GALLOC = .TRUE. + END IF + ! + IF ( TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY' ) THEN + CALL GATHER_XXFIELD( TPFIELD%CDIR, PFIELD, ZFIELDP, TPFILE%NMASTER_RANK, TPFILE%NMPICOMM, KXOBOX, KXEBOX ) + END IF + ! + 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 ) + end if + END IF + END IF ! multiprocesses execution + END IF + + call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X1', iresp, iresp_lfi, iresp_nc4, iresp_glob ) + if ( Present( kresp ) ) kresp = iresp_glob + + IF (GALLOC) DEALLOCATE(ZFIELDP) + END SUBROUTINE IO_Field_write_box_byfield_X1 + + SUBROUTINE IO_Field_write_box_byfield_X2( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset ) ! USE MODD_IO, ONLY: GSMONOPROC, ISP