Philippe 29/05/2024: create subroutine IO_Field_box_user_write

src/LIB/SURCOUCHE/src/mode_io_field_write.f90

@@ -28,7 +28,7 @@
 
 MODULE MODE_IO_FIELD_WRITE
 
-  use modd_field,        only: tfieldlist, tfieldmetadata, tfieldmetadata_base, &
+  use modd_field,        only: tfielddata, tfieldlist, tfieldmetadata, tfieldmetadata_base, &
                                TYPECHAR, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL
   USE MODD_IO,         ONLY: TFILEDATA
   USE MODD_MPIF
@@ -88,6 +88,20 @@ MODULE MODE_IO_FIELD_WRITE
      MODULE PROCEDURE IO_Field_write_byname_lb, IO_Field_write_byfield_lb
   END INTERFACE
 
+  INTERFACE IO_Field_box_user_write
+    MODULE PROCEDURE                                          &
+      IO_Field_box_user_write_X0, IO_Field_box_user_write_X1, &
+      IO_Field_box_user_write_X2, IO_Field_box_user_write_X3, &
+      IO_Field_box_user_write_X4, IO_Field_box_user_write_X5, &
+      IO_Field_box_user_write_X6,                             &
+      IO_Field_box_user_write_N0, IO_Field_box_user_write_N1, &
+      IO_Field_box_user_write_N2, IO_Field_box_user_write_N3, &
+      IO_Field_box_user_write_L0, IO_Field_box_user_write_L1, &
+      IO_Field_box_user_write_C0, IO_Field_box_user_write_C1, &
+      IO_Field_box_user_write_T0, IO_Field_box_user_write_T1
+  END INTERFACE
+
+
 CONTAINS 
 
   SUBROUTINE IO_Field_metadata_check(TPFIELD,KTYPE,KDIMS,HCALLER)
@@ -5062,6 +5076,239 @@ SUBROUTINE IO_Box_coords_enable( TPFIELD, TPBOX )
 END SUBROUTINE IO_Box_coords_enable
 
 
+SUBROUTINE IO_Field_box_user_write_X0( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  real,                   target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X0
+
+
+SUBROUTINE IO_Field_box_user_write_X1( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:),  target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X1
+
+
+SUBROUTINE IO_Field_box_user_write_X2( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                 intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),           intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),          intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:,:), target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X2
+
+
+SUBROUTINE IO_Field_box_user_write_X3( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                   intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),             intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),            intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:,:,:), target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X3
+
+
+SUBROUTINE IO_Field_box_user_write_X4( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                     intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),               intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),              intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:,:,:,:), target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X4
+
+
+SUBROUTINE IO_Field_box_user_write_X5( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                       intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),                 intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),                intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:,:,:,:,:), target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X5
+
+
+SUBROUTINE IO_Field_box_user_write_X6( tpoutput, tpfieldmetadata, obox_write, pdata )
+  type(tfiledata),                         intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),                   intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),                  intent(in) :: obox_write      ! Boxes to write
+  real,    dimension(:,:,:,:,:,:), target, intent(in) :: pdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, pdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_X6
+
+
+SUBROUTINE IO_Field_box_user_write_N0( tpoutput, tpfieldmetadata, obox_write, kdata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  integer,                target, intent(in) :: kdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, kdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_N0
+
+
+SUBROUTINE IO_Field_box_user_write_N1( tpoutput, tpfieldmetadata, obox_write, kdata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  integer, dimension(:),  target, intent(in) :: kdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, kdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_N1
+
+
+SUBROUTINE IO_Field_box_user_write_N2( tpoutput, tpfieldmetadata, obox_write, kdata )
+  type(tfiledata),                 intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),           intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),          intent(in) :: obox_write      ! Boxes to write
+  integer, dimension(:,:), target, intent(in) :: kdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, kdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_N2
+
+
+SUBROUTINE IO_Field_box_user_write_N3( tpoutput, tpfieldmetadata, obox_write, kdata )
+  type(tfiledata),                   intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),             intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),            intent(in) :: obox_write      ! Boxes to write
+  integer, dimension(:,:,:), target, intent(in) :: kdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, kdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_N3
+
+
+SUBROUTINE IO_Field_box_user_write_L0( tpoutput, tpfieldmetadata, obox_write, odata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  logical,                target, intent(in) :: odata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, odata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_L0
+
+
+SUBROUTINE IO_Field_box_user_write_L1( tpoutput, tpfieldmetadata, obox_write, odata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  logical, dimension(:),  target, intent(in) :: odata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, odata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_L1
+
+
+SUBROUTINE IO_Field_box_user_write_C0( tpoutput, tpfieldmetadata, obox_write, hdata )
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  character(len=*),       target, intent(in) :: hdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, hdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_C0
+
+
+SUBROUTINE IO_Field_box_user_write_C1( tpoutput, tpfieldmetadata, obox_write, hdata )
+  type(tfiledata),                        intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),                  intent(in) :: tpfieldmetadata ! Field metadata
+  logical,          dimension(0:),        intent(in) :: obox_write      ! Boxes to write
+  character(len=*), dimension(:), target, intent(in) :: hdata           ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, hdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_C1
+
+
+SUBROUTINE IO_Field_box_user_write_T0( tpoutput, tpfieldmetadata, obox_write, tpdata )
+  use modd_type_date, only: date_time
+
+  type(tfiledata),                intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),          intent(in) :: tpfieldmetadata ! Field metadata
+  logical, dimension(0:),         intent(in) :: obox_write      ! Boxes to write
+  type(date_time),        target, intent(in) :: tpdata          ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, tpdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_T0
+
+
+SUBROUTINE IO_Field_box_user_write_T1( tpoutput, tpfieldmetadata, obox_write, tpdata )
+  use modd_type_date, only: date_time
+
+  type(tfiledata),                       intent(in) :: tpoutput        ! Output file
+  class(tfieldmetadata),                 intent(in) :: tpfieldmetadata ! Field metadata
+  logical,         dimension(0:),        intent(in) :: obox_write      ! Boxes to write
+  type(date_time), dimension(:), target, intent(in) :: tpdata          ! Data
+
+  ! Use the custom constructor tfielddata to fill a tfielddata object and provide it to the write subroutine
+  call IO_Field_box_user_intern_write( tpoutput, tfielddata( tpfieldmetadata, tpdata ), obox_write )
+END SUBROUTINE IO_Field_box_user_write_T1
+
+
+SUBROUTINE IO_Field_box_user_intern_write( tpoutput, tpfield, obox_write )
+  use modd_io,        only: isp
+  use modd_out_n,     only: nout_nboxes, tout_boxes
+
+  type(tfiledata),                 intent(in) :: tpoutput        ! Output file
+  type(tfielddata),                intent(in) :: tpfield         ! Field data
+  logical, dimension(0:),          intent(in) :: obox_write      ! Boxes to write
+
+  integer          :: jbox
+  type(tfiledata)  :: tzoutput
+
+  if ( obox_write(0) ) call IO_Fieldlist_1field_write( tpoutput, tpfield, 0, tout_boxes(0) )
+
+  if ( nout_nboxes > 0 ) then
+    tzoutput = tpoutput
+
+    ! Only available for netCDF files
+    if ( tzoutput%cformat == 'LFI') then
+      return
+    else if ( tzoutput%cformat == 'LFICDF4') then
+      tzoutput%cformat = 'NETCDF4'
+    else if ( tzoutput%cformat /= 'NETCDF4' ) THEN
+      call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_box_user_write', &
+                      trim( tzoutput%cname ) // ': unknown fileformat: ' // trim( tzoutput%cformat ) )
+      return
+    end if
+
+    do jbox = 1, nout_nboxes
+      ! Check if the data has to be written for this box
+      if ( .not. obox_write(jbox) ) cycle
+
+      ! Go to the group
+      if ( isp == tzoutput%nmaster_rank ) tzoutput%nncid = tzoutput%nboxncid(jbox)
+
+      ! Write data
+      call IO_Fieldlist_1field_write( tzoutput, tpfield, jbox, tout_boxes(jbox) )
+    end do
+  end if
+
+END SUBROUTINE IO_Field_box_user_intern_write
+
+
 SUBROUTINE IO_Field_user_write( TPOUTPUT )
 !
 #if 0