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

Philippe 10/10/2024: WRITE_SURFT1_MNH: write array of dates instead of old way...

Philippe 10/10/2024: WRITE_SURFT1_MNH: write array of dates instead of old way (3 integer + 1 real arrays) + clean the subroutine
parent 015bd30e
No related branches found
No related tags found
No related merge requests found
!MNH_LIC Copyright 1997-2023 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC Copyright 1997-2024 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1. !MNH_LIC for details. version 1.
...@@ -1450,7 +1450,6 @@ USE MODD_IO, ONLY: TFILE_SURFEX ...@@ -1450,7 +1450,6 @@ USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_TYPE_DATE USE MODD_TYPE_DATE
use MODE_IO_FIELD_WRITE, only: IO_Field_write use MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE
USE MODE_MSG USE MODE_MSG
USE MODE_WRITE_SURF_MNH_TOOLS USE MODE_WRITE_SURF_MNH_TOOLS
...@@ -1539,84 +1538,48 @@ END SUBROUTINE WRITE_SURFT0_MNH ...@@ -1539,84 +1538,48 @@ END SUBROUTINE WRITE_SURFT0_MNH
!* 0. DECLARATIONS !* 0. DECLARATIONS
! ------------ ! ------------
! !
use modd_field, only: tfieldmetadata, TYPEINT, TYPEREAL use modd_field, only: tfieldmetadata, TYPEDATE
USE MODD_IO, ONLY: TFILE_SURFEX USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE USE MODD_TYPE_DATE
use MODE_IO_FIELD_WRITE, only: IO_Field_write use MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE
USE MODE_MSG USE MODE_MSG
USE MODE_WRITE_SURF_MNH_TOOLS
IMPLICIT NONE IMPLICIT NONE
! !
!* 0.1 Declarations of arguments !* 0.1 Declarations of arguments
! !
CHARACTER(LEN=MNH_LEN_HREC), INTENT(IN) :: HREC ! name of the article to be written CHARACTER(LEN=MNH_LEN_HREC), INTENT(IN) :: HREC ! name of the article to be written
INTEGER, INTENT(IN) :: KL1 ! number of points INTEGER, INTENT(IN) :: KL1 ! number of points
INTEGER, DIMENSION(KL1), INTENT(IN) :: KYEAR ! year INTEGER, DIMENSION(KL1), INTENT(IN) :: KYEAR ! year
INTEGER, DIMENSION(KL1), INTENT(IN) :: KMONTH ! month INTEGER, DIMENSION(KL1), INTENT(IN) :: KMONTH ! month
INTEGER, DIMENSION(KL1), INTENT(IN) :: KDAY ! day INTEGER, DIMENSION(KL1), INTENT(IN) :: KDAY ! day
REAL, DIMENSION(KL1), INTENT(IN) :: PTIME ! time REAL, DIMENSION(KL1), INTENT(IN) :: PTIME ! time
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
!* 0.2 Declarations of local variables !* 0.2 Declarations of local variables
! !
! !
CHARACTER(LEN=5) :: YMSG CHARACTER(LEN=5) :: YMSG
INTEGER, DIMENSION(3,KL1) :: ITDATE TYPE (DATE_TIME), DIMENSION(KL1) :: TZDATA
TYPE(TFIELDMETADATA) :: TZFIELD TYPE(TFIELDMETADATA) :: TZFIELD
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT1_MNH',TRIM(TFILE_SURFEX%CNAME)//': writing '//TRIM(HREC)) CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT1_MNH',TRIM(TFILE_SURFEX%CNAME)//': writing '//TRIM(HREC))
! !
IF( HREC=='DTCUR' .AND. CSTORAGE_TYPE/='SU' ) THEN TZDATA(:)%nyear = kyear(:)
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT1_MNH',TRIM(HREC)//' not written in file by externalized surface') TZDATA(:)%nmonth = kmonth(:)
RETURN TZDATA(:)%nday = kday(:)
ELSE TZDATA(:)%xtime = PTIME(:)
!
ITDATE(1,:) = KYEAR (:)
ITDATE(2,:) = KMONTH (:)
ITDATE(3,:) = KDAY (:)
!
TZFIELD = TFIELDMETADATA( &
CMNHNAME = TRIM(HREC)//'%TDATE', &
CSTDNAME = '', &
CLONGNAME = TRIM(HREC)//'%TDATE', &
CUNITS = '', &
CDIR = '--', &
CCOMMENT = TRIM(HCOMMENT), &
NGRID = 0, &
NTYPE = TYPEINT, &
NDIMS = 2, &
LTIMEDEP = .FALSE. )
!
CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ITDATE(:,:),KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!
TZFIELD = TFIELDMETADATA( &
CMNHNAME = TRIM(HREC)//'%xtime', &
CSTDNAME = '', &
CLONGNAME = TRIM(HREC)//'%xtime', &
CUNITS = '', &
CDIR = '--', &
CCOMMENT = TRIM(HCOMMENT), &
NGRID = 0, &
NTYPE = TYPEREAL, &
NDIMS = 1, &
LTIMEDEP = .FALSE. )
!
CALL IO_Field_write(TFILE_SURFEX,TZFIELD,PTIME(:),KRESP)
! !
IF (KRESP /=0) THEN CALL PREPARE_METADATA_WRITE_SURF( HREC, '--', HCOMMENT, 0, TYPEDATE, 1, 'WRITE_SURFT1_MNH', TZFIELD )
WRITE ( YMSG, '( I5 )' ) KRESP CALL IO_Field_write( TFILE_SURFEX, TZFIELD, TZDATA, KRESP )
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
! !
IF ( KRESP /=0 ) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
CALL PRINT_MSG( NVERB_ERROR, 'IO', 'WRITE_SURFT1_MNH', 'error when writing article ' // TRIM(HREC) // ' KRESP=' // YMSG )
END IF END IF
! !
END SUBROUTINE WRITE_SURFT1_MNH END SUBROUTINE WRITE_SURFT1_MNH
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment