Skip to content
Snippets Groups Projects
Commit 68b7052a 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)

(cherry picked from commit ab3bad9d)
parent d130e294
No related branches found
No related tags found
No related merge requests found
......@@ -68,8 +68,10 @@
!! add the initialization of the dimensions of
!! MASK array in MASK case with write outside the
!! routine.
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! D.Gazen+ G.Delautier 06/2016 modif for ncl files
!! 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
......@@ -114,7 +116,7 @@ REAL,DIMENSION(:,:,:),OPTIONAL :: PTRAJZ
!
CHARACTER(LEN=16) :: YRECFM
CHARACTER(LEN=LEN(HFILEDIA)+4) :: YFILEDIA
CHARACTER(LEN=20) :: YCOMMENT
CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=3) :: YJ
INTEGER :: ILENG, ILENCH, ILENTITRE, ILENUNITE, ILENCOMMENT, ILE, IRESP
INTEGER :: ILUOUTDIA, IRESPDIA,INPRARDIA,IFTYPEDIA,IVERBDIA,ININARDIA
......@@ -132,7 +134,7 @@ LOGICAL :: GPACK
GPACK=LPACK
LPACK=.FALSE.
YCOMMENT='NOTHING'
ILENCH = LEN(YCOMMENT)
ILENCH = LEN_TRIM(YCOMMENT)
!
! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
! Question: doit-on mettre condition comme:
......@@ -243,7 +245,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TYPE')
#if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HTYPE,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
HTYPE,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else
......@@ -254,7 +256,7 @@ DO J = 1,ILENG
ENDDO
!print *,SIZE(ITABCHAR),' ITABCHAR ',ITABCHAR,' KGRID ',KGRID,HLUOUTDIA,HFILEDIA
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
#endif
......@@ -293,7 +295,7 @@ SELECT CASE(HTYPE)
ITABCHAR(31)=IKMASK; ITABCHAR(32)=ITMASK
ITABCHAR(33)=INMASK; ITABCHAR(34)=IPMASK
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',ITABCHAR, &
KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT ',ILENTITRE,ILENUNITE,ILENCOMMENT
......@@ -315,9 +317,9 @@ SELECT CASE(HTYPE)
ITABCHAR(22)=IKMASK; ITABCHAR(23)=ITMASK
ITABCHAR(24)=INMASK; ITABCHAR(25)=IPMASK
! 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, &
KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
END SELECT
IF (NVERB>=5) THEN
......@@ -330,7 +332,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TITRE')
#if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HTITRE(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
HTITRE(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else
......@@ -346,7 +348,7 @@ DO JJ = 1,IP
ENDIF
ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
#endif
......@@ -361,7 +363,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.UNITE')
#if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HUNITE(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
HUNITE(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else
......@@ -377,7 +379,7 @@ DO JJ = 1,IP
ENDIF
ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
#endif
......@@ -393,7 +395,7 @@ YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.COMMENT')
#if defined(MNH_IOCDF4)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
HCOMMENT(1:IP),KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
HCOMMENT(1:IP),KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
#else
......@@ -409,7 +411,7 @@ DO JJ = 1,IP
ENDIF
ENDDO
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
ITABCHAR,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
ITABCHAR,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
DEALLOCATE(ITABCHAR)
#endif
......@@ -433,22 +435,22 @@ DO J = 1,IP
ELSE IF(J >= 100 .AND. J < 1000) THEN
WRITE(YJ,'(I3)')J
ENDIF
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.PROC'//YJ)
YRECFM = TRIM(HGROUP)//'.'//TRIM(HTITRE(J))
ILENG = II*IJ*IK*IT*IN
YCOMMENT = TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
ILENCH = LEN_TRIM(YCOMMENT)
!print *,' PVAR '
!print *,' YJ ILENG YRECFM KGRID(J) ',YJ,ILENG,YRECFM,KGRID(J)
! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN
CALL FMWRITBOX(HFILEDIA,YRECFM,HLUOUTDIA,'BUDGET',PVAR(:,:,:,:,:,J),KGRID(J), &
HTITRE(J),KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT,IRESPDIA)
TRIM(YCOMMENT),KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT,IRESPDIA)
ELSE
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J), &
LEN(HTITRE(J)),HTITRE(J),IRESPDIA)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF
ELSE
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J), &
LEN(HTITRE(J)),HTITRE(J),IRESPDIA)
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--',PVAR(:,:,:,:,:,J),KGRID(J),ILENCH,TRIM(YCOMMENT),IRESPDIA)
END IF
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)J,TRIM(YRECFM)
......@@ -458,12 +460,15 @@ IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 6th ENREGISTREMENT: OK'
ENDIF
!
YCOMMENT='NOTHING'
ILENCH = LEN_TRIM(YCOMMENT)
!
! 7eme enregistrement TRAJT
!
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJT')
ILENG = IT*INTRAJT
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJT,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
PTRAJT,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 7th ENREGISTREMENT(',TRIM(YRECFM),'): OK'
ENDIF
......@@ -477,7 +482,7 @@ IF(PRESENT(PTRAJX))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJX')
ILENG = IKTRAJX*ITTRAJX*INTRAJX
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJX,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
PTRAJX,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF
!
! ou
......@@ -486,7 +491,7 @@ IF(PRESENT(PMASK))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.MASK')
ILENG = IIMASK*IJMASK*IKMASK*ITMASK*INMASK*IPMASK
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'XY',PMASK,KGRID(1), &
ILENCH,YCOMMENT,IRESPDIA)
ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF
!
! 9eme enregistrement TRAJY
......@@ -495,7 +500,7 @@ IF(PRESENT(PTRAJY))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJY')
ILENG = IKTRAJY*ITTRAJY*INTRAJY
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJY,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
PTRAJY,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF
!
! 10eme enregistrement TRAJZ
......@@ -504,7 +509,7 @@ IF(PRESENT(PTRAJZ))THEN
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJZ')
ILENG = IKTRAJZ*ITTRAJZ*INTRAJZ
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PTRAJZ,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
PTRAJZ,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
ENDIF
!
! 11eme enregistrement PDATIME
......@@ -512,7 +517,7 @@ ENDIF
YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.DATIM')
ILENG=16*IT
CALL FMWRIT(HFILEDIA,YRECFM,HLUOUTDIA,'--', &
PDATIME,KGRID(1),ILENCH,YCOMMENT,IRESPDIA)
PDATIME,KGRID(1),ILENCH,TRIM(YCOMMENT),IRESPDIA)
!
CALL MENU_DIACHRO(HFILEDIA,HLUOUTDIA,HGROUP)
LPACK=GPACK
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment