From 3f03fc8e8231960f9731d0cf4c56aaa911aaea4f Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 12 Apr 2024 11:24:36 +0200
Subject: [PATCH] Philippe 12/04/2024: add IO_Field_write_box_byfield_N1
subroutine
---
src/LIB/SURCOUCHE/src/mode_io_field_write.f90 | 101 +++++++++++++++++-
1 file changed, 100 insertions(+), 1 deletion(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 2daa8afd0..428a047c3 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -76,7 +76,8 @@ 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_N1, IO_Field_write_box_byfield_N2, &
+ IO_Field_write_box_byfield_N3, &
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
@@ -3522,6 +3523,104 @@ end subroutine IO_Ndimlist_reduce
END SUBROUTINE IO_Field_write_byfield_lb
+ SUBROUTINE IO_Field_write_box_byfield_N1( TPFILE, TPFIELD, HBUDGET, KFIELD, 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)
+ INTEGER, DIMENSION(:), TARGET, INTENT(IN) :: KFIELD ! 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
+ INTEGER, DIMENSION(:), POINTER :: IFIELDP
+ LOGICAL :: GALLOC
+ LOGICAL :: GLFI, GNC4
+ CHARACTER(LEN=:), ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_N1',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_N1',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_N1', 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
+ IFIELDP=>KFIELD(KXOBOX:KXEBOX)
+ ELSE
+ ! take the field as a budget
+ IFIELDP=>KFIELD
+ 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, IFIELDP, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, IFIELDP, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, IFIELDP, 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
+ IFIELDP => KFIELD(KXOBOX:KXEBOX)
+ ELSE
+ ! Allocate the box
+ ALLOCATE(IFIELDP(KXEBOX-KXOBOX+1))
+ GALLOC = .TRUE.
+ END IF
+ ELSE
+ ALLOCATE(IFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF ( TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY' ) THEN
+ CALL GATHER_XXFIELD( TPFIELD%CDIR, KFIELD, IFIELDP, 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, IFIELDP, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, IFIELDP, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, IFIELDP, 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_N1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_N1
+
+
SUBROUTINE IO_Field_write_box_byfield_N2( TPFILE, TPFIELD, HBUDGET, KFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset )
!
USE MODD_IO, ONLY: GSMONOPROC, ISP
--
GitLab