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

Philippe 04/11/2020: IO: add Write_diachro_lfi subroutine

parent 2f48c300
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/write_diachro.f90
+ 101
− 64
View file @ 30b073a6
...@@ -87,21 +87,11 @@ subroutine Write_diachro( tpdiafile, tpfields, hgroup, htype, & ...@@ -87,21 +87,11 @@ subroutine Write_diachro( tpdiafile, tpfields, hgroup, htype, &
!* 0. DECLARATIONS !* 0. DECLARATIONS
! ------------ ! ------------
! !
use modd_budget
use modd_conf, only: lpack use modd_conf, only: lpack
use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_BUDGET_LES_MASK, NMNHDIM_FLYER_TIME, & use modd_field, only: tfield_metadata_base
NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
TYPECHAR, TYPEDATE, TYPEINT, TYPEREAL, &
tfield_metadata_base, tfielddata
use modd_io, only: tfiledata 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 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_menu_diachro, only: Menu_diachro
use mode_msg use mode_msg
! !
...@@ -124,6 +114,80 @@ REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTR ...@@ -124,6 +114,80 @@ REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PTR
! !
!* 0.1 Local variables !* 0.1 Local variables
! --------------- ! ---------------
logical :: gicp, gjcp, gkcp
logical :: gpack
!------------------------------------------------------------------------------
call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro', 'called' )
if ( present( oicp ) ) then
gicp = oicp
else
gicp = .false.
end if
if ( present( ojcp ) ) then
gjcp = ojcp
else
gjcp = .false.
end if
if ( present( okcp ) ) then
gkcp = okcp
else
gkcp = .false.
end if
gpack = lpack
lpack = .false.
if ( tpdiafile%cformat == 'LFI' .or. tpdiafile%cformat == 'LFICDF4' ) &
call Write_diachro_lfi( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, gicp, gjcp, gkcp, kil, kih, kjl, kjh, kkl, kkh, &
ptrajx, ptrajy, ptrajz )
#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 )
#endif
call Menu_diachro( tpdiafile, hgroup )
lpack = gpack
end subroutine Write_diachro
!-----------------------------------------------------------------------------
subroutine Write_diachro_lfi( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh, &
ptrajx, ptrajy, ptrajz )
use modd_budget, only: nbumask, nbuwrnb
use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_FLYER_TIME, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
TYPECHAR, 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_msg
use mode_tools_ll, only: Get_globaldims_ll
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) :: 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
integer, parameter :: LFITITLELGT = 100 integer, parameter :: LFITITLELGT = 100
integer, parameter :: LFIUNITLGT = 100 integer, parameter :: LFIUNITLGT = 100
integer, parameter :: LFICOMMENTLGT = 100 integer, parameter :: LFICOMMENTLGT = 100
...@@ -143,40 +207,23 @@ INTEGER :: ICOMPX, ICOMPY, ICOMPZ ...@@ -143,40 +207,23 @@ INTEGER :: ICOMPX, ICOMPY, ICOMPZ
INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
integer :: ji integer :: ji
INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
logical :: gicp, gjcp, gkcp
LOGICAL :: GPACK
real, dimension(:,:), allocatable :: ztimes real, dimension(:,:), allocatable :: ztimes
real, dimension(:,:), allocatable :: zdatime real, dimension(:,:), allocatable :: zdatime
TYPE(TFIELDDATA) :: TZFIELD TYPE(TFIELDDATA) :: TZFIELD
!------------------------------------------------------------------------------ type(tfiledata) :: tzfile
call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro', 'called' )
if ( present( oicp ) ) then call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro_lfi', 'called' )
gicp = oicp
else
gicp = .false.
end if
if ( present( ojcp ) ) then tzfile = tpdiafile
gjcp = ojcp
else
gjcp = .false.
end if
if ( present( okcp ) ) then !Write only in LFI files
gkcp = okcp tzfile%cformat = 'LFI'
else
gkcp = .false.
end if
GPACK=LPACK
LPACK=.FALSE.
YCOMMENT='NOTHING' YCOMMENT='NOTHING'
!
II = SIZE(PVAR,1) II = SIZE(PVAR,1)
IJ = SIZE(PVAR,2) IJ = SIZE(PVAR,2)
IF(HTYPE == 'CART' .AND. .NOT. GICP .AND. .NOT. GJCP) THEN IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN
!for parallel execution, PVAR is distributed on several proc !for parallel execution, PVAR is distributed on several proc
II=KIH-KIL+1 II=KIH-KIL+1
IJ=KJH-KJL+1 IJ=KJH-KJL+1
...@@ -225,23 +272,22 @@ ILENUNITE = LFIUNITLGT ...@@ -225,23 +272,22 @@ ILENUNITE = LFIUNITLGT
ILENCOMMENT = LFICOMMENTLGT ILENCOMMENT = LFICOMMENTLGT
ICOMPX=0; ICOMPY=0; ICOMPZ=0 ICOMPX=0; ICOMPY=0; ICOMPZ=0
IF ( GICP ) THEN IF ( OICP ) THEN
ICOMPX = 1 ICOMPX = 1
ELSE ELSE
ICOMPX = 0 ICOMPX = 0
ENDIF ENDIF
IF ( GJCP ) THEN IF ( OJCP ) THEN
ICOMPY = 1 ICOMPY = 1
ELSE ELSE
ICOMPY = 0 ICOMPY = 0
ENDIF ENDIF
IF ( GKCP ) THEN IF ( OKCP ) THEN
ICOMPZ=1 ICOMPZ=1
ELSE ELSE
ICOMPZ = 0 ICOMPZ = 0
ENDIF ENDIF
! !
!
! 1er enregistrement TYPE ! 1er enregistrement TYPE
! !
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TYPE' TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TYPE'
...@@ -254,7 +300,7 @@ TZFIELD%NGRID = tpfields(1)%ngrid ...@@ -254,7 +300,7 @@ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0 TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(TPDIAFILE,TZFIELD,HTYPE) CALL IO_Field_write(tzfile,TZFIELD,HTYPE)
! !
! 2eme enregistrement DIMENSIONS des MATRICES et LONGUEUR des TABLEAUX de CARACTERES et FLAGS de COMPRESSION sur les DIFFERENTS AXES ! 2eme enregistrement DIMENSIONS des MATRICES et LONGUEUR des TABLEAUX de CARACTERES et FLAGS de COMPRESSION sur les DIFFERENTS AXES
! !
...@@ -299,7 +345,7 @@ SELECT CASE(HTYPE) ...@@ -299,7 +345,7 @@ SELECT CASE(HTYPE)
ITABCHAR(29)=IIMASK; ITABCHAR(30)=IJMASK ITABCHAR(29)=IIMASK; ITABCHAR(30)=IJMASK
ITABCHAR(31)=IKMASK; ITABCHAR(32)=ITMASK ITABCHAR(31)=IKMASK; ITABCHAR(32)=ITMASK
ITABCHAR(33)=INMASK; ITABCHAR(34)=IPMASK ITABCHAR(33)=INMASK; ITABCHAR(34)=IPMASK
CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR) CALL IO_Field_write(tzfile,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
CASE DEFAULT CASE DEFAULT
ILENG = 25 ILENG = 25
...@@ -317,7 +363,7 @@ SELECT CASE(HTYPE) ...@@ -317,7 +363,7 @@ SELECT CASE(HTYPE)
ITABCHAR(20)=IIMASK; ITABCHAR(21)=IJMASK ITABCHAR(20)=IIMASK; ITABCHAR(21)=IJMASK
ITABCHAR(22)=IKMASK; ITABCHAR(23)=ITMASK ITABCHAR(22)=IKMASK; ITABCHAR(23)=ITMASK
ITABCHAR(24)=INMASK; ITABCHAR(25)=IPMASK ITABCHAR(24)=INMASK; ITABCHAR(25)=IPMASK
CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR) CALL IO_Field_write(tzfile,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
END SELECT END SELECT
! !
...@@ -335,7 +381,7 @@ TZFIELD%NDIMS = 1 ...@@ -335,7 +381,7 @@ TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
allocate( ytitles( ip ) ) allocate( ytitles( ip ) )
ytitles(:) = tpfields(1 : ip)%cmnhname ytitles(:) = tpfields(1 : ip)%cmnhname
CALL IO_Field_write(TPDIAFILE,TZFIELD,ytitles(:)) CALL IO_Field_write(tzfile,TZFIELD,ytitles(:))
deallocate( ytitles ) deallocate( ytitles )
! !
! 4eme enregistrement UNITE ! 4eme enregistrement UNITE
...@@ -352,7 +398,7 @@ TZFIELD%NDIMS = 1 ...@@ -352,7 +398,7 @@ TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
allocate( yunits( ip ) ) allocate( yunits( ip ) )
yunits(:) = tpfields(1 : ip)%cunits yunits(:) = tpfields(1 : ip)%cunits
CALL IO_Field_write(TPDIAFILE,TZFIELD,yunits(:)) CALL IO_Field_write(tzfile,TZFIELD,yunits(:))
deallocate( yunits ) deallocate( yunits )
! !
! 5eme enregistrement COMMENT ! 5eme enregistrement COMMENT
...@@ -369,7 +415,7 @@ TZFIELD%NDIMS = 1 ...@@ -369,7 +415,7 @@ TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
allocate( ycomments( ip ) ) allocate( ycomments( ip ) )
ycomments(:) = tpfields(1 : ip)%ccomment ycomments(:) = tpfields(1 : ip)%ccomment
CALL IO_Field_write(TPDIAFILE,TZFIELD,ycomments(:)) CALL IO_Field_write(tzfile,TZFIELD,ycomments(:))
deallocate( ycomments ) deallocate( ycomments )
! !
! 6eme enregistrement PVAR ! 6eme enregistrement PVAR
...@@ -395,7 +441,7 @@ DO J = 1,IP ...@@ -395,7 +441,7 @@ DO J = 1,IP
ELSE IF(J >= 100 .AND. J < 1000) THEN ELSE IF(J >= 100 .AND. J < 1000) THEN
WRITE(YJ,'(I3)')J WRITE(YJ,'(I3)')J
ENDIF ENDIF
IF(HTYPE == 'CART' .AND. .NOT. GICP .AND. .NOT. GJCP) THEN IF(HTYPE == 'CART' .AND. .NOT. oicp .AND. .NOT. ojcp) THEN
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
TZFIELD%CSTDNAME = '' TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
...@@ -407,7 +453,7 @@ DO J = 1,IP ...@@ -407,7 +453,7 @@ DO J = 1,IP
TZFIELD%NDIMS = 5 TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write_BOX(TPDIAFILE,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), & CALL IO_Field_write_BOX(tzfile,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT) KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT)
ELSE ELSE
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
...@@ -421,7 +467,7 @@ DO J = 1,IP ...@@ -421,7 +467,7 @@ DO J = 1,IP
TZFIELD%NDIMS = 5 TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J)) CALL IO_Field_write(tzfile,TZFIELD,PVAR(:,:,:,:,:,J))
ENDIF ENDIF
tzfield%ndimlist(:) = NMNHDIM_UNKNOWN tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
ENDDO ENDDO
...@@ -454,7 +500,7 @@ do ji=1,size(tpdates) ...@@ -454,7 +500,7 @@ do ji=1,size(tpdates)
call Datetime_distance( tdtexp, tpdates(ji ), ztimes(ji, 1 ) ) call Datetime_distance( tdtexp, tpdates(ji ), ztimes(ji, 1 ) )
end do end do
call IO_Field_write( tpdiafile, tzfield, ztimes ) call IO_Field_write( tzfile, tzfield, ztimes )
!Reset ndimlist !Reset ndimlist
tzfield%ndimlist(:) = NMNHDIM_UNKNOWN tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
...@@ -477,7 +523,7 @@ IF(PRESENT(PTRAJX))THEN ...@@ -477,7 +523,7 @@ IF(PRESENT(PTRAJX))THEN
TZFIELD%NTYPE = TYPEREAL TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3 TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJX) CALL IO_Field_write(tzfile,TZFIELD,PTRAJX)
ENDIF ENDIF
! !
! 9eme enregistrement TRAJY ! 9eme enregistrement TRAJY
...@@ -493,7 +539,7 @@ IF(PRESENT(PTRAJY))THEN ...@@ -493,7 +539,7 @@ IF(PRESENT(PTRAJY))THEN
TZFIELD%NTYPE = TYPEREAL TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3 TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJY) CALL IO_Field_write(tzfile,TZFIELD,PTRAJY)
ENDIF ENDIF
! !
! 10eme enregistrement TRAJZ ! 10eme enregistrement TRAJZ
...@@ -509,7 +555,7 @@ IF(PRESENT(PTRAJZ))THEN ...@@ -509,7 +555,7 @@ IF(PRESENT(PTRAJZ))THEN
TZFIELD%NTYPE = TYPEREAL TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3 TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE. TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJZ) CALL IO_Field_write(tzfile,TZFIELD,PTRAJZ)
ENDIF ENDIF
! !
! 11eme enregistrement PDATIME ! 11eme enregistrement PDATIME
...@@ -545,20 +591,11 @@ zdatime(14, : ) = tpdates(:)%tdate%month ...@@ -545,20 +591,11 @@ zdatime(14, : ) = tpdates(:)%tdate%month
zdatime(15, : ) = tpdates(:)%tdate%day zdatime(15, : ) = tpdates(:)%tdate%day
zdatime(16, : ) = tpdates(:)%time zdatime(16, : ) = tpdates(:)%time
call IO_Field_write( tpdiafile, tzfield, zdatime ) call IO_Field_write( tzfile, tzfield, zdatime )
deallocate( zdatime ) deallocate( zdatime )
!
#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 )
#endif
CALL MENU_DIACHRO(TPDIAFILE,HGROUP)
LPACK=GPACK
end subroutine Write_diachro
end subroutine Write_diachro_lfi
!----------------------------------------------------------------------------- !-----------------------------------------------------------------------------
#ifdef MNH_IOCDF4 #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 )
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

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