From ed3055971caae03cb4bc39ceecf5b0c62be880ce Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 11 Apr 2024 13:38:30 +0200
Subject: [PATCH] Philippe 11/04/2024: IO_Field_write_box: add
IO_Field_write_box_byfield_N2 and IO_Field_write_box_byfield_N3 subroutines
---
src/LIB/SURCOUCHE/src/mode_io_field_write.f90 | 210 +++++++++++++++++-
1 file changed, 208 insertions(+), 2 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index e7e7ed37a..e2a158c3d 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -75,8 +75,10 @@ MODULE MODE_IO_FIELD_WRITE
END INTERFACE
INTERFACE IO_Field_write_box
- MODULE PROCEDURE IO_Field_write_box_byfield_X2, IO_Field_write_box_byfield_X3, &
- IO_Field_write_box_byfield_X4, IO_Field_write_box_byfield_X5
+ 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
END INTERFACE
INTERFACE IO_Field_write_lb
@@ -3519,6 +3521,210 @@ end subroutine IO_Ndimlist_reduce
END SUBROUTINE IO_Field_write_byfield_lb
+ SUBROUTINE IO_Field_write_box_byfield_N2( TPFILE, TPFIELD, HBUDGET, KFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, 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, INTENT(IN) :: KYOBOX !
+ INTEGER, INTENT(IN) :: KYEBOX !
+ 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_N2',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_N2',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_N2', 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,KYOBOX:KYEBOX)
+ 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
+ ! Allocate the box
+ ALLOCATE(IFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(IFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,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, 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_N2', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_N2
+
+
+ SUBROUTINE IO_Field_write_box_byfield_N3( TPFILE, TPFIELD, HBUDGET, KFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, &
+ KZOBOX, KZEBOX, 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, INTENT(IN) :: KYOBOX !
+ INTEGER, INTENT(IN) :: KYEBOX !
+ INTEGER, OPTIONAL, INTENT(IN) :: KZOBOX !
+ INTEGER, OPTIONAL, INTENT(IN) :: KZEBOX !
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ INTEGER :: IZOBOX, IZEBOX
+ 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_N3',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_N3',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_N3', Trim( tpfile%cname ) &
+ // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
+ IF (IRESP==0) THEN
+ IF ( PRESENT( KZOBOX ) ) THEN
+ IZOBOX = KZOBOX
+ ELSE
+ IZOBOX = LBOUND( KFIELD, 3 )
+ END IF
+
+ IF ( PRESENT( KZEBOX ) ) THEN
+ IZEBOX = KZEBOX
+ ELSE
+ IZEBOX = UBOUND( KFIELD, 3 )
+ END IF
+
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ IFIELDP=>KFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,IZOBOX:IZEBOX)
+ 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
+ ! Allocate the box
+ ALLOCATE( IFIELDP(KXEBOX-KXOBOX+1, KYEBOX-KYOBOX+1, IZEBOX-IZOBOX+1) )
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(IFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(KFIELD(:,:,IZOBOX:IZEBOX),IFIELDP,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, 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_N3', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_N3
+
+
SUBROUTINE IO_Field_write_box_byfield_X2( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset )
!
USE MODD_IO, ONLY: GSMONOPROC, ISP
--
GitLab