Philippe 09/06/2017: IO: name of the variable added to the name of the written field...
authorPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Fri, 9 Jun 2017 12:28:28 +0000 (14:28 +0200)
committerPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Fri, 9 Jun 2017 12:28:28 +0000 (14:28 +0200)
src/MNH/write_diachro.f90

index cbcb29e..f646a41 100644 (file)
@@ -69,6 +69,8 @@
 !!                                          MASK array in MASK case with write outside the 
 !!                                          routine.
 !!      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
@@ -113,7 +115,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
@@ -131,7 +133,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:
@@ -242,7 +244,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
 
@@ -253,7 +255,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
@@ -292,7 +294,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
@@ -314,9 +316,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
@@ -329,7 +331,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
 
@@ -345,7 +347,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
@@ -360,7 +362,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
 
@@ -376,7 +378,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
@@ -392,7 +394,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
 
@@ -408,7 +410,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
@@ -432,22 +434,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), &
-                   YCOMMENT,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),   &
-                ILENCH,YCOMMENT,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),   &
-                ILENCH,YCOMMENT,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)
@@ -457,12 +459,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
@@ -476,7 +481,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
@@ -485,7 +490,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
@@ -494,7 +499,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
@@ -503,7 +508,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
@@ -511,7 +516,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