From 24f50e2383ad0083841db9449874bfb183758e6b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 8 Dec 2020 16:39:32 +0100
Subject: [PATCH] Philippe 08/12/2020: budgets: merge budgets terms with
different nbutshift in same group variables
---
src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 | 28 +-
src/MNH/ini_budget.f90 | 9 +
src/MNH/modd_budget.f90 | 7 +-
src/MNH/write_budget.f90 | 105 +++--
src/MNH/write_diachro.f90 | 423 ++++++++++++++++++--
5 files changed, 504 insertions(+), 68 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
index 343f7125e..d1daa0105 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
@@ -15,6 +15,7 @@
! P. Wautelet 14/09/2020: IO_Vdims_fill_nc4: use ndimlist when provided to fill dimensions ids
! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
! P. Wautelet 26/11/2020: IO_Vdims_fill_nc4: support for empty kshape
+! P. Wautelet 08/12/2020: add nbutotwrite
!-----------------------------------------------------------------
#ifdef MNH_IOCDF4
module mode_io_tools_nc4
@@ -241,7 +242,7 @@ END SUBROUTINE IO_Dimids_guess_nc4
SUBROUTINE IO_Knowndims_set_nc4(TPFILE,HPROGRAM_ORIG)
-use modd_budget, only: cbutype, lbu_icp, lbu_jcp, lbu_kcp, nbuimax_ll, nbujmax_ll, nbukmax, nbumask, nbuwrnb
+use modd_budget, only: cbutype, lbu_icp, lbu_jcp, lbu_kcp, nbuimax_ll, nbujmax_ll, nbukmax, nbumask, nbutotwrite
use modd_lbc_n, only: clbcx, clbcy
USE MODD_CONF, ONLY: CPROGRAM, l2d, lpack
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
@@ -338,19 +339,20 @@ if ( tpfile%ctype == 'MNHDIACHRONIC' ) then
!Dimensions for the budgets masks
if ( cbutype == 'CART' .or. cbutype == 'SKIP' ) then
- if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI, 'cart_ni', nbuimax_ll )
- if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ, 'cart_nj', nbujmax_ll )
- if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_U, 'cart_ni_u', nbuimax_ll )
- if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_U, 'cart_nj_u', nbujmax_ll )
- if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_V, 'cart_ni_v', nbuimax_ll )
- if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_V, 'cart_nj_v', nbujmax_ll )
- if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL, 'cart_level', nbukmax )
- if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL_W, 'cart_level_w', nbukmax )
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI, 'cart_ni', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ, 'cart_nj', nbujmax_ll )
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_U, 'cart_ni_u', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_U, 'cart_nj_u', nbujmax_ll )
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_V, 'cart_ni_v', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_V, 'cart_nj_v', nbujmax_ll )
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL, 'cart_level', nbukmax )
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL_W, 'cart_level_w', nbukmax )
+ if ( nbutotwrite > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_TIME, 'time_budget', nbutotwrite )
else if ( cbutype == 'MASK' ) then
- if ( nbukmax > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL, 'mask_level', nbukmax )
- if ( nbukmax > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL_W, 'mask_level_w', nbukmax )
- if ( nbuwrnb > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_TIME, 'time_budget', nbuwrnb )
- if ( nbumask > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_NBUMASK, 'nbumask', nbumask )
+ if ( nbukmax > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL, 'mask_level', nbukmax )
+ if ( nbukmax > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL_W, 'mask_level_w', nbukmax )
+ if ( nbutotwrite > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_TIME, 'time_budget', nbutotwrite )
+ if ( nbumask > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_NBUMASK, 'nbumask', nbumask )
end if
!Dimension for the number of LES budget time samplings
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 46cd0d5e2..0a1adcb42 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -198,6 +198,7 @@ end subroutine Budget_preallocate
! P. Wautelet 30/06/2020: use NADVSV when possible
! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -345,6 +346,14 @@ if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
NBUWRNB = NINT (XBUWRI / XBULEN) ! only after NBUWRNB budget periods, we write the
! result on the FM_FILE
+
+ if ( cbutype == 'CART' ) then
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ nbusubwrite = nbuwrnb !Number of budget time average periods for each write
+ nbutotwrite = nbuwrnb * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
end if
IF (CBUTYPE=='CART') THEN ! cartesian case only
diff --git a/src/MNH/modd_budget.f90 b/src/MNH/modd_budget.f90
index 99154b8e0..aa5fbd9c1 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -56,6 +56,7 @@
! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
! P. Wautelet 17/08/2020: add xtmplesstore in tbudgetdata datatype
! P. Wautelet 08/10/2020: add clessource in tbudgetdata datatype
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -112,7 +113,7 @@ type, extends( tfield_metadata_base ) :: tbusourcedata
logical :: lenabled = .false.
logical :: ldonotinit = .false. ! if true, does not need a call to Budget_store_init
! It may be true only if the source term is in a group not containing other sources
- logical :: loverwrite = .false. ! if true, source term values will overwrite the previuos ones
+ logical :: loverwrite = .false. ! if true, source term values will overwrite the previous ones
! It may be true only if the source term is in a group not containing other sources
end type tbusourcedata
@@ -147,11 +148,13 @@ REAL, SAVE :: XBULEN ! length in seconds of the budget
!
INTEGER, SAVE :: NBUSTEP ! number of model timesteps required
! for the budget time average
-REAL, SAVE :: XBUWRI ! period in seconds of
+REAL, SAVE :: XBUWRI ! period in seconds of
! budget writing on FM-files
INTEGER, SAVE :: NBUWRNB ! number of budget periods when storage
! arrays are written on FM-files
INTEGER, SAVE :: NBUTSHIFT ! temporal shift for budgets writing
+integer, save :: nbusubwrite = 0 ! Number of budget time average periods for each write
+integer, save :: nbutotwrite = 0 ! Total number of budget time average periods
!
INTEGER, SAVE :: NBUKL, NBUKH ! lowest and highest K indice values
! of the budget box
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index c4364f06c..a50d7435f 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -31,6 +31,7 @@
! P. Wautelet 14/10/2019: complete restructuration and deduplication of code
! P. Wautelet 10/03/2020: use the new data structures and subroutines for budgets
! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
+! P. Wautelet 08/12/2020: budgets: merge budgets terms with different nbutshift
!-----------------------------------------------------------------
!#######################
@@ -100,14 +101,16 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
NBUDGET_RHO, NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
tbudgets, tburhodj
- use modd_field, only: tfielddata, TYPEREAL
+ use modd_field, only: NMNHDIM_ONE, NMNHDIM_NI, NMNHDIM_NJ, &
+ NMNHDIM_BUDGET_TIME, NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_UNUSED, &
+ tfielddata, TYPEREAL
use modd_io, only: tfiledata
use modd_lunit_n, only: tluout
use modd_parameters, only: NMNHNAMELGTMAX
use modd_type_date, only: date_time
use mode_datetime, only: datetime_distance
- use mode_io_field_write, only: IO_Field_write
+ use mode_io_field_write, only: IO_Field_create, IO_Field_write
use mode_menu_diachro, only: Menu_diachro
use mode_msg
use mode_time, only: tdtexp
@@ -127,6 +130,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
real, dimension(:,:,:,:,:,:), allocatable :: zrhodjn, zworkmask
type(date_time), dimension(:), allocatable :: tzdates
type(tfielddata) :: tzfield
+ type(tfiledata) :: tzfile
!
!-------------------------------------------------------------------------------
!
@@ -201,14 +205,6 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
CASE('MASK')
ALLOCATE(ZWORKTEMP(NBUWRNB))
allocate( tzdates(NBUWRNB) )
- ALLOCATE(ZWORKMASK(SIZE(XBUSURF,1),SIZE(XBUSURF,2),1,NBUWRNB,NBUMASK,1))
- !
- ! local array
- DO JMASK=1,NBUMASK
- DO JT=1,NBUWRNB
- ZWORKMASK(:,:,1,JT,JMASK,1) = XBUSURF(:,:,JMASK,JT)
- END DO
- END DO
!
CALL DATETIME_DISTANCE(TDTEXP,TPDTCUR,ZWORKTEMP(NBUWRNB))
!
@@ -230,20 +226,70 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!
!* 3.1 storage of the masks array
!
- WRITE(TZFIELD%CMNHNAME,FMT="('MASK_',I4.4,'.MASK')" ) nbutshift
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = ''
- TZFIELD%CDIR = 'XY'
- WRITE(TZFIELD%CCOMMENT,FMT="('X_Y_MASK',I4.4)" ) nbutshift
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 6
- TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ZWORKMASK(:,:,:,:,:,:))
- WRITE(YRECFM,FMT="('MASK_',I4.4)" ) nbutshift
- CALL MENU_DIACHRO(TPDIAFILE,YRECFM)
- DEALLOCATE(ZWORKMASK)
+ if ( Trim( tpdiafile%cformat ) == 'LFI' .or. Trim( tpdiafile%cformat ) == 'LFICDF4' ) then
+ Allocate( zworkmask(Size( xbusurf, 1 ), Size( xbusurf, 2 ), 1, nbuwrnb, nbumask,1) )
+ ! local array
+ do jmask = 1, nbumask
+ do jt = 1, nbuwrnb
+ zworkmask(:, :, 1, jt, jmask, 1) = xbusurf(:, :, jmask, jt)
+ end do
+ end do
+
+ tzfile = tpdiafile
+ tzfile%cformat = 'LFI'
+
+ Write( tzfield%cmnhname, fmt = "( 'MASK_', i4.4, '.MASK' )" ) nbutshift
+ tzfield%cstdname = ''
+ tzfield%clongname = Trim( tzfield%cmnhname )
+ tzfield%cunits = ''
+ tzfield%cdir = 'XY'
+ Write( tzfield%ccomment, fmt = "( 'X_Y_MASK', i4.4 )" ) nbutshift
+ tzfield%ngrid = 1
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 6
+ tzfield%ltimedep = .FALSE.
+ tzfield%ndimlist(1) = NMNHDIM_NI
+ tzfield%ndimlist(2) = NMNHDIM_NJ
+ tzfield%ndimlist(3) = NMNHDIM_ONE
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfield%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(6) = NMNHDIM_ONE
+ call IO_Field_write( tzfile, tzfield, zworkmask(:, :, :, :, :, :) )
+
+ Write( yrecfm, fmt = "( 'MASK_', i4.4 )" ) nbutshift
+ call Menu_diachro( tzfile, yrecfm )
+
+ Deallocate( zworkmask )
+ end if
+
+ if ( Trim( tpdiafile%cformat ) == 'LFICDF4' .or. Trim( tpdiafile%cformat ) == 'NETCDF4' ) then
+ tzfile = tpdiafile
+ tzfile%cformat = 'NETCDF4'
+
+ tzfield%cmnhname = 'MASKS'
+ tzfield%cstdname = ''
+ tzfield%clongname = Trim( tzfield%cmnhname )
+ tzfield%cunits = '1'
+ tzfield%cdir = 'XY'
+ tzfield%ccomment = 'Masks for budget areas'
+ tzfield%ngrid = 1
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 4
+ tzfield%ltimedep = .false. !The time dependance is in the NMNHDIM_BUDGET_TIME dimension
+ tzfield%ndimlist(1) = NMNHDIM_NI
+ tzfield%ndimlist(2) = NMNHDIM_NJ
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ !Write the data (partial write of the field with the given offset)
+ call IO_Field_write( tzfile, tzfield, xbusurf(:,:,:,:), koffset= [ 0, 0, 0, ( nbutshift - 1 ) * nbuwrnb ] )
+
+ if ( nbutshift == 1 ) call Menu_diachro( tzfile, 'MASKS' )
+ end if
!
END SELECT
!
@@ -386,7 +432,7 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
call Print_msg( NVERB_DEBUG, 'BUD', 'Store_one_budget_rho', 'called for '//trim( tprhodj%cmnhname ) )
- if ( allocated( prhodjn ) ) deallocate( prhodjn )
+ !if ( allocated( prhodjn ) ) deallocate( prhodjn ) !Not necessary: if intent(out) => automatically deallocated
! pburhodj storage
select case ( cbutype )
@@ -499,7 +545,7 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
call Write_diachro( tpdiafile, [ tzfield ], ygroup_name, ybutype, tpdates, prhodjn, &
oicp = lbu_icp, ojcp = lbu_jcp, okcp = lbu_kcp, &
- kil = nbuil, kih = nbuih, kjl = nbujl, kjh = nbujh, kkl = nbukl, kkh = nbukh )
+ kil = nbuil, kih = nbuih, kjl = nbujl, kjh = nbujh, kkl = nbukl, kkh = nbukh, osplit = .true. )
end subroutine Store_one_budget_rho
@@ -724,9 +770,10 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
end if
end do
- call Write_diachro( tpdiafile, tzfields, ygroup_name, ybutype, tpdates, zworkt, &
- oicp = lbu_icp, ojcp = lbu_jcp, okcp = lbu_kcp, &
- kil = nbuil, kih = nbuih, kjl = nbujl, kjh = nbujh, kkl = nbukl, kkh = nbukh )
+ call Write_diachro( tpdiafile, tzfields, ygroup_name, ybutype, tpdates, zworkt, &
+ oicp = lbu_icp, ojcp = lbu_jcp, okcp = lbu_kcp, &
+ kil = nbuil, kih = nbuih, kjl = nbujl, kjh = nbujh, kkl = nbukl, kkh = nbukh, &
+ osplit = .true. )
end subroutine Store_one_budget
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 9803640e3..eb611be30 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -82,6 +82,7 @@ subroutine Write_diachro( tpdiafile, tpfields, hgroup, htype, &
! P. Wautelet 13/09/2019: remove never used PMASK optional dummy-argument
! P. Wautelet 28/08/2020: remove TPLUOUTDIA dummy argument
! P. Wautelet 09/10/2020: use new data type tpfields
+! P. Wautelet 08/12/2020: budgets: merge budgets terms with different nbutshift in same group variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -110,6 +111,7 @@ INTEGER, INTENT(IN), OPTIONAL :: KKL
REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJX
REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJY
REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJZ
+logical, intent(in), optional :: osplit
!
!* 0.1 Local variables
! ---------------
@@ -146,7 +148,8 @@ if ( tpdiafile%cformat == 'LFI' .or. tpdiafile%cformat == 'LFICDF4' ) &
#ifdef MNH_IOCDF4
if ( tpdiafile%cformat == 'NETCDF4' .or. tpdiafile%cformat == 'LFICDF4' ) &
- call Write_diachro_nc4( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, gicp, gjcp, gkcp, kil, kih, kjl, kjh, kkl, kkh )
+ call Write_diachro_nc4( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, gicp, gjcp, gkcp, kil, kih, kjl, kjh, kkl, kkh, &
+ osplit )
#endif
lpack = gpack
@@ -616,11 +619,13 @@ call Menu_diachro( tzfile, ygroup )
end subroutine Write_diachro_lfi
!-----------------------------------------------------------------------------
#ifdef MNH_IOCDF4
-subroutine Write_diachro_nc4( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh )
+subroutine Write_diachro_nc4( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh, &
+ osplit )
use NETCDF, only: NF90_DEF_DIM, NF90_DEF_GRP, NF90_DEF_VAR, NF90_INQ_NCID, NF90_PUT_ATT, NF90_PUT_VAR, &
NF90_GLOBAL, NF90_NOERR, NF90_STRERROR
+use modd_budget, only: nbutshift, nbusubwrite
use modd_field
use modd_io, only: isp, tfiledata
use modd_les, only: nles_masks
@@ -628,7 +633,7 @@ use modd_parameters, only: jphext
use modd_precision, only: CDFINT, MNHREAL_NF90
use modd_type_date, only: date_time
-use mode_io_field_write, only: IO_Field_write, IO_Field_write_box
+use mode_io_field_write, only: IO_Field_create, IO_Field_write, IO_Field_write_box
use mode_io_tools_nc4, only: IO_Err_handle_nc4
use mode_menu_diachro, only: Menu_diachro
use mode_msg
@@ -642,6 +647,7 @@ logical, intent(in) :: oic
integer, intent(in), optional :: kil, kih
integer, intent(in), optional :: kjl, kjh
integer, intent(in), optional :: kkl, kkh
+logical, intent(in), optional :: osplit
character(len=3) :: ynum
integer :: icompx, icompy, icompz
@@ -654,6 +660,7 @@ integer(kind=CDFINT) :: idimid
integer(kind=CDFINT) :: igrpid
integer(kind=CDFINT) :: istatus
integer(kind=CDFINT) :: idimtimeid
+logical :: gsplit
real :: zdata0d
real, dimension(:), allocatable :: zdata1d
real, dimension(:,:), allocatable :: zdata2d
@@ -694,6 +701,12 @@ else
icompz = 0
endif
+if ( Present( osplit ) ) then
+ gsplit = osplit
+else
+ gsplit = .false.
+end if
+
MASTER: if ( isp == tzfile%nmaster_rank) then
istatus = NF90_INQ_NCID( tzfile%nncid, trim( hgroup ), igrpid )
if ( istatus == NF90_NOERR ) then
@@ -817,6 +830,12 @@ end if
select case ( idims )
case (0)
+
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
zdata0d = pvar(1, 1, 1, 1, 1, 1)
TZFIELD%CMNHNAME = tpfields(1)%cmnhname
@@ -832,10 +851,16 @@ select case ( idims )
CALL IO_Field_write( tzfile, tzfield, zdata0d )
case (1)
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
if ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
tzfield%ndimlist(1) = tpfields(1)%ndimlist(4)
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
@@ -862,6 +887,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(1) == NMNHDIM_BUDGET_CART_NI &
.or. tpfields(1)%ndimlist(1) == NMNHDIM_BUDGET_CART_NI_U &
.or. tpfields(1)%ndimlist(1) == NMNHDIM_BUDGET_CART_NI_V ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
tzfield%ndimlist(1) = tpfields(1)%ndimlist(1)
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
@@ -888,6 +918,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ &
.or. tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ_U &
.or. tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ_V ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
tzfield%ndimlist(1) = tpfields(1)%ndimlist(2)
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
@@ -929,16 +964,39 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(1)%ntype
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write( tzfile, tzfield, zdata1d )
+
+ if ( gsplit ) then
+ if ( htype /= 'CART' ) call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //': gsplit=T not implemented for these dimensions and htype/=CART' )
+
+ !Add budget time dimension
+ tzfield%ndims = 2
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, Reshape( zdata1d, [ Size(zdata1d,1), 1 ] ), &
+ koffset= [ 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata1d )
+ end if
deallocate( zdata1d )
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
end if
case (2)
+
if ( ( tpfields(1)%ndimlist(1) == NMNHDIM_NI .or. tpfields(1)%ndimlist(1) == NMNHDIM_NI_U .or. &
tpfields(1)%ndimlist(1) == NMNHDIM_NI_V .or. tpfields(1)%ndimlist(1) == NMNHDIM_BUDGET_CART_NI &
.or. tpfields(1)%ndimlist(1) == NMNHDIM_BUDGET_CART_NI_U &
@@ -947,6 +1005,11 @@ select case ( idims )
tpfields(1)%ndimlist(2) == NMNHDIM_NJ_V .or. tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ .or. &
tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ_U &
.or. tpfields(1)%ndimlist(2) == NMNHDIM_BUDGET_CART_NJ_V ) ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -979,6 +1042,7 @@ select case ( idims )
.and. ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL_W ) ) then
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1000,7 +1064,23 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(1)%ntype
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write( tzfile, tzfield, zdata2d )
+
+ if ( gsplit ) then
+ if ( htype /= 'CART' ) call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //': gsplit=T not implemented for these dimensions and htype/=CART' )
+
+ !Add budget time dimension
+ tzfield%ndims = 3
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ koffset= [ 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata2d )
+ end if
deallocate( zdata2d )
@@ -1011,6 +1091,7 @@ select case ( idims )
.and. ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL_W ) ) then
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1032,13 +1113,34 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(1)%ntype
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write( tzfile, tzfield, zdata2d )
+
+ if ( gsplit ) then
+ if ( htype /= 'CART' ) call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //': gsplit=T not implemented for these dimensions and htype/=CART' )
+
+ !Add budget time dimension
+ tzfield%ndims = 3
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ koffset= [ 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata2d )
+ end if
deallocate( zdata2d )
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1064,9 +1166,53 @@ select case ( idims )
deallocate( zdata2d )
+ else if ( Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
+ tzfield%ndimlist(1) = tpfields(1)%ndimlist(3)
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+
+ allocate( zdata1d( size(pvar,3) ) )
+
+ ! Loop on the processes (1 written variable per process)
+ do ji = 1, Size( pvar, 6 )
+ zdata1d(:) = pvar(1, 1, :, 1, 1, ji)
+
+ tzfield%cmnhname = tpfields(ji)%cmnhname
+ tzfield%cstdname = tpfields(ji)%cstdname
+ tzfield%clongname = tpfields(ji)%clongname
+ tzfield%cunits = tpfields(ji)%cunits
+ tzfield%cdir = '--'
+ tzfield%ccomment = tpfields(ji)%ccomment
+ tzfield%ngrid = tpfields(ji)%ngrid
+ tzfield%ntype = tpfields(ji)%ntype
+ tzfield%ndims = 1
+ tzfield%ltimedep = .FALSE.
+
+ if ( gsplit ) then
+ !Add budget time dimension
+ tzfield%ndims = 2
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, Reshape( zdata1d, [ Size(zdata1d,1), 1 ] ), &
+ koffset= [ 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata1d )
+ end if
+ end do
+
+ deallocate( zdata1d )
+
else if ( ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1094,6 +1240,10 @@ select case ( idims )
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_FLYER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_FLYER_PROC ) then
!Correspond to FLYER_DIACHRO
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
!Create local time dimension
if ( isp == tzfile%nmaster_rank) then
@@ -1128,6 +1278,10 @@ select case ( idims )
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_STATION_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_STATION_PROC ) then
!Correspond to STATION_DIACHRO_n
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
tzfield%ndimlist(1) = tpfields(1)%ndimlist(4)
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
@@ -1155,6 +1309,10 @@ select case ( idims )
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to WRITE_SERIES_n
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
tzfield%ndimlist(1) = tpfields(1)%ndimlist(4)
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
@@ -1182,6 +1340,12 @@ select case ( idims )
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
end if
@@ -1218,18 +1382,124 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(1)%ntype
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
- !Data is distributed between all the processes
- TZFIELD%CDIR = 'XY'
- CALL IO_Field_write_BOX( tzfile, tzfield, 'BUDGET', zdata3d, &
- KIL + JPHEXT, KIH + JPHEXT, KJL + JPHEXT, KJH + JPHEXT )
+
+ if ( gsplit ) then
+ if ( htype /= 'CART' ) call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //': gsplit=T not implemented for these dimensions and htype/=CART' )
+
+ if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
+ !Data is distributed between all the processes
+ tzfield%cdir = 'XY'
+
+ !Add budget time dimension
+ tzfield%ndims = 4
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write_box( tzfile, tzfield, 'BUDGET', &
+ Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ) , &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset= [ 0, 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
else
- !Data is already collected on the master process
- TZFIELD%CDIR = '--'
- CALL IO_Field_write( tzfile, tzfield, zdata3d )
+ if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
+ !Data is distributed between all the processes
+ tzfield%cdir = 'XY'
+ call IO_Field_write_box( tzfile, tzfield, 'BUDGET', zdata3d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
+ else
+ !Data is already collected on the master process
+ tzfield%cdir = '--'
+ call IO_Field_write( tzfile, tzfield, zdata3d )
+ end if
end if
deallocate( zdata3d )
+ else if ( Any ( tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) &
+ .and. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
+ tzfield%ndimlist(1) = tpfields(1)%ndimlist(1)
+ tzfield%ndimlist(2) = tpfields(1)%ndimlist(3)
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ Allocate( zdata2d(Size( pvar, 1 ), Size( pvar, 3 )) )
+
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ zdata2d(:, :) = pvar(:, 1, :, 1, 1, ji)
+
+ tzfield%cmnhname = tpfields(ji)%cmnhname
+ tzfield%cstdname = tpfields(ji)%cstdname
+ tzfield%clongname = tpfields(ji)%clongname
+ tzfield%cunits = tpfields(ji)%cunits
+ tzfield%cdir = '--'
+ tzfield%ccomment = tpfields(ji)%ccomment
+ tzfield%ngrid = tpfields(ji)%ngrid
+ tzfield%ntype = tpfields(ji)%ntype
+ tzfield%ndims = 2
+ tzfield%ltimedep = .false.
+ if ( gsplit ) then
+ !Add budget time dimension
+ tzfield%ndims = 3
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, &
+ Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ koffset= [ 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata2d )
+ end if
+ end do
+
+ Deallocate( zdata2d )
+ else if ( Any ( tpfields(1)%ndimlist(2) == [ NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) &
+ .and. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_CART_LEVEL &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
+ tzfield%ndimlist(1) = tpfields(1)%ndimlist(2)
+ tzfield%ndimlist(2) = tpfields(1)%ndimlist(3)
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ Allocate( zdata2d(Size( pvar, 2 ), Size( pvar, 3 )) )
+
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ zdata2d(:, :) = pvar(1, :, :, 1, 1, ji)
+
+ tzfield%cmnhname = tpfields(ji)%cmnhname
+ tzfield%cstdname = tpfields(ji)%cstdname
+ tzfield%clongname = tpfields(ji)%clongname
+ tzfield%cunits = tpfields(ji)%cunits
+ tzfield%cdir = '--'
+ tzfield%ccomment = tpfields(ji)%ccomment
+ tzfield%ngrid = tpfields(ji)%ngrid
+ tzfield%ntype = tpfields(ji)%ntype
+ tzfield%ndims = 2
+ tzfield%ltimedep = .false.
+ if ( gsplit ) then
+ !Add budget time dimension
+ tzfield%ndims = 3
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write( tzfile, tzfield, &
+ Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ koffset= [ 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata2d )
+ end if
+ end do
+
+ Deallocate( zdata2d )
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME &
@@ -1257,13 +1527,24 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(1)%ntype
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write( tzfile, tzfield, zdata3d )
+ if ( gsplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+ call IO_Field_write( tzfile, tzfield, zdata3d(:,:,:), koffset= [ 0, ( nbutshift - 1 ) * nbusubwrite, 0 ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata3d )
+ end if
deallocate( zdata3d )
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( nles_masks /= Size( pvar, 6 ) ) &
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'last dimension size of pvar is not equal to nles_masks (variable ' &
@@ -1297,6 +1578,11 @@ select case ( idims )
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_TERM ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
tzfield%ndimlist(1) = tpfields(1)%ndimlist(3)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(4)
tzfield%ndimlist(3:) = NMNHDIM_UNUSED
@@ -1325,6 +1611,11 @@ select case ( idims )
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1355,6 +1646,11 @@ select case ( idims )
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1384,6 +1680,11 @@ select case ( idims )
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1413,6 +1714,10 @@ select case ( idims )
.and. tpfields(1)%ndimlist(4) == NMNHDIM_FLYER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_FLYER_PROC ) then
!Correspond to FLYER_DIACHRO
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
!Create local time dimension
if ( isp == tzfile%nmaster_rank) then
@@ -1449,6 +1754,10 @@ select case ( idims )
.and. tpfields(1)%ndimlist(4) == NMNHDIM_PROFILER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_PROFILER_PROC ) then
!Correspond to PROFILER_DIACHRO_n
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
tzfield%ndimlist(1) = tpfields(1)%ndimlist(3)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(4)
@@ -1478,6 +1787,10 @@ select case ( idims )
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to PROFILER_DIACHRO_n
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
tzfield%ndimlist(1) = tpfields(1)%ndimlist(3)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(4)
@@ -1507,6 +1820,10 @@ select case ( idims )
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to PROFILER_DIACHRO_n
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
tzfield%ndimlist(1) = tpfields(1)%ndimlist(1)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(4)
@@ -1566,15 +1883,41 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(ji)%ntype
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
- !Data is distributed between all the processes
- TZFIELD%CDIR = 'XY'
- CALL IO_Field_write_BOX( tzfile, tzfield, 'BUDGET', zdata3d, &
- KIL + JPHEXT, KIH + JPHEXT, KJL + JPHEXT, KJH + JPHEXT )
+
+ if ( gsplit ) then
+ if ( htype /= 'CART' ) call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented for these dimensions and htype/=CART' )
+
+ if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
+ !Data is distributed between all the processes
+ tzfield%cdir = 'XY'
+
+ !Add budget time dimension
+ tzfield%ndims = 4
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ call IO_Field_write_box( tzfile, tzfield, 'BUDGET', &
+ Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ) , &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset= [ 0, 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
else
- !Data is already collected on the master process
- TZFIELD%CDIR = '--'
- CALL IO_Field_write( tzfile, tzfield, zdata3d )
+ if ( htype == 'CART' .and. .not. oicp .and. .not. ojcp ) then
+ !Data is distributed between all the processes
+ tzfield%cdir = 'XY'
+ call IO_Field_write_box( tzfile, tzfield, 'BUDGET', zdata3d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
+ else
+ !Data is already collected on the master process
+ tzfield%cdir = '--'
+ call IO_Field_write( tzfile, tzfield, zdata3d )
+ end if
end if
end do
@@ -1607,7 +1950,14 @@ select case ( idims )
TZFIELD%NTYPE = tpfields(ji)%ntype
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write( tzfile, tzfield, zdata3d )
+ if ( gsplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+! call IO_Field_partial_write( tzfile, tzfield, zdata3d(:,:,:), koffset= [ 0, ( nbutshift - 1 ) * nbusubwrite, 0 ] )
+ call IO_Field_write( tzfile, tzfield, zdata3d(:,:,:), koffset= [ 0, ( nbutshift - 1 ) * nbusubwrite, 0 ] )
+ else
+ call IO_Field_write( tzfile, tzfield, zdata3d )
+ end if
end do
deallocate( zdata3d )
@@ -1616,6 +1966,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( nles_masks /= Size( pvar, 6 ) ) &
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'last dimension size of pvar is not equal to nles_masks (variable ' &
@@ -1651,6 +2006,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_TERM ) then
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
tzfield%ndimlist(1) = tpfields(1)%ndimlist(3)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(4)
tzfield%ndimlist(3) = tpfields(1)%ndimlist(5)
@@ -1682,6 +2042,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
!Correspond to LES_DIACHRO_SPEC
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1714,6 +2079,11 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
!Correspond to LES_DIACHRO_SPEC
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
@@ -1750,6 +2120,11 @@ select case ( idims )
! case (6)
case default
+ if ( gsplit ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( hgroup ) //' gsplit=T not implemented' )
+ end if
+
if ( All( tpfields(1)%ndimlist(:) /= NMNHDIM_UNKNOWN ) ) then
tzfield%ndimlist(1) = tpfields(1)%ndimlist(1)
tzfield%ndimlist(2) = tpfields(1)%ndimlist(2)
--
GitLab