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

Philippe 09/06/2017: IO: name of the variable added to the name of the written... 

Philippe 09/06/2017: IO: name of the variable added to the name of the written field and better comment (true comment + units)
parent 1dcbe698
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
+ 30
− 25
View file @ ab3bad9d
...@@ -69,6 +69,8 @@ ...@@ -69,6 +69,8 @@
!! MASK array in MASK case with write outside the !! MASK array in MASK case with write outside the
!! routine. !! routine.
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable !! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! P. Wautelet 09/06/2017: name of the variable added to the name of the written field
!! and better comment (true comment + units)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
!* 0. DECLARATIONS !* 0. DECLARATIONS
...@@ -113,7 +115,7 @@ REAL,DIMENSION(:,:,:),OPTIONAL :: PTRAJZ ...@@ -113,7 +115,7 @@ REAL,DIMENSION(:,:,:),OPTIONAL :: PTRAJZ
! !
CHARACTER(LEN=16) :: YRECFM CHARACTER(LEN=16) :: YRECFM
CHARACTER(LEN=LEN(HFILEDIA)+4) :: YFILEDIA CHARACTER(LEN=LEN(HFILEDIA)+4) :: YFILEDIA
CHARACTER(LEN=20) :: YCOMMENT CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=3) :: YJ CHARACTER(LEN=3) :: YJ
INTEGER :: ILENG, ILENCH, ILENTITRE, ILENUNITE, ILENCOMMENT, ILE, IRESP INTEGER :: ILENG, ILENCH, ILENTITRE, ILENUNITE, ILENCOMMENT, ILE, IRESP
INTEGER :: ILUOUTDIA, IRESPDIA,INPRARDIA,IFTYPEDIA,IVERBDIA,ININARDIA INTEGER :: ILUOUTDIA, IRESPDIA,INPRARDIA,IFTYPEDIA,IVERBDIA,ININARDIA
...@@ -131,7 +133,7 @@ LOGICAL :: GPACK ...@@ -131,7 +133,7 @@ LOGICAL :: GPACK
GPACK=LPACK GPACK=LPACK
LPACK=.FALSE. LPACK=.FALSE.
YCOMMENT='NOTHING' YCOMMENT='NOTHING'
ILENCH = LEN(YCOMMENT) ILENCH = LEN_TRIM(YCOMMENT)
! !
! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini ! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
! Question: doit-on mettre condition comme: ! Question: doit-on mettre condition comme:
...@@ -242,7 +244,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TYPE') ...@@ -242,7 +244,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TYPE')
#if defined(MNH_IOCDF4) #if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HTYPE,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) HTYPE,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else #else
...@@ -253,7 +255,7 @@ DO J = 1,ILENG ...@@ -253,7 +255,7 @@ DO J = 1,ILENG
ENDDO ENDDO
!print *,SIZE(ITABCHAR),' ITABCHAR ',ITABCHAR,' KGRID ',KGRID,HLUOUTDIA,HFILEDIA !print *,SIZE(ITABCHAR),' ITABCHAR ',ITABCHAR,' KGRID ',KGRID,HLUOUTDIA,HFILEDIA
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
#endif #endif
...@@ -292,7 +294,7 @@ SELECT CASE(HTYPE) ...@@ -292,7 +294,7 @@ SELECT CASE(HTYPE)
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 FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ITABCHAR, & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ITABCHAR, &
KGRID(1),ILENCH,YCOMMENT,IRESPDIA) KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
IF (NVERB>=5) THEN IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT ',ILENTITRE,ILENUNITE,ILENCOMMENT WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT ',ILENTITRE,ILENUNITE,ILENCOMMENT
...@@ -314,9 +316,9 @@ SELECT CASE(HTYPE) ...@@ -314,9 +316,9 @@ SELECT CASE(HTYPE)
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 FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ILENTITRE,ILENUNITE, & ! CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ILENTITRE,ILENUNITE, &
! ILENCOMMENT,II,IJ,IK,IT,IN,IP,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) ! ILENCOMMENT,II,IJ,IK,IT,IN,IP,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ITABCHAR, & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ITABCHAR, &
KGRID(1),ILENCH,YCOMMENT,IRESPDIA) KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
END SELECT END SELECT
IF (NVERB>=5) THEN IF (NVERB>=5) THEN
...@@ -329,7 +331,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TITRE') ...@@ -329,7 +331,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TITRE')
#if defined(MNH_IOCDF4) #if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HTITRE(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA) HTITRE(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else #else
...@@ -345,7 +347,7 @@ DO JJ = 1,IP ...@@ -345,7 +347,7 @@ DO JJ = 1,IP
ENDIF ENDIF
ENDDO ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
#endif #endif
...@@ -360,7 +362,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.UNITE') ...@@ -360,7 +362,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.UNITE')
#if defined(MNH_IOCDF4) #if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HUNITE(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA) HUNITE(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else #else
...@@ -376,7 +378,7 @@ DO JJ = 1,IP ...@@ -376,7 +378,7 @@ DO JJ = 1,IP
ENDIF ENDIF
ENDDO ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
#endif #endif
...@@ -392,7 +394,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.COMMENT') ...@@ -392,7 +394,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.COMMENT')
#if defined(MNH_IOCDF4) #if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HCOMMENT(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA) HCOMMENT(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else #else
...@@ -408,7 +410,7 @@ DO JJ = 1,IP ...@@ -408,7 +410,7 @@ DO JJ = 1,IP
ENDIF ENDIF
ENDDO ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR) DEALLOCATE(ITABCHAR)
#endif #endif
...@@ -432,22 +434,22 @@ DO J = 1,IP ...@@ -432,22 +434,22 @@ 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
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.PROC'//YJ) YRECFM = TRIM(HGROUP)//'.'//TRIM(HTITRE(J))
ILENG = II*IJ*IK*IT*IN ILENG = II*IJ*IK*IT*IN
YCOMMENT = TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
ILENCH = LEN_TRIM(YCOMMENT)
!print *,' PVAR ' !print *,' PVAR '
!print *,' YJ ILENG YRECFM KGRID(J) ',YJ,ILENG,YRECFM,KGRID(J) !print *,' YJ ILENG YRECFM KGRID(J) ',YJ,ILENG,YRECFM,KGRID(J)
! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini ! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN
CALL FMWRITBOX(HFILEDIA,YRECFM,HLUOUTDIA,'BUDGET',PVAR(:,:,:,:,:,J),KGRID(J), & CALL FMWRITBOX(HFILEDIA,YRECFM,HLUOUTDIA,'BUDGET',PVAR(:,:,:,:,:,J),KGRID(J), &
YCOMMENT,KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT,IRESPDIA) TRIM(YCOMMENT),KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT,IRESPDIA)
ELSE ELSE
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J), & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ILENCH,YCOMMENT,IRESPDIA)
ENDIF ENDIF
ELSE ELSE
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J), & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ILENCH,YCOMMENT,IRESPDIA)
END IF END IF
IF (NVERB>=5) THEN IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)J,TRIM(YRECFM) WRITE(ILUOUTDIA,*)J,TRIM(YRECFM)
...@@ -457,12 +459,15 @@ IF (NVERB>=5) THEN ...@@ -457,12 +459,15 @@ IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 6th ENREGISTREMENT: OK' WRITE(ILUOUTDIA,*)' 6th ENREGISTREMENT: OK'
ENDIF ENDIF
! !
YCOMMENT='NOTHING'
ILENCH = LEN_TRIM(YCOMMENT)
!
! 7eme enregistrement TRAJT ! 7eme enregistrement TRAJT
! !
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJT') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJT')
ILENG = IT*INTRAJT ILENG = IT*INTRAJT
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJT,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) PTRAJT,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
IF (NVERB>=5) THEN IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 7th ENREGISTREMENT(',TRIM(YRECFM),'): OK' WRITE(ILUOUTDIA,*)' 7th ENREGISTREMENT(',TRIM(YRECFM),'): OK'
ENDIF ENDIF
...@@ -476,7 +481,7 @@ IF(PRESENT(PTRAJX))THEN ...@@ -476,7 +481,7 @@ IF(PRESENT(PTRAJX))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJX') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJX')
ILENG = IKTRAJX*ITTRAJX*INTRAJX ILENG = IKTRAJX*ITTRAJX*INTRAJX
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJX,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) PTRAJX,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF ENDIF
! !
! ou ! ou
...@@ -485,7 +490,7 @@ IF(PRESENT(PMASK))THEN ...@@ -485,7 +490,7 @@ IF(PRESENT(PMASK))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.MASK') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.MASK')
ILENG = IIMASK*IJMASK*IKMASK*ITMASK*INMASK*IPMASK ILENG = IIMASK*IJMASK*IKMASK*ITMASK*INMASK*IPMASK
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'XY',PMASK,KGRID(1), & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'XY',PMASK,KGRID(1), &
ILENCH,YCOMMENT,IRESPDIA) ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF ENDIF
! !
! 9eme enregistrement TRAJY ! 9eme enregistrement TRAJY
...@@ -494,7 +499,7 @@ IF(PRESENT(PTRAJY))THEN ...@@ -494,7 +499,7 @@ IF(PRESENT(PTRAJY))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJY') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJY')
ILENG = IKTRAJY*ITTRAJY*INTRAJY ILENG = IKTRAJY*ITTRAJY*INTRAJY
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJY,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) PTRAJY,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF ENDIF
! !
! 10eme enregistrement TRAJZ ! 10eme enregistrement TRAJZ
...@@ -503,7 +508,7 @@ IF(PRESENT(PTRAJZ))THEN ...@@ -503,7 +508,7 @@ IF(PRESENT(PTRAJZ))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJZ') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJZ')
ILENG = IKTRAJZ*ITTRAJZ*INTRAJZ ILENG = IKTRAJZ*ITTRAJZ*INTRAJZ
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJZ,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) PTRAJZ,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF ENDIF
! !
! 11eme enregistrement PDATIME ! 11eme enregistrement PDATIME
...@@ -511,7 +516,7 @@ ENDIF ...@@ -511,7 +516,7 @@ ENDIF
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.DATIM') YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.DATIM')
ILENG=16*IT ILENG=16*IT
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', & CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PDATIME,KGRID(1),ILENCH,YCOMMENT,IRESPDIA) PDATIME,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
! !
CALL MENU_DIACHRO(HFILEDIA,HLUOUTDIA,HGROUP) CALL MENU_DIACHRO(HFILEDIA,HLUOUTDIA,HGROUP)
LPACK=GPACK LPACK=GPACK
......
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