Newer
Older
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_TERM ) then
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
WAUTELET Philippe
committed
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(5) == NMNHDIM_BUDGET_LES_SV ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
WAUTELET Philippe
committed
else if ( tpfields(1)%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI &
.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 ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 3, 4 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( tpfields(1)%ndimlist(2) == NMNHDIM_SPECTRA_2PTS_NJ &
.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 ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2, 3, 4 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_FLYER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_FLYER_PROC ) then
!Correspond to FLYER_DIACHRO
!Create local time dimension
if ( isp == tzfile%nmaster_rank) then
istatus = NF90_DEF_DIM( igrpid, 'time_flyer', Size( pvar, 4), idimid )
if ( istatus /= NF90_NOERR ) &
call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_DIM', Trim( tpfields(1)%cmnhname ) )
end if
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_PROFILER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_PROFILER_PROC ) then
!Correspond to PROFILER_DIACHRO_n
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
WAUTELET Philippe
committed
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to PROFILER_DIACHRO_n
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(1) == NMNHDIM_NI .or. tpfields(1)%ndimlist(1) == NMNHDIM_NI_U ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to PROFILER_DIACHRO_n
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 4 ], gsplit, gdistributed )
else if ( ( tpfields(1)%ndimlist(2) == NMNHDIM_NJ .or. tpfields(1)%ndimlist(2) == NMNHDIM_NJ_U ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 2, 4 ], gsplit, gdistributed )
end do
WAUTELET Philippe
committed
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_MASK_NBUMASK &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
WAUTELET Philippe
committed
! Loop on the processes
WAUTELET Philippe
committed
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 4, 5 ], gsplit, gdistributed )
WAUTELET Philippe
committed
end do
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
end if
case (4)
WAUTELET Philippe
committed
if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) &
.and. Any( tpfields(1)%ndimlist(2) == [ NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) &
.and. Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_BUDGET_CART_LEVEL,NMNHDIM_BUDGET_CART_LEVEL_W ] ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
!Correspond to Store_one_budget (CART)
! Loop on the processes
WAUTELET Philippe
committed
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
WAUTELET Philippe
committed
elseif ( ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL_W ) &
WAUTELET Philippe
committed
.and. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_MASK_NBUMASK &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
!Correspond to Store_one_budget (MASK)
! Loop on the processes
WAUTELET Philippe
committed
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
WAUTELET Philippe
committed
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(5) == NMNHDIM_BUDGET_LES_SV &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
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 ' &
// Trim( tpfields(1)%cmnhname ) // ')' )
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
WAUTELET Philippe
committed
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(5) == NMNHDIM_BUDGET_LES_SV &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_TERM ) then
WAUTELET Philippe
committed
! Loop on the processes
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
WAUTELET Philippe
committed
else if ( tpfields(1)%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI &
.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 ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
!Correspond to LES_DIACHRO_SPEC
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 3, 4, 5 ], gsplit, gdistributed )
WAUTELET Philippe
committed
else if ( tpfields(1)%ndimlist(2) == NMNHDIM_SPECTRA_SPEC_NJ &
.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 ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
!Correspond to LES_DIACHRO_SPEC
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2, 3, 4, 5 ], gsplit, gdistributed )
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
end if
! case (5)
! case (6)
case default
do ji = 1, Size( pvar, 6 )
WAUTELET Philippe
committed
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3, 4, 5 ], &
WAUTELET Philippe
committed
gsplit, gdistributed )
WAUTELET Philippe
committed
end select
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
!Write X and Y position of the flyer
if ( Present( tpflyer ) ) then
if ( lcartesian ) then
ystdnameprefix = 'plane'
else
ystdnameprefix = 'projection'
endif
tzfield%cmnhname = 'X'
tzfield%cstdname = Trim( ystdnameprefix ) // '_x_coordinate'
tzfield%clongname = 'x-position of the flyer'
tzfield%cunits = 'm'
tzfield%cdir = '--'
tzfield%ccomment = ''
tzfield%ngrid = 0
tzfield%ntype = TYPEREAL
tzfield%ltimedep = .false.
tzfield%ndims = 1
tzfield%ndimlist(1) = NMNHDIM_FLYER_TIME
tzfield%ndimlist(2:) = NMNHDIM_UNUSED
call IO_Field_write( tzfile, tzfield, tpflyer%x )
tzfield%cmnhname = 'Y'
tzfield%cstdname = Trim( ystdnameprefix ) // '_y_coordinate'
tzfield%clongname = 'y-position of the flyer'
call IO_Field_write( tzfile, tzfield, tpflyer%y )
end if
!Restore id of the file root group ('/' group)
tzfile%nncid = isavencid
end subroutine Write_diachro_nc4
WAUTELET Philippe
committed
WAUTELET Philippe
committed
subroutine Diachro_one_field_write_nc4( tpfile, tpfield, htype, pvar, kdims, osplit, odistributed, kil, kih, kjl, kjh, kkl, kkh )
use modd_budget, only: nbutshift, nbusubwrite
use modd_field, only: tfielddata, tfield_metadata_base
use modd_io, only: isp, tfiledata
use modd_parameters, only: jphext
WAUTELET Philippe
committed
WAUTELET Philippe
committed
use mode_io_field_write, only: IO_Field_create, IO_Field_write, IO_Field_write_box
WAUTELET Philippe
committed
WAUTELET Philippe
committed
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
type(tfiledata), intent(in) :: tpfile !File to write
class(tfield_metadata_base), intent(in) :: tpfield
character(len=*), intent(in) :: htype
real, dimension(:,:,:,:,:,:), intent(in) :: pvar
integer, dimension(:), intent(in) :: kdims !List of indices of dimensions to use
logical, intent(in) :: osplit
logical, intent(in) :: odistributed !.T. if data is distributed among all processes
integer, intent(in), optional :: kil, kih
integer, intent(in), optional :: kjl, kjh
integer, intent(in), optional :: kkl, kkh
integer :: idims
integer :: ibutimepos
integer :: ji
integer, dimension(size(shape(pvar))) :: isizes_alldims
integer, dimension(:), allocatable :: ioffset
integer, dimension(:), allocatable :: isizes
real :: zdata0d
real, dimension(:), allocatable :: zdata1d
real, dimension(:,:), allocatable :: zdata2d
real, dimension(:,:,:), allocatable :: zdata3d
real, dimension(:,:,:,:), allocatable :: zdata4d
real, dimension(:,:,:,:,:), allocatable :: zdata5d
type(tfielddata) :: tzfield
WAUTELET Philippe
committed
idims = Size( kdims )
if ( odistributed ) then
WAUTELET Philippe
committed
if ( idims /= 2 .and. idims /= 3 ) &
WAUTELET Philippe
committed
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'odistributed=.true. not allowed for dims/=3, field: ' //Trim( tzfield%cmnhname ) )
if ( htype /= 'CART' ) &
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'odistributed=.true. not allowed for htype/=CART, field: ' //Trim( tzfield%cmnhname ) )
end if
if ( osplit ) then
if ( idims > 3 ) &
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'osplit=.true. not allowed for dims>3, field: ' //Trim( tzfield%cmnhname ) )
if ( htype /= 'CART' .and. htype /= 'MASK' ) &
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'osplit=.true. not allowed for htype/=CART and /=MASK, field: ' //Trim( tzfield%cmnhname ) )
end if
Allocate( isizes(idims) )
isizes_alldims = 1
do ji = 1, idims
isizes(ji) = Size( pvar, kdims(ji) )
isizes_alldims(kdims(ji)) = isizes(ji)
end do
call Prepare_diachro_write( tpfield, tzfield, kdims, osplit, odistributed, ibutimepos )
NDIMS: select case( idims )
case ( 0 ) NDIMS
zdata0d = pvar(1, 1, 1, 1, 1, 1)
if ( osplit ) then
!Create the metadata of the field (has to be done only once)
if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
call IO_Field_write( tpfile, tzfield, [ zdata0d ], koffset= [ ( nbutshift - 1 ) * nbusubwrite ] )
else
call IO_Field_write( tpfile, tzfield, zdata0d )
end if
case ( 1 ) NDIMS
! Copy selected dimensions into zdata (+ auto-allocate it)
zdata1d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
isizes(1:1) )
if ( osplit ) then
!Create the metadata of the field (has to be done only once)
if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
Allocate( ioffset( tzfield%ndims ) )
ioffset(:) = 0
ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, zdata1d(:), koffset = ioffset )
else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, Reshape( zdata1d, [ Size(zdata1d,1), 1 ] ), &
koffset = ioffset )
else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'probable bug for ' //Trim( tzfield%cmnhname ) )
end if
else !.not. osplit
call IO_Field_write( tpfile, tzfield, zdata1d )
end if
case ( 2 ) NDIMS
! Copy selected dimensions into zdata (+ auto-allocate it)
zdata2d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
isizes(1:2) )
if ( osplit ) then
!Create the metadata of the field (has to be done only once)
if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
Allocate( ioffset( tzfield%ndims ) )
ioffset(:) = 0
ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
WAUTELET Philippe
committed
if ( odistributed ) then
if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
zdata2d, &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset )
else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset )
else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'probable bug for ' //Trim( tzfield%cmnhname ) )
end if
WAUTELET Philippe
committed
else
WAUTELET Philippe
committed
!Data is already collected on the master process
if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, zdata2d(:,:), koffset = ioffset )
else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
koffset = ioffset )
else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'probable bug for ' //Trim( tzfield%cmnhname ) )
end if
WAUTELET Philippe
committed
end if
else !.not. osplit
WAUTELET Philippe
committed
if ( odistributed ) then
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', zdata2d, &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
else
!Data is already collected on the master process
call IO_Field_write( tpfile, tzfield, zdata2d )
end if
WAUTELET Philippe
committed
end if
case ( 3 ) NDIMS
! Copy selected dimensions into zdata (+ auto-allocate it)
zdata3d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
isizes(1:3) )
if ( osplit ) then
!Create the metadata of the field (has to be done only once)
if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
Allocate( ioffset( tzfield%ndims ) )
ioffset(:) = 0
ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
if ( odistributed ) then
if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write
WAUTELET Philippe
committed
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
zdata3d, &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset )
WAUTELET Philippe
committed
else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write
WAUTELET Philippe
committed
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ), &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset )
WAUTELET Philippe
committed
else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
WAUTELET Philippe
committed
'probable bug for ' //Trim( tzfield%cmnhname ) )
WAUTELET Philippe
committed
end if
else
!Data is already collected on the master process
if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, zdata3d(:,:,:), koffset = ioffset )
else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write
call IO_Field_write( tpfile, tzfield, Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ), &
koffset = ioffset )
else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
WAUTELET Philippe
committed
'probable bug for ' //Trim( tzfield%cmnhname ) )
WAUTELET Philippe
committed
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
end if
end if
else !.not. osplit
if ( odistributed ) then
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', zdata3d, &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
else
!Data is already collected on the master process
call IO_Field_write( tpfile, tzfield, zdata3d )
end if
end if
case ( 4 ) NDIMS
! Copy selected dimensions into zdata (+ auto-allocate it)
zdata4d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
isizes(1:4) )
call IO_Field_write( tpfile, tzfield, zdata4d )
case ( 5 ) NDIMS
! Copy selected dimensions into zdata (+ auto-allocate it)
zdata5d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
isizes(1:5) )
call IO_Field_write( tpfile, tzfield, zdata5d )
case default NDIMS
call Print_msg( NVERB_ERROR, 'IO', 'Diachro_one_field_write_nc4', Trim( tpfile%cname ) // &
': unsupported number of dimensions' )
return
end select NDIMS
end subroutine Diachro_one_field_write_nc4
subroutine Prepare_diachro_write( tpfieldin, tpfieldout, kdims, osplit, odistributed, kbutimepos )
use modd_field, only: NMNHDIM_BUDGET_TIME, NMNHDIM_UNUSED, NMNHMAXDIMS, tfielddata, tfield_metadata_base
WAUTELET Philippe
committed
class(tfield_metadata_base), intent(in) :: tpfieldin
type(tfielddata), intent(out) :: tpfieldout
integer, dimension(:), intent(in) :: kdims ! List of indices of dimensions to use
WAUTELET Philippe
committed
logical, intent(in) :: osplit
logical, intent(in) :: odistributed ! .true. if data is distributed among all the processes
integer, intent(out) :: kbutimepos
WAUTELET Philippe
committed
integer :: idims
WAUTELET Philippe
committed
integer :: jdim
WAUTELET Philippe
committed
idims = Size( kdims )
if ( idims > NMNHMAXDIMS ) call Print_msg( NVERB_FATAL, 'IO', 'Prepare_diachro_write', &
'kdims is too big for ' //Trim( tpfieldin%cmnhname ) )
tpfieldout%cmnhname = tpfieldin%cmnhname
tpfieldout%cstdname = tpfieldin%cstdname
tpfieldout%clongname = tpfieldin%clongname
tpfieldout%cunits = tpfieldin%cunits
WAUTELET Philippe
committed
if ( .not. odistributed ) then
tpfieldout%cdir = '--'
else
tpfieldout%cdir = 'XY'
end if
WAUTELET Philippe
committed
tpfieldout%ccomment = tpfieldin%ccomment
tpfieldout%ngrid = tpfieldin%ngrid
tpfieldout%ntype = tpfieldin%ntype
tpfieldout%ltimedep = .false.
tpfieldout%ndims = idims
do jdim = 1, idims
tpfieldout%ndimlist(jdim) = tpfieldin%ndimlist(kdims(jdim))
end do
tpfieldout%ndimlist(idims + 1:) = NMNHDIM_UNUSED
WAUTELET Philippe
committed
kbutimepos = -1
WAUTELET Philippe
committed
!Add budget time dimension if required
WAUTELET Philippe
committed
if ( osplit ) then
do jdim = 1, idims
if ( tpfieldout%ndimlist(jdim) == NMNHDIM_BUDGET_TIME ) then
kbutimepos = jdim
exit
end if
end do
!budget time dimension was not found => add it
if ( kbutimepos == -1 ) then
idims = idims + 1
if ( idims > NMNHMAXDIMS ) call Print_msg( NVERB_FATAL, 'IO', 'Prepare_diachro_write', &
'impossible to add NMNHDIM_BUDGET_TIME dimension for ' //Trim( tpfieldin%cmnhname ) )
kbutimepos = idims
tpfieldout%ndims = idims
tpfieldout%ndimlist(idims) = NMNHDIM_BUDGET_TIME
WAUTELET Philippe
committed
end if
end if
WAUTELET Philippe
committed
WAUTELET Philippe
committed
end subroutine Prepare_diachro_write
end module mode_write_diachro