diff --git a/src/MNH/mode_les_diachro.f90 b/src/MNH/mode_les_diachro.f90
index 0918a7266e0e3b1bf0fa36fac9c79f13e6b239ce..8b387678a8f611eb016ceb8e673e23203e533731 100644
--- a/src/MNH/mode_les_diachro.f90
+++ b/src/MNH/mode_les_diachro.f90
@@ -512,9 +512,10 @@ END SUBROUTINE LES_TIME_AVG
!------------------------------------------------------------------------------
!
!########################################################
-subroutine Les_diachro_gen(tpdiafile,hgroup,hcomment,hunit,pfield,havg, htitle, osurf, osv )
+subroutine Les_diachro_gen(tpdiafile, hgroup, hcomment, hunit, pfield, havg, htitle, osurf, osv )
!########################################################
+use modd_field, only: NMNHDIM_UNKNOWN, tfield_metadata_base, TYPEREAL
use modd_io, only: tfiledata
use modd_les, only: nles_current_iinf, nles_current_isup, nles_current_jinf, nles_current_jsup, nles_current_times, &
nles_k, nles_levels, xles_current_z, xles_temp_mean_start, xles_temp_mean_end
@@ -562,6 +563,7 @@ real, dimension(size(pfield,1),size(pfield,2),size(pfield,3),size(
:: zfield ! Normalized field
real, dimension(:,:,:,:,:,:), allocatable :: zwork6 ! Contains physical field
type(date_time), dimension(:), allocatable :: tzdates
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!------------------------------------------------------------------------------
if ( present( osurf ) .and. present ( htitle ) ) then
@@ -661,12 +663,29 @@ else
end if
! Write the profile
-if ( iresp==0 .and. ( gsurf .or. any( zwork6 /= xundef ) ) ) &
- call write_diachro( tpdiafile, ygroup, "ssol", igrid, tzdates, &
- zwork6, ytitle, yunit, ycomment, &
- oicp = .false., ojcp = .false., okcp = .false., &
- kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh, &
- ptrajx = ztrajx, ptrajy = ztrajy, ptrajz = ztrajz )
+if ( iresp==0 .and. ( gsurf .or. any( zwork6 /= xundef ) ) ) then
+ allocate( tzfields( Size( pfield, 3 ) ) )
+
+ tzfields(:)%cmnhname = ytitle(:)
+ tzfields(:)%cstdname = ''
+ tzfields(:)%clongname = ytitle(:)
+ tzfields(:)%cunits = yunit(:)
+ tzfields(:)%ccomment = ycomment(:)
+ tzfields(:)%ngrid = igrid
+ tzfields(:)%ntype = TYPEREAL
+ tzfields(:)%ndims = 6
+ do jp = 1, Size( tzfields )
+ tzfields(jp)%ndimlist(:) = NMNHDIM_UNKNOWN
+ end do
+
+ call Write_diachro( tpdiafile, tzfields, ygroup, "SSOL", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh, &
+ ptrajx = ztrajx, ptrajy = ztrajy, ptrajz = ztrajz )
+
+ deallocate( tzfields )
+end if
!-------------------------------------------------------------------------------
end subroutine Les_diachro_gen
@@ -803,6 +822,7 @@ call Les_diachro_gen( tpdiafile, hgroup, [ hcomment ], hunit,
!-------------------------------------------------------------------------------
END SUBROUTINE LES_DIACHRO_SURF_SV
!-------------------------------------------------------------------------------
+
!#####################################################################
SUBROUTINE LES_DIACHRO_2PT(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELDX,PFIELDY,HAVG)
!#####################################################################
@@ -811,12 +831,13 @@ SUBROUTINE LES_DIACHRO_2PT(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELDX,PFIELDY,HAVG)
!
!
USE MODD_CONF
+use modd_field, only: NMNHDIM_UNKNOWN, tfield_metadata_base, TYPEREAL
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
use modd_type_date, only: date_time
-USE MODE_WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -839,8 +860,6 @@ CHARACTER(LEN= 10) :: YGROUP ! group title
CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-REAL, DIMENSION(SIZE(PFIELDX,1),SIZE(PFIELDX,2)) :: ZAVG_FIELDX
-REAL, DIMENSION(SIZE(PFIELDY,1),SIZE(PFIELDY,2)) :: ZAVG_FIELDY
INTEGER :: JT ! time counter
INTEGER :: JK ! level counter
INTEGER :: IRESP ! return code
@@ -854,6 +873,7 @@ CHARACTER(len=6) :: YSTRING
!
LOGICAL :: GAVG ! flag to compute time averagings
type(date_time), dimension(:), allocatable :: tzdates
+type(tfield_metadata_base) :: tzfield
!-------------------------------------------------------------------------------
!
IF (HAVG/=' '.AND. HAVG/='A') RETURN
@@ -906,11 +926,22 @@ END IF
!* 2.0 Writing of the profile
! ----------------------
!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+if ( iresp == 0 ) then
+ tzfield%cmnhname = ytitle(1)
+ tzfield%cstdname = ''
+ tzfield%clongname = ytitle(1)
+ tzfield%cunits = yunit(1)
+ tzfield%ccomment = ycomment(1)
+ tzfield%ngrid = igrid(1)
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 6
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+ call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
+end if
!
!
deallocate( tzdates )
@@ -948,10 +979,20 @@ IF (GAVG) THEN
YGROUP = 'T_'//YGROUP
END IF
!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+tzfield%cmnhname = ytitle(1)
+tzfield%cstdname = ''
+tzfield%clongname = ytitle(1)
+tzfield%cunits = yunit(1)
+tzfield%ccomment = ycomment(1)
+tzfield%ngrid = igrid(1)
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 6
+tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
!
DEALLOCATE(ZWORK6)
deallocate( tzdates )
@@ -967,12 +1008,13 @@ SUBROUTINE LES_DIACHRO_SPEC(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PSPECTRAX,PSPECTRAY)
!
!
USE MODD_CONF
+use modd_field, only: NMNHDIM_UNKNOWN, tfield_metadata_base, TYPEREAL
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
use modd_type_date, only: date_time
-USE MODE_WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -1006,6 +1048,7 @@ CHARACTER(len=6) :: YSTRING
INTEGER :: JT ! time counter
INTEGER :: JK ! level counter
type(date_time), dimension(:), allocatable :: tzdates
+type(tfield_metadata_base) :: tzfield
!
!-------------------------------------------------------------------------------
!
@@ -1046,10 +1089,20 @@ WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAX )
YCOMMENT(:) = " DOMEGAX="//YSTRING//' '//HCOMMENT
!
!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+tzfield%cmnhname = ytitle(1)
+tzfield%cstdname = ''
+tzfield%clongname = ytitle(1)
+tzfield%cunits = yunit(1)
+tzfield%ccomment = ycomment(1)
+tzfield%ngrid = igrid(1)
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 6
+tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
!
!
!* time average
@@ -1058,11 +1111,23 @@ IRESP=0
CALL LES_TIME_AVG( ZWORK6, tzdates, IRESP )
YGROUP = 'T_'//YGROUP
!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+if ( iresp == 0 ) then
+ tzfield%cmnhname = ytitle(1)
+ tzfield%cstdname = ''
+ tzfield%clongname = ytitle(1)
+ tzfield%cunits = yunit(1)
+ tzfield%ccomment = ycomment(1)
+ tzfield%ngrid = igrid(1)
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 6
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+ call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
+end if
+
DEALLOCATE(ZWORK6)
deallocate( tzdates )
!
@@ -1093,10 +1158,20 @@ YTITLE(:) = YGROUP
WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAY )
YCOMMENT(:) = " DOMEGAY="//YSTRING//' '//HCOMMENT
!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+tzfield%cmnhname = ytitle(1)
+tzfield%cstdname = ''
+tzfield%clongname = ytitle(1)
+tzfield%cunits = yunit(1)
+tzfield%ccomment = ycomment(1)
+tzfield%ngrid = igrid(1)
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 6
+tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
!
!
!* time average
@@ -1104,11 +1179,22 @@ CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates,
CALL LES_TIME_AVG( ZWORK6, tzdates, IRESP )
YGROUP = 'T_'//YGROUP
!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "SPXY", IGRID, tzdates, &
- ZWORK6, YTITLE, YUNIT, YCOMMENT, &
- OICP = .FALSE., OJCP = .FALSE., OKCP = .FALSE., &
- KIL = IIL, KIH = IIH, KJL = IJL, KJH = IJH, KKL = IKL, KKH = IKH )
+if ( iresp == 0 ) then
+ tzfield%cmnhname = ytitle(1)
+ tzfield%cstdname = ''
+ tzfield%clongname = ytitle(1)
+ tzfield%cunits = yunit(1)
+ tzfield%ccomment = ycomment(1)
+ tzfield%ngrid = igrid(1)
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 6
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+ call Write_diachro( tpdiafile, [ tzfield ], ygroup, "SPXY", tzdates, &
+ zwork6, &
+ oicp = .false., ojcp = .false., okcp = .false., &
+ kil = iil, kih = iih, kjl = ijl, kjh = ijh, kkl = ikl, kkh = ikh )
+end if
!
DEALLOCATE(ZWORK6)
deallocate( tzdates )
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index af24818337d91b9961abf47ad23d5591d29a0106..a5bb3358805c939f552579461d4e5a0595e7b002 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -62,11 +62,12 @@ END MODULE MODI_WRITE_AIRCRAFT_BALLOON
!! aircraft, ballon and profiler
!! Oct 2016 : G.Delautier LIMA
!! August 2016 (M.Leriche) Add mass concentration of aerosol species
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 29/01/2019: bug: moved an instruction later (to prevent access to a not allocated array)
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! P. Wautelet 02/10/2020: bugfix: YGROUP/YGROUPZ were too small
! P. Wautelet 09/10/2020: bugfix: correction on IPROCZ when not LIMA (condition was wrong)
+! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -101,7 +102,7 @@ USE MODD_PARAM_LIMA , ONLY: NINDICE_CCN_IMM,NMOD_CCN,NMOD_IFN,NMOD_IMM
USE MODE_MODELN_HANDLER
USE MODE_DUST_PSD
USE MODE_AERO_PSD
-USE MODE_WRITE_DIACHRO, only: WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -170,7 +171,10 @@ CONTAINS
!----------------------------------------------------------------------------
!
SUBROUTINE FLYER_DIACHRO(TPFLYER)
-!
+
+use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_FLYER_PROC, NMNHDIM_FLYER_TIME, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+
TYPE(FLYER), INTENT(IN) :: TPFLYER
!
!* 0.2 declaration of local variables for diachro
@@ -208,6 +212,7 @@ INTEGER :: IKU, IK
CHARACTER(LEN=2) :: INDICE
INTEGER :: I
INTEGER :: JLOOP
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
!
@@ -839,14 +844,52 @@ ALLOCATE (ZWZ6(1,1,IKU,size(tpflyer%tpdates),1,JPROCZ))
ZWZ6 = ZWORKZ6(:,:,:,:,:,:JPROCZ)
DEALLOCATE(ZWORKZ6)
!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "RSPL", IGRID, tpflyer%tpdates, &
- ZW6, YTITLE(:), YUNIT(:), YCOMMENT(:), &
- PTRAJX = ZTRAJX, PTRAJY = ZTRAJY, PTRAJZ = ZTRAJZ )
-!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUPZ, "CART", IGRIDZ, tpflyer%tpdates, &
- ZWZ6, YTITLEZ(:), YUNITZ(:), YCOMMENTZ(:), &
- OICP = .TRUE., OJCP = .TRUE., OKCP = .FALSE., &
- KIL = 1, KIH = 1, KJL = 1, KJH = 1, KKL = 1, KKH = IKU )
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ytitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitle(1 : jproc)
+tzfields(:)%cunits = yunit(1 : jproc)
+tzfields(:)%ccomment = ycomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
+
+call Write_diachro( tpdiafile, tzfields, ygroup, "RSPL", tpflyer%tpdates, &
+ zw6, &
+ ptrajx = ztrajx, ptrajy = ztrajy, ptrajz = ztrajz )
+
+deallocate( tzfields )
+
+allocate( tzfields( jprocz ) )
+
+tzfields(:)%cmnhname = ytitlez(1 : jprocz)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitlez(1 : jprocz)
+tzfields(:)%cunits = yunitz(1 : jprocz)
+tzfields(:)%ccomment = ycommentz(1 : jprocz)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 3
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
+tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
+
+call Write_diachro( tpdiafile, tzfields, ygroupz, "CART", tpflyer%tpdates, &
+ zwz6, &
+ oicp = .true., ojcp = .true., okcp = .false., &
+ kil = 1, kih = 1, kjl = 1, kjh = 1, kkl = 1, kkh = iku )
+
+deallocate( tzfields )
DEALLOCATE (ZTRAJX)
DEALLOCATE (ZTRAJY)
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index a160a54bbfd57809e09d83e3adf0197281a5af24..69158b6704d97cbc351845a4e3cfbaa8c28a1744 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -30,6 +30,7 @@
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! 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
!-----------------------------------------------------------------
!#######################
@@ -353,6 +354,12 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
nbumask, nbuwrnb, &
tburhodata, &
NBUDGET_RHO, NBUDGET_U, NBUDGET_V, NBUDGET_W
+ use modd_field, only: NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NI_U, &
+ NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NI_V, NMNHDIM_BUDGET_CART_NJ_V, &
+ NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_TIME, NMNHDIM_BUDGET_MASK_NBUMASK, &
+ NMNHDIM_UNUSED, NMNHDIM_UNKNOWN
use modd_io, only: tfiledata
use modd_lunit_n, only: tluout
use modd_parameters, only: XNEGUNDEF
@@ -373,12 +380,9 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
logical, intent(in) :: knocompress ! compression for the cart option
real, dimension(:,:,:,:,:,:), allocatable, intent(out) :: prhodjn
- character(len=4) :: ybutype
- character(len=9) :: ygroup_name ! group name
- character(len=99), dimension(:), allocatable :: ybucomment ! comment
- character(len=100), dimension(:), allocatable :: yworkcomment ! comment
- character(len=100), dimension(:), allocatable :: yworkunit ! comment
- integer, dimension(:), allocatable :: iworkgrid ! grid label
+ character(len=4) :: ybutype
+ character(len=9) :: ygroup_name
+ type(tburhodata) :: tzfield
call Print_msg( NVERB_DEBUG, 'BUD', 'Store_one_budget_rho', 'called for '//trim( tprhodj%cmnhname ) )
@@ -387,36 +391,28 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
! pburhodj storage
select case ( cbutype )
case( 'CART', 'SKIP' )
+ !Set to CART for all processes even if has no data(='SKIP')
+ !Necessary to do the call and the collective write later (if knocompress)
ybutype = 'CART'
- if ( knocompress ) then
- allocate( prhodjn(nbuimax, nbujmax, nbukmax, 1, 1, 1) ) ! local budget of RHODJU
- prhodjn(:, :, :, 1, 1, 1) = tprhodj%xdata(:, :, :)
- else
- allocate( prhodjn(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, 1) ) ! global budget of RhodjU
- prhodjn(:,:,:,1,1,1)=End_cart_compress( tprhodj%xdata(:,:,:) )
- end if
+ if ( knocompress ) then
+ allocate( prhodjn(nbuimax, nbujmax, nbukmax, 1, 1, 1) ) ! local budget of RHODJU
+ prhodjn(:, :, :, 1, 1, 1) = tprhodj%xdata(:, :, :)
+ else
+ allocate( prhodjn(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, 1) ) ! global budget of RhodjU
+ prhodjn(:,:,:,1,1,1)=End_cart_compress( tprhodj%xdata(:,:,:) )
+ end if
case('MASK')
ybutype = 'MASK'
- allocate( prhodjn(1, 1, nbukmax, nbuwrnb, nbumask, 1) )
- prhodjn(1, 1, :, :, :, 1) = End_mask_compress( tprhodj%xdata(:, :, :) )
- where ( prhodjn(1, 1, :, :, :, 1) <= 0. )
- prhodjn(1, 1, :, :, :, 1) = XNEGUNDEF
- end where
+ allocate( prhodjn(1, 1, nbukmax, nbuwrnb, nbumask, 1) )
+ prhodjn(1, 1, :, :, :, 1) = End_mask_compress( tprhodj%xdata(:, :, :) )
+ where ( prhodjn(1, 1, :, :, :, 1) <= 0. )
+ prhodjn(1, 1, :, :, :, 1) = XNEGUNDEF
+ end where
case default
call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget_rho', 'unknown CBUTYPE' )
end select
- allocate( ybucomment(1) )
- allocate( yworkunit(1) )
- allocate( yworkcomment(1) )
- allocate( iworkgrid(1) )
-
- ybucomment(1) = tprhodj%cmnhname
- yworkunit(1) = tprhodj%cunits
- yworkcomment(1) = tprhodj%ccomment
- iworkgrid(1) = tprhodj%ngrid
-
select case( kp )
case( NBUDGET_RHO )
write( ygroup_name, fmt = "('RJS__',I4.4)" ) nbutshift
@@ -434,12 +430,76 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget_rho', 'unknown budget type' )
end select
- call Write_diachro( tpdiafile, ygroup_name, ybutype, iworkgrid, &
- tpdates, prhodjn, ybucomment, &
- yworkunit, yworkcomment, &
+ !Copy all fields from tprhodj
+ tzfield = tprhodj
+
+ !Modify metadata coming from tprhodj%tgroups
+ !ndims and ndimlist are adapted for Write_diachro
+ if ( tzfield%ngrid < 1 .or. tzfield%ngrid > 4 ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Store_one_budget_rho', 'invalid grid' )
+
+ if ( ybutype == 'CART' ) then
+ if ( .not. lbu_icp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 4 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI
+ case ( 2 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_U
+ case ( 3 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_V
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_jcp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 4 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ
+ case ( 2 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_U
+ case ( 3 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_V
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_kcp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 2, 3 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL
+ case ( 4 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL_W
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ else if ( ybutype == 'MASK' ) then
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ select case ( tzfield%ngrid )
+ case ( 1, 2, 3 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL
+ case ( 4 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL_W
+ end select
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_MASK_TIME
+ tzfield%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(6) = NMNHDIM_UNUSED
+
+ else
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+ end if
+
+ 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 )
- deallocate( ybucomment, yworkunit, yworkcomment, iworkgrid )
end subroutine Store_one_budget_rho
@@ -452,7 +512,14 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
nbumask, nbuwrnb, &
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, &
- tbudgetdata
+ tbudgetdata, tbugroupdata
+ use modd_field, only: NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NI_U, &
+ NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NI_V, NMNHDIM_BUDGET_CART_NJ_V, &
+ NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_TIME, NMNHDIM_BUDGET_MASK_NBUMASK, &
+ NMNHDIM_BUDGET_NGROUPS, NMNHDIM_UNUSED, NMNHDIM_UNKNOWN, &
+ TYPEREAL
use modd_io, only: tfiledata
use modd_lunit_n, only: tluout
use modd_parameters, only: NBUNAMELGTMAX
@@ -475,16 +542,12 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
character(len=4) :: ybutype
character(len=9) :: ygroup_name
- character(len=NBUNAMELGTMAX), dimension(:), allocatable :: ytitles
- character(len=100), dimension(:), allocatable :: yworkcomment
- character(len=100), dimension(:), allocatable :: yworkunit
integer :: igroups
integer :: jproc
integer :: jsv
- integer :: jt
- integer, dimension(:), allocatable :: iworkgrid ! grid label
real, dimension(:), allocatable :: zconvert ! unit conversion coefficient
real, dimension(:,:,:,:,:,:), allocatable :: zworkt
+ type(tbugroupdata), dimension(:), allocatable :: tzfields
call Print_msg( NVERB_DEBUG, 'BUD', 'Store_one_budget', 'called for '//trim( tpbudget%cname ) )
@@ -512,27 +575,27 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
select case ( cbutype )
case( 'CART', 'SKIP' )
ybutype = 'CART'
- if ( knocompress ) then
- allocate( zworkt(nbuimax, nbujmax, nbukmax, 1, 1, igroups ) ) ! local budget of ru
- do jproc = 1, igroups
- zworkt(:, :, :, 1, 1, jproc) = tpbudget%tgroups(jproc)%xdata(:, :, :) &
- * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
- end do
- else
- allocate( zworkt(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, igroups ) ) ! global budget of ru
-
- do jproc = 1, igroups
- zworkt(:, :, :, 1, 1, jproc) = End_cart_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) )
- zworkt(:, :, :, 1, 1, jproc) = zworkt(:, :, :, 1, 1, jproc) * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
- end do
- endif
- case('MASK')
- ybutype = 'MASK'
- allocate( zworkt(1, 1, nbukmax, nbuwrnb, nbumask, igroups ) )
+ if ( knocompress ) then
+ allocate( zworkt(nbuimax, nbujmax, nbukmax, 1, 1, igroups ) ) ! local budget of ru
do jproc = 1, igroups
- zworkt(1, 1, :, :, :, jproc) = End_mask_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) ) &
- * zconvert(jproc) / prhodjn(1, 1, :, :, :, 1)
+ zworkt(:, :, :, 1, 1, jproc) = tpbudget%tgroups(jproc)%xdata(:, :, :) &
+ * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
end do
+ else
+ allocate( zworkt(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, igroups ) ) ! global budget of ru
+
+ do jproc = 1, igroups
+ zworkt(:, :, :, 1, 1, jproc) = End_cart_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) )
+ zworkt(:, :, :, 1, 1, jproc) = zworkt(:, :, :, 1, 1, jproc) * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
+ end do
+ endif
+ case('MASK')
+ ybutype = 'MASK'
+ allocate( zworkt(1, 1, nbukmax, nbuwrnb, nbumask, igroups ) )
+ do jproc = 1, igroups
+ zworkt(1, 1, :, :, :, jproc) = End_mask_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) ) &
+ * zconvert(jproc) / prhodjn(1, 1, :, :, :, 1)
+ end do
case default
call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget', 'unknown CBUTYPE' )
@@ -540,15 +603,6 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
deallocate(zconvert)
- allocate( ytitles( igroups ) )
- allocate( yworkunit( igroups ) )
- allocate( yworkcomment( igroups ) )
- allocate( iworkgrid( igroups ) )
-
- yworkunit(:) = tpbudget%tgroups(:)%cunits
- yworkcomment(:) = tpbudget%tgroups(:)%ccomment
- iworkgrid(:) = tpbudget%tgroups(:)%ngrid
-
select case( tpbudget%nid )
case ( NBUDGET_U )
write( ygroup_name, fmt = "('UU___',I4.4)" ) nbutshift
@@ -588,28 +642,91 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
case ( NBUDGET_SV1 : )
jsv = tpbudget%nid - NBUDGET_SV1 + 1
-! yworkunit(:) = 's-1' ; yworkunit(1:3) = ' '
-! DO JT = 1, igroups
-! WRITE(yworkcomment(JT),FMT="('Budget of SVx=',I3.3)") jsv
-! END DO
write( ygroup_name, fmt = "('SV',I3.3,I4.4)") jsv, nbutshift
case default
call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget', 'unknown budget type' )
end select
+ allocate( tzfields( igroups ) )
+
+ !Copy all fields from tpbudget%tgroups
+ tzfields(:) = tpbudget%tgroups(:)
+
+ !Modify metadata coming from tpbudget%tgroups
+ !ndims and ndimlist are adapted for Write_diachro
do jproc = 1, igroups
- ytitles(jproc) = trim( tpbudget%tgroups(jproc)%cmnhname )
+ tzfields(jproc)%ndims = 4
+
+ if ( tzfields(jproc)%ngrid < 1 .or. tzfields(jproc)%ngrid > 4 ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Store_one_budget_rho', 'invalid grid' )
+
+ if ( ybutype == 'CART' ) then
+ if ( .not. lbu_icp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 4 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI
+ case ( 2 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_U
+ case ( 3 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_V
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_jcp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 4 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ
+ case ( 2 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_U
+ case ( 3 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_V
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_kcp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 2, 3 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL
+ case ( 4 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL_W
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfields(jproc)%ndimlist(4) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(5) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(6) = NMNHDIM_BUDGET_NGROUPS
+
+ else if ( ybutype == 'MASK' ) then
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_UNUSED
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 2, 3 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL
+ case ( 4 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL_W
+ end select
+ tzfields(jproc)%ndimlist(4) = NMNHDIM_BUDGET_MASK_TIME
+ tzfields(jproc)%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfields(jproc)%ndimlist(6) = NMNHDIM_BUDGET_NGROUPS
+
+ else
+ tzfields(jproc)%ndimlist(:) = NMNHDIM_UNKNOWN
+ end if
end do
- call Write_diachro( tpdiafile, ygroup_name, ybutype, iworkgrid, &
- tpdates, zworkt, ytitles, &
- yworkunit, yworkcomment, &
+ 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 )
- deallocate( zworkt, yworkunit, yworkcomment, iworkgrid )
-
end subroutine Store_one_budget
end module mode_write_budget
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 7c7bc53f7478198810296bbfa01f2a414f842704..a2fe6cec6fcd0cb8f5e653b98c7ee237b5a20bda 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -12,26 +12,27 @@ private
public :: Write_diachro
contains
-! #################################################################
- SUBROUTINE WRITE_DIACHRO(TPDIAFILE,HGROUP,HTYPE, &
- KGRID, tpdates, PVAR, &
- HTITRE,HUNITE,HCOMMENT,OICP,OJCP,OKCP,KIL,KIH,KJL,KJH,KKL,KKH, &
- PTRAJX,PTRAJY,PTRAJZ )
-! #################################################################
+
+! #########################################################################
+subroutine Write_diachro( tpdiafile, tpfields, hgroup, htype, &
+ tpdates, pvar, &
+ oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh, &
+ ptrajx, ptrajy, ptrajz )
+! #########################################################################
!
!!**** *WRITE_DIACHRO* - Ecriture d'un enregistrement dans un fichier
!! diachronique (de nom de base HGROUP)
!!
!! PURPOSE
!! -------
-!
+!
!
!!** METHOD
!! ------
!! En fait pour un groupe donne HGROUP, on ecrit systematiquement
! plusieurs enregistrements :
! - 1: HGROUP.TYPE (type d'informations a enregistrer)
-! - 2: HGROUP.DIM (dimensions de toutes les matrices a
+! - 2: HGROUP.DIM (dimensions de toutes les matrices a
! enregistrer)
! - 3: HGROUP.TITRE (Nom des processus)
! - 4: HGROUP.UNITE (Unites pour chaque processus)
@@ -64,13 +65,13 @@ contains
!! Original 08/01/96
!! Updated PM
!! Modification (N. Asencio) 18/06/99 : the two first dimensions of PMASK
-!! are linked to the horizontal grid, FMWRIT is called with 'XY' argument.
-!! In standard configuration of the budgets, the mask is written once
+!! are linked to the horizontal grid, FMWRIT is called with 'XY' argument.
+!! In standard configuration of the budgets, the mask is written once
!! outside this routine with FMWRIT call. Its record name is 'MASK_nnnn.MASK'
!! So optional PMASK is not used .
!! Modification (J. Duron) 24/06/99 : add logical GPACK to disable the pack option,
!! add the initialization of the dimensions of
-!! MASK array in MASK case with write outside the
+!! MASK array in MASK case with write outside the
!! routine.
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! D.Gazen+ G.Delautier 06/2016 modif for ncl files
@@ -80,48 +81,58 @@ contains
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget
use modd_conf, only: lpack
-use modd_field, only: tfielddata, TYPECHAR, TYPEDATE, TYPEINT, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY: JPHEXT
+use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_BUDGET_LES_MASK, NMNHDIM_FLYER_TIME, &
+ NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
+ TYPECHAR, TYPEDATE, TYPEINT, TYPEREAL, &
+ tfield_metadata_base, tfielddata
+use modd_io, only: tfiledata
+use modd_parameters, only: jphext
use modd_time, only: tdtexp, tdtseg
use modd_time_n, only: tdtmod
use modd_type_date, only: date_time
!
use mode_datetime, only: Datetime_distance
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Field_write_box
-USE MODE_ll
-use mode_menu_diachro, only: MENU_DIACHRO
+use mode_io_field_write, only: IO_Field_write, IO_Field_write_box
+use mode_ll
+use mode_menu_diachro, only: Menu_diachro
use mode_msg
!
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP, HTYPE
-INTEGER,DIMENSION(:), INTENT(IN) :: KGRID
-type(date_time), dimension(:), intent(in) :: tpdates
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVAR
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HTITRE, HUNITE, HCOMMENT
-LOGICAL, INTENT(IN),OPTIONAL :: OICP, OJCP, OKCP
-INTEGER, INTENT(IN),OPTIONAL :: KIL, KIH
-INTEGER, INTENT(IN),OPTIONAL :: KJL, KJH
-INTEGER, INTENT(IN),OPTIONAL :: KKL, KKH
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJX
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJY
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJZ
+TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
+class(tfield_metadata_base), dimension(:), intent(in) :: tpfields
+CHARACTER(LEN=*), INTENT(IN) :: HGROUP, HTYPE
+type(date_time), dimension(:), intent(in) :: tpdates
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVAR
+LOGICAL, INTENT(IN), OPTIONAL :: OICP, OJCP, OKCP
+INTEGER, INTENT(IN), OPTIONAL :: KIL, KIH
+INTEGER, INTENT(IN), OPTIONAL :: KJL, KJH
+INTEGER, INTENT(IN), OPTIONAL :: KKL, KKH
+REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJX
+REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJY
+REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTRAJZ
!
!* 0.1 Local variables
! ---------------
+integer, parameter :: LFITITLELGT = 100
+integer, parameter :: LFIUNITLGT = 100
+integer, parameter :: LFICOMMENTLGT = 100
+
CHARACTER(LEN=20) :: YCOMMENT
CHARACTER(LEN=3) :: YJ
+character(len=LFITITLELGT), dimension(:), allocatable :: ytitles !Used to respect LFI fileformat
+character(len=LFIUNITLGT), dimension(:), allocatable :: yunits !Used to respect LFI fileformat
+character(len=LFICOMMENTLGT), dimension(:), allocatable :: ycomments !Used to respect LFI fileformat
INTEGER :: ILENG, ILENTITRE, ILENUNITE, ILENCOMMENT
INTEGER :: II, IJ, IK, IT, IN, IP, J, JJ
INTEGER :: INTRAJT, IKTRAJX, IKTRAJY, IKTRAJZ
@@ -209,9 +220,9 @@ IF(HTYPE == 'MASK')THEN
IPMASK=1
ENDIF
-ILENTITRE = LEN(HTITRE)
-ILENUNITE = LEN(HUNITE)
-ILENCOMMENT = LEN(HCOMMENT)
+ILENTITRE = LFITITLELGT
+ILENUNITE = LFIUNITLGT
+ILENCOMMENT = LFICOMMENTLGT
ICOMPX=0; ICOMPY=0; ICOMPZ=0
IF ( GICP ) THEN
@@ -239,7 +250,7 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TYPE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
@@ -253,12 +264,17 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.DIM'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
SELECT CASE(HTYPE)
CASE('CART','MASK','SPXY')
+ if ( .not. Present( kil ) .or. .not. Present( kih ) .or. .not. Present( kjl ) .or. .not. Present( kjh ) &
+ .or. .not. Present( kkl ) .or. .not. Present( kkh ) ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro', &
+ 'kil, kih, kjl, kjh, kkl or kkh not provided for variable ' // Trim( tpfields(1)%cmnhname ) )
+ end if
ILENG = 34
ALLOCATE(ITABCHAR(ILENG))
ITABCHAR(1)=ILENTITRE; ITABCHAR(2)=ILENUNITE
@@ -286,7 +302,7 @@ SELECT CASE(HTYPE)
CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
CASE DEFAULT
- ILENG = 25
+ ILENG = 25
ALLOCATE(ITABCHAR(ILENG))
ITABCHAR(1)=ILENTITRE; ITABCHAR(2)=ILENUNITE
ITABCHAR(3)=ILENCOMMENT; ITABCHAR(4)=II
@@ -313,11 +329,14 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TITRE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HTITRE(1:IP))
+allocate( ytitles( ip ) )
+ytitles(:) = tpfields(1 : ip)%cmnhname
+CALL IO_Field_write(TPDIAFILE,TZFIELD,ytitles(:))
+deallocate( ytitles )
!
! 4eme enregistrement UNITE
!
@@ -327,11 +346,14 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.UNITE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HUNITE(1:IP))
+allocate( yunits( ip ) )
+yunits(:) = tpfields(1 : ip)%cunits
+CALL IO_Field_write(TPDIAFILE,TZFIELD,yunits(:))
+deallocate( yunits )
!
! 5eme enregistrement COMMENT
!
@@ -341,53 +363,67 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.COMMENT'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HCOMMENT(1:IP))
+allocate( ycomments( ip ) )
+ycomments(:) = tpfields(1 : ip)%ccomment
+CALL IO_Field_write(TPDIAFILE,TZFIELD,ycomments(:))
+deallocate( ycomments )
!
! 6eme enregistrement PVAR
!
-! Dans la mesure ou cette matrice risque d'etre tres volumineuse, on ecrira un
+! Dans la mesure ou cette matrice risque d'etre tres volumineuse, on ecrira un
! enregistrement par processus
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!ocl scalar
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
DO J = 1,IP
+ if ( All( tpfields(1)%ndimlist(:) /= NMNHDIM_UNKNOWN ) ) then
+ tzfield%ndimlist(1:5) = tpfields(j)%ndimlist(1:5)
+ do jj = 1, 5
+ if ( tzfield%ndimlist(jj) == NMNHDIM_UNUSED ) then
+ tzfield%ndimlist(jj) = NMNHDIM_ONE
+ end if
+ end do
+ if ( tzfield%ndimlist(4) == NMNHDIM_FLYER_TIME ) tzfield%ndimlist(4) = NMNHDIM_NOTLISTED
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ end if
+
YJ = ' '
IF(J < 10)WRITE(YJ,'(I1)')J ; YJ = ADJUSTL(YJ)
- IF(J >= 10 .AND. J < 100) THEN
+ IF(J >= 10 .AND. J < 100) THEN
WRITE(YJ,'(I2)')J ; YJ = ADJUSTL(YJ)
- ELSE IF(J >= 100 .AND. J < 1000) THEN
+ ELSE IF(J >= 100 .AND. J < 1000) THEN
WRITE(YJ,'(I3)')J
ENDIF
IF(HTYPE == 'CART' .AND. .NOT. GICP .AND. .NOT. GJCP) THEN
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = TRIM(HUNITE(J))
+ TZFIELD%CUNITS = tpfields(j)%cunits
TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = TRIM(HTITRE(J))//' - '//TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
- TZFIELD%NGRID = KGRID(J)
+ TZFIELD%CCOMMENT = TRIM(tpfields(j)%cmnhname)//' - '//TRIM(tpfields(j)%ccomment)//' ('// Trim( tpfields(j)%cunits ) //')'
+ TZFIELD%NGRID = tpfields(j)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
+
CALL IO_Field_write_BOX(TPDIAFILE,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT)
ELSE
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = TRIM(HUNITE(J))
+ TZFIELD%CUNITS = tpfields(j)%cunits
TZFIELD%CDIR = '--'
- TZFIELD%CCOMMENT = TRIM(HTITRE(J))//' - '//TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
- TZFIELD%NGRID = KGRID(J)
+ TZFIELD%CCOMMENT = TRIM(tpfields(j)%cmnhname)//' - '//TRIM(tpfields(j)%ccomment)//' ('// Trim( tpfields(j)%cunits ) //')'
+ TZFIELD%NGRID = tpfields(j)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
+
CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
ENDIF
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
ENDDO
!
! 7eme enregistrement TRAJT
@@ -398,11 +434,19 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TRAJT'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
+!NMNHDIM_FLYER_TIME excluded because created only in netCDF/HDF groups (local to each flyer)
+if ( tpfields(1)%ndimlist(4) /= NMNHDIM_UNKNOWN .and. tpfields(1)%ndimlist(4) /= NMNHDIM_UNUSED &
+ .and. tpfields(1)%ndimlist(4) /= NMNHDIM_FLYER_TIME ) then
+ tzfield%ndimlist(1) = tpfields(1)%ndimlist(4)
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+end if
+
!Reconstitute old diachro format
allocate( ztimes( size( tpdates ), 1 ) )
@@ -412,6 +456,9 @@ end do
call IO_Field_write( tpdiafile, tzfield, ztimes )
+!Reset ndimlist
+tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
deallocate( ztimes )
!
! Dans certains cas
@@ -426,7 +473,7 @@ IF(PRESENT(PTRAJX))THEN
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
@@ -442,7 +489,7 @@ IF(PRESENT(PTRAJY))THEN
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
@@ -458,7 +505,7 @@ IF(PRESENT(PTRAJZ))THEN
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
@@ -473,7 +520,7 @@ TZFIELD%CLONGNAME = TRIM(HGROUP)//'.DATIM'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
@@ -506,10 +553,6 @@ CALL MENU_DIACHRO(TPDIAFILE,HGROUP)
LPACK=GPACK
!-----------------------------------------------------------------------------
!
-!* 2. EXITS
-! -----
-!
-RETURN
-END SUBROUTINE WRITE_DIACHRO
+END SUBROUTINE Write_diachro
end module mode_write_diachro
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 95c97354b7dd5411c5eb4b17a39a513ea2f2ee6e..de4e25a89016d1e640308e6371b3f69aef8094e4 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -56,12 +56,12 @@ END MODULE MODI_WRITE_PROFILER_n
!! MODIFICATIONS
!! -------------
!! Original 15/02/2002
-!! 2016 : G.DELAUTIER : LIMA
-!! Oct, 2016 (C.Lac) Add visibility diagnostics for fog
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! J. Escobar : 16/08/2018: From Pierre & Maud , correction use CNAMES(JSV-NSV_CHEMBEG+1)
+! G. Delautier 2016: LIMA
+! C. Lac 10/2016: add visibility diagnostics for fog
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Escobar 16/08/2018: From Pierre & Maud , correction use CNAMES(JSV-NSV_CHEMBEG+1)
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -89,7 +89,7 @@ USE MODD_PARAM_n, ONLY: CRAD
!
USE MODE_AERO_PSD
USE MODE_DUST_PSD
-USE MODE_WRITE_DIACHRO, only: WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
@@ -124,7 +124,10 @@ CONTAINS
!
!----------------------------------------------------------------------------
SUBROUTINE PROFILER_DIACHRO_n(TPROFILER,II)
-!
+
+use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+
TYPE(PROFILER), INTENT(IN) :: TPROFILER
INTEGER, INTENT(IN) :: II
!
@@ -148,6 +151,7 @@ INTEGER :: JSV ! loop counter
INTEGER :: IKU, IK ! loop counter
CHARACTER(LEN=2) :: INDICE
INTEGER :: I
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
!
@@ -628,10 +632,29 @@ ALLOCATE (ZW6(1,1,IKU,size(tprofiler%tpdates),1,JPROC))
ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
DEALLOCATE(ZWORK6)
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "CART", IGRID(:JPROC), tprofiler%tpdates, &
- ZW6, YTITLE(:JPROC), YUNIT(:JPROC), YCOMMENT(:JPROC), &
- OICP = .TRUE., OJCP = .TRUE., OKCP = .FALSE., &
- KIL = 1, KIH = 1, KJL = 1, KJH = 1, KKL = 1, KKH = IKU )
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ytitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitle(1 : jproc)
+tzfields(:)%cunits = yunit(1 : jproc)
+tzfields(:)%ccomment = ycomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 3
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
+tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
+
+call Write_diachro( tpdiafile, tzfields, ygroup, "CART", tprofiler%tpdates, &
+ zw6, &
+ oicp = .true., ojcp = .true., okcp = .false., &
+ kil = 1, kih = 1, kjl = 1, kjh = 1, kkl = 1, kkh = iku )
+
+deallocate( tzfields )
DEALLOCATE (ZW6 )
DEALLOCATE (YCOMMENT)
diff --git a/src/MNH/write_seriesn.f90 b/src/MNH/write_seriesn.f90
index 2cac51fbb3d2557f695985d09bb92ac8216d29d2..84f4a2b4382a9d3c244dd332738e1e059ad4e830 100644
--- a/src/MNH/write_seriesn.f90
+++ b/src/MNH/write_seriesn.f90
@@ -56,20 +56,24 @@ END MODULE MODI_WRITE_SERIES_n
!! MODIFICATIONS
!! -------------
!! Original 4/03/2002
-!! Modification 7/01/2013 Add key for netcdf writing
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! P.Wautelet: 11/07/2016 : removed MNH_NCWRIT define
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! 07/01/2013: add key for netCDF writing
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 11/07/2016: removed MNH_NCWRIT define
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
!-------------------------------------------------------------------------------
!
!
!* 0. Declaration
! --------------
!
-USE MODD_IO, ONLY: NGEN_VERB, TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+use modd_field, only: NMNHDIM_NI, NMNHDIM_NI_U, &
+ NMNHDIM_SERIES_LEVEL, NMNHDIM_SERIES_LEVEL_W, NMNHDIM_SERIES_TIME, NMNHDIM_SERIES_PROC, &
+ NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+USE MODD_IO, ONLY: NGEN_VERB, TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_SERIES
USE MODD_SERIES_n
@@ -77,7 +81,7 @@ USE MODD_SERIES_n
USE MODE_GATHER_ll
USE MODE_ll
USE MODE_MSG
-USE MODE_WRITE_DIACHRO, only: WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -109,8 +113,8 @@ INTEGER :: IRESP ! Return code of FM-routines
INTEGER :: INFO_ll ! Return code of FM-routines
INTEGER :: ISER,INAV
REAL :: ZSIZEHB
-LOGICAL :: GICP,GJCP,GKCP ! compression flags along the 3 directions
CHARACTER(LEN=100) :: YMSG
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION
@@ -235,12 +239,29 @@ ENDIF
!
!* 2.3 Write in diachro file
!
-GICP=.TRUE. ; GJCP=.TRUE. ; GKCP=.TRUE.
-CALL WRITE_DIACHRO( TPDIAFILE, 'TSERIES', 'CART', NSGRIDD1, tpsdates(1:nsnbstept), &
- XSSERIES1(1:1,1:1,1:1,1:NSNBSTEPT,:,:), &
- CSTITLE1(:), CSUNIT1(:), CSCOMMENT1(:), &
- OICP = GICP, OJCP = GJCP, OKCP = GKCP, &
- KIL = 1, KIH = 1, KJL = 1, KJH = 1, KKL = 1, KKH = 1 )
+allocate( tzfields( nstemp_serie1 ) )
+
+tzfields(:)%cmnhname = cstitle1(:)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = cstitle1(:)
+tzfields(:)%cunits = csunit1(:)
+tzfields(:)%ccomment = cscomment1(:)
+tzfields(:)%ngrid = nsgridd1(:)
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
+
+call Write_diachro( tpdiafile, tzfields, 'TSERIES', 'CART', tpsdates(1:nsnbstept), &
+ xsseries1(1:1,1:1,1:1,1:nsnbstept,1:1,:), &
+ oicp = .true., ojcp = .true., okcp = .true., &
+ kil = 1, kih = 1, kjl = 1, kjh = 1, kkl = 1, kkh = 1 )
+
+deallocate( tzfields )
!
!----------------------------------------------------------------------------
!
@@ -289,12 +310,38 @@ DEALLOCATE(ZVAR3D)
!
!* 3.2 Write in diachro file
!
-GICP=.TRUE. ; GJCP=.TRUE. ; GKCP=.FALSE.
-CALL WRITE_DIACHRO( TPDIAFILE, 'ZTSERIES', 'CART', NSGRIDD2, tpsdates(1:nsnbstept), &
- XSSERIES2(1:1,1:1,1:IKMAX,1:NSNBSTEPT,:,:), &
- CSTITLE2(:), CSUNIT2(:), CSCOMMENT2(:), &
- OICP = GICP, OJCP = GJCP, OKCP = GKCP, &
- KIL = 1, KIH = 1, KJL = 1, KJH = 1, KKL = IKB, KKH = IKE )
+allocate( tzfields( nstemp_serie2 ) )
+
+tzfields(:)%cmnhname = cstitle2(:)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = cstitle2(:)
+tzfields(:)%cunits = csunit2(:)
+tzfields(:)%ccomment = cscomment2(:)
+tzfields(:)%ngrid = nsgridd2(:)
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 3
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+do ji = 1, nstemp_serie2
+ if ( nsgridd2(ji) == 1 ) then
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL
+ else if ( nsgridd2(ji) == 4 ) then
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL_W
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_series_n', 'invalid nsgridd2' )
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL
+ end if
+end do
+tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
+
+call Write_diachro( tpdiafile, tzfields, 'ZTSERIES', 'CART', tpsdates(1:nsnbstept), &
+ xsseries2(1:1,1:1,1:ikmax,1:nsnbstept,1:1,:), &
+ oicp = .true., ojcp = .true., okcp = .false., &
+ kil = 1, kih = 1, kjl = 1, kjh = 1, kkl = ikb, kkh = ike )
+
+deallocate( tzfields )
!
!----------------------------------------------------------------------------
!
@@ -347,12 +394,38 @@ DO JS=1,NBJSLICE
DO JT=1, NSTEMP_SERIE3
YSTITLE3S(JT)=ADJUSTL(ADJUSTR(CSTITLE3(JT))//'Y'//YSL//'-'//YSH)
END DO
- GICP=.FALSE. ; GJCP=.TRUE. ; GKCP=.TRUE.
- CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, 'CART', NSGRIDD3, tpsdates(1:nsnbstept), &
- ZSERIES3_ll(1:IIU_ll,1:1,1:1,1:NSNBSTEPT,1:1,ISB1:ISB2), &
- YSTITLE3S(:), CSUNIT3(:), CSCOMMENT3(:), &
- OICP = GICP, OJCP = GJCP, OKCP = GKCP, &
- KIL = 1, KIH = IIU_ll, KJL = 1, KJH = 1, KKL = 1, KKH = 1 )
+ allocate( tzfields( isb2 - isb1 + 1 ) )
+
+ tzfields(:)%cmnhname = ystitle3s(:)
+ tzfields(:)%cstdname = ''
+ tzfields(:)%clongname = ystitle3s(:)
+ tzfields(:)%cunits = csunit3(:)
+ tzfields(:)%ccomment = cscomment3(:)
+ tzfields(:)%ngrid = nsgridd3(:)
+ tzfields(:)%ntype = TYPEREAL
+ tzfields(:)%ndims = 3
+ do ji = 1, isb2 - isb1 + 1
+ if ( nsgridd3(ji) == 1 .or. nsgridd3(ji) == 4 ) then
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI
+ else if ( nsgridd3(ji) == 2 ) then
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI_U
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_series_n', 'invalid nsgridd3' )
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI
+ end if
+ end do
+ tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+ tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+ tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
+ tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+ tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
+
+ call Write_diachro( tpdiafile, tzfields, ygroup, 'CART', tpsdates(1:nsnbstept), &
+ zseries3_ll(1:iiu_ll, 1:1, 1:1, 1:nsnbstept, 1:1, isb1:isb2), &
+ oicp = .false., ojcp = .true., okcp = .true., &
+ kil = 1, kih = iiu_ll, kjl = 1, kjh = 1, kkl = 1, kkh = 1 )
+
+ deallocate( tzfields )
END DO
DEALLOCATE(ZVAR3D,ZWORK2D,ZSERIES3_ll)
!
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index b419ef542e07585325c2821da1744f9a61426a92..23f3d72bcc6f9a993f0a4b3f588c29da28f61c7f 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -58,7 +58,7 @@ END MODULE MODI_WRITE_STATION_n
!! Original 15/02/2002
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -88,7 +88,7 @@ USE MODD_STATION_n
USE MODE_AERO_PSD
USE MODE_DUST_PSD
USE MODE_SALT_PSD
-USE MODE_WRITE_DIACHRO, only: WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -120,7 +120,10 @@ CONTAINS
!
!----------------------------------------------------------------------------
SUBROUTINE STATION_DIACHRO_n(TSTATION,II)
-!
+
+use modd_field, only: NMNHDIM_STATION_TIME, NMNHDIM_STATION_PROC, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+
TYPE(STATION), INTENT(IN) :: TSTATION
INTEGER, INTENT(IN) :: II
!
@@ -138,12 +141,13 @@ CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENT ! comment string
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLE ! title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT ! physical unit
!
-!!! do not forget to incremente the IPROC value if you add diagnostic !!!
+!!! do not forget to increment the IPROC value if you add diagnostic !!!
INTEGER :: IPROC ! number of variables records
-!!! do not forget to incremente the IPROC value if you add diagnostic !!!
+!!! do not forget to increment the JPROC value if you add diagnostic !!!
INTEGER :: JPROC ! loop counter
INTEGER :: JRR ! loop counter
INTEGER :: JSV ! loop counter
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
IF (TSTATION%X(II)==XUNDEF) RETURN
@@ -711,11 +715,30 @@ ALLOCATE (ZW6(1,1,1,SIZE(tstation%tpdates),1,JPROC))
ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
DEALLOCATE(ZWORK6)
!
-CALL WRITE_DIACHRO( TPDIAFILE, YGROUP, "CART", IGRID, tstation%tpdates, &
- ZW6(:,:,:,:,:,:), YTITLE(:), YUNIT(:), YCOMMENT(:), &
- OICP = .TRUE., OJCP = .TRUE., OKCP = .FALSE., &
- KIL = 1, KIH = 1, KJL = 1, KJH = 1, KKL = 1, KKH = 1 )
-!
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ytitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitle(1 : jproc)
+tzfields(:)%cunits = yunit(1 : jproc)
+tzfields(:)%ccomment = ycomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_STATION_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_STATION_PROC
+
+call Write_diachro( tpdiafile, tzfields, ygroup, "CART", tstation%tpdates, &
+ zw6, &
+ oicp = .true., ojcp = .true., okcp = .false., &
+ kil = 1, kih = 1, kjl = 1, kjh = 1, kkl = 1, kkh = 1 )
+
+deallocate( tzfields )
+
DEALLOCATE (ZW6)
DEALLOCATE (YCOMMENT)
DEALLOCATE (YTITLE )