Skip to content
Snippets Groups Projects
Commit d81484ab authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 28/01/2021: budgets: add support for 2D distributed arrays in Diachro_one_field_write_nc4 

(needed if LBU_KCP=T, LBU_ICP=F and LBU_JCP=F for CART budgets)
parent e2de4df2
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/write_diachro.f90
+ 51
− 23
View file @ d81484ab
...@@ -890,7 +890,8 @@ select case ( idims ) ...@@ -890,7 +890,8 @@ select case ( idims )
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) ) then NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', & if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' ) 'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
call Diachro_one_field_write_nc4( tzfile, tpfields(1), htype, pvar, [ 1, 2 ], gsplit, gdistributed ) call Diachro_one_field_write_nc4( tzfile, tpfields(1), htype, pvar, [ 1, 2 ], gsplit, gdistributed, &
kil, kih, kjl, kjh, kkl, kkh )
else if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_NI, NMNHDIM_NI_U, NMNHDIM_NI_V, NMNHDIM_BUDGET_CART_NI, & else if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_NI, NMNHDIM_NI_U, NMNHDIM_NI_V, NMNHDIM_BUDGET_CART_NI, &
NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) & NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) &
.and. Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, & .and. Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, &
...@@ -983,7 +984,8 @@ select case ( idims ) ...@@ -983,7 +984,8 @@ select case ( idims )
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes ! Loop on the processes
do ji = 1, Size( pvar, 6 ) do ji = 1, Size( pvar, 6 )
call Diachro_one_field_write_nc4( tzfile, tpfields(ji), htype, pvar(:,:,:,:,:,ji:ji), [ 1, 2 ], gsplit, gdistributed ) call Diachro_one_field_write_nc4( tzfile, tpfields(ji), htype, pvar(:,:,:,:,:,ji:ji), [ 1, 2 ], gsplit, gdistributed, &
kil, kih, kjl, kjh, kkl, kkh )
end do end do
else if ( Any ( tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) & 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(3) == NMNHDIM_BUDGET_CART_LEVEL &
...@@ -1264,7 +1266,7 @@ type(tfielddata) :: tzfield ...@@ -1264,7 +1266,7 @@ type(tfielddata) :: tzfield
idims = Size( kdims ) idims = Size( kdims )
if ( odistributed ) then if ( odistributed ) then
if ( idims /= 3 ) & if ( idims /= 2 .and. idims /= 3 ) &
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', & call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'odistributed=.true. not allowed for dims/=3, field: ' //Trim( tzfield%cmnhname ) ) 'odistributed=.true. not allowed for dims/=3, field: ' //Trim( tzfield%cmnhname ) )
...@@ -1350,19 +1352,45 @@ NDIMS: select case( idims ) ...@@ -1350,19 +1352,45 @@ NDIMS: select case( idims )
ioffset(:) = 0 ioffset(:) = 0
ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
if ( tzfield%ndims == idims ) then if ( odistributed ) then
!No time dimension was added in Prepare_diachro_write if ( tzfield%ndims == idims ) then
call IO_Field_write( tpfile, tzfield, zdata2d(:,:), koffset = ioffset ) !No time dimension was added in Prepare_diachro_write
else if ( tzfield%ndims == ( idims + 1 ) ) then call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
!A time dimension was added in Prepare_diachro_write zdata2d, &
call IO_Field_write( tpfile, tzfield, Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), & kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset ) 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
else else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', & !Data is already collected on the master process
'probable bug for ' //Trim( tzfield%cmnhname ) ) 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
end if end if
else !.not. osplit else !.not. osplit
call IO_Field_write( tpfile, tzfield, zdata2d ) 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
end if end if
...@@ -1383,19 +1411,19 @@ NDIMS: select case( idims ) ...@@ -1383,19 +1411,19 @@ NDIMS: select case( idims )
if ( odistributed ) then if ( odistributed ) then
if ( tzfield%ndims == idims ) then if ( tzfield%ndims == idims ) then
!No time dimension was added in Prepare_diachro_write !No time dimension was added in Prepare_diachro_write
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', & call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
zdata3d, & zdata3d, &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, & kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset ) koffset = ioffset )
else if ( tzfield%ndims == ( idims + 1 ) ) then else if ( tzfield%ndims == ( idims + 1 ) ) then
!A time dimension was added in Prepare_diachro_write !A time dimension was added in Prepare_diachro_write
call IO_Field_write_box( tpfile, tzfield, 'BUDGET', & call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ) , & Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ), &
kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, & kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
koffset = ioffset ) koffset = ioffset )
else else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', & call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'probable bug for ' //Trim( tzfield%cmnhname ) ) 'probable bug for ' //Trim( tzfield%cmnhname ) )
end if end if
else else
!Data is already collected on the master process !Data is already collected on the master process
...@@ -1408,7 +1436,7 @@ NDIMS: select case( idims ) ...@@ -1408,7 +1436,7 @@ NDIMS: select case( idims )
koffset = ioffset ) koffset = ioffset )
else else
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', & call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'probable bug for ' //Trim( tzfield%cmnhname ) ) 'probable bug for ' //Trim( tzfield%cmnhname ) )
end if end if
end if end if
else !.not. osplit else !.not. osplit
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme