Gaelle 01/10/2015 : adaptation pour JPHEXT=3

tools/diachro/src/DIAPRO/extract_and_open_files.f90

@@ -55,11 +55,13 @@ END MODULE MODI_EXTRACT_AND_OPEN_FILES
 !
 USE MODD_FILES_DIACHRO ! NBGUIL
 USE MODD_ALLOC_FORDIACHRO
-USE MODD_RESOLVCAR 
+USE MODD_RESOLVCAR
+USE MODD_PARAMETERS,ONLY:JPHEXT
 !USE MODD_DIM1
 !USE MODN_PARA
 !USE MODN_NCAR
 USE MODI_CREATLINK
+USE MODI_FMREAD
 !
 IMPLICIT NONE
 !
@@ -89,6 +91,8 @@ INTEGER   ::   ILU, INUM, IRESP2
 LOGICAL   ::   GPLUS
 !INTEGER           :: IIINF, IJINF, IISUP, IJSUP
 !REAL              :: ZIDEBCOU, ZJDEBCOU
+CHARACTER(LEN=20) :: YCOMMENT
+INTEGER           ::  ILENCH,ILENG,IGRID
 !------------------------------------------------------------------------------
 !
 YCARIN = HCARIN
@@ -362,16 +366,9 @@ DO J=1,NBGUIL,2 !***********************************************************
 	NUMFILECUR=NUMFILES(NBFILES)
 
 ! ouverture du listing
-        !CALL FMLOOK(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES),&
-        !            NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES)  )
-        !IF (NRESPDIAS(NBFILES) .NE. 0) THEN
-        !WRITE(YC,'(I2.2)')NBFILES
-        !CLUOUTDIAS(NBFILES)=ADJUSTL(ADJUSTR(CLUOUTDIAS(NBFILES))//YC)
-        !print *,'NBFILES CLUOUTDIAS(NBFILES) YC',NBFILES,CLUOUTDIAS(NBFILES),YC
         CALL FMATTR(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES), &
                     NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
         OPEN(UNIT=NLUOUTDIAS(NBFILES),FILE=CLUOUTDIAS(NBFILES),FORM='FORMATTED')
-        !ENDIF
         WRITE(UNIT=NLUOUTDIAS(NBFILES),FMT=1)NBFILES,' ',CFILEDIAS(NBFILES)
 	1 FORMAT(' OPEN DIACHRONIC FILE ',I2.2,A,A28)
 
@@ -397,12 +394,10 @@ DO J=1,NBGUIL,2 !***********************************************************
 
 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
 	IF(JM>=1)THEN
-!       IF(JM>1)THEN
 	  HCAROUT(1:NMGUIL(J)-1)=YCARIN(1:NMGUIL(J)-1)
-!         HCAROUT(1:JM-1)=YCARIN(1:JM-1)
-!         print *,' HCAROUT 1 ',HCAROUT
         ENDIF
-
+! READ JPHEXT
+        CALL FMREAD(CFILEDIAS(NBFILES),'JPHEXT',CLUOUTDIAS(NBFILES),ILENG,JPHEXT,IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
       ELSE    ! NBFILES/=0
 !
 ! Fichiers autres que le premier
@@ -464,8 +459,6 @@ DO J=1,NBGUIL,2 !***********************************************************
           CFILEDIAS(NBFILES)=ADJUSTL(YNAMFILE)
 
 ! Ouverture du fichier lfi et fermeture du fichier des correspondant
-          !WRITE(YC,'(I2.2)')NBFILES
-	  !CLUOUTDIAS(NBFILES)=ADJUSTL(ADJUSTR(CLUOUTDIAS(NBFILES))//YC)
           CALL FMLOOK(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES), &
                       NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
           IF (NRESPDIAS(NBFILES) .NE. 0) THEN
@@ -473,7 +466,6 @@ DO J=1,NBGUIL,2 !***********************************************************
             LPBREAD=.TRUE.
             RETURN
           ENDIF
-          !OPEN(UNIT=NLUOUTDIAS(NBFILES),FILE=CLUOUTDIAS(NBFILES),FORM='FORMATTED')
           WRITE(UNIT=NLUOUTDIAS(NBFILES),FMT=1)NBFILES,' ',CFILEDIAS(NBFILES)
 
       IF(NVERBIA>0) THEN
@@ -501,24 +493,18 @@ DO J=1,NBGUIL,2 !***********************************************************
 	IF(MAX(1,J-1) == 1)THEN
 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
 	  IDIF=NMGUIL(J)-1-1
-!         IDIF=JM-1-1
 	  IF(IDIF >0)THEN
 	    JMM=LEN_TRIM(HCAROUT)+1
 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
 	    HCAROUT(JMM:JMM+IDIF)=YCARIN(1:NMGUIL(J)-1)
-!           HCAROUT(JMM:JMM+IDIF)=YCARIN(1:JM-1)
-!           print *,' HCAROUT 2 ',HCAROUT
           ENDIF
 	ELSE
 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
 	  IDIF=NMGUIL(J)-1-(NMGUIL(MAX(1,J-1))+1)
-!         IDIF=JM-1-(NMGUIL(MAX(1,J-1))+1)
           IF(IDIF >0)THEN
 	    JMM=LEN_TRIM(HCAROUT)+1
 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
 	    HCAROUT(JMM:JMM+IDIF)=YCARIN(NMGUIL(MAX(1,J-1))+1:NMGUIL(J)-1)
-!           HCAROUT(JMM:JMM+IDIF)=YCARIN(NMGUIL(MAX(1,J-1))+1:JM-1)
-!           print *,' HCAROUT 2 ',HCAROUT
           ENDIF
 	ENDIF
 
@@ -532,16 +518,6 @@ DO J=1,NBGUIL,2 !***********************************************************
       IF(NVERBIA>0) THEN
         print *,' ** EXTRACT avant lecture de l entete de ',TRIM(CFILEDIAS(JME))
       ENDIF
-!   IIINF=NIINF; IJINF=NJINF; IISUP=NISUP; IJSUP=NJSUP
-!   ZIDEBCOU=XIDEBCOU; ZJDEBCOU=XJDEBCOU
-!   CALL INI_CST
-!   CALL READ_DIMGRIDREF(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
-!   CALL INIDEF
-!   NIMNMX=-1
-!   LMINMAX=.TRUE.
-!   CALL COMPCOORD_FORDIACHRO(0)
-!   NIINF=IIINF; NJINF=IJINF; NISUP=IISUP; NJSUP=IJSUP
-!   XIDEBCOU=ZIDEBCOU; XJDEBCOU=ZJDEBCOU
     CALL READ_FILEHEAD(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
     LFIC1=.TRUE.
 

tools/diachro/src/EXTRACTDIA/readvar.f90

@@ -72,7 +72,7 @@
 !              ------------
 !
 ! modules MesoNH
-USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_PARAMETERS, ONLY: XUNDEF,JPHEXT
 USE MODD_DIM1, ONLY: NIMAX,NJMAX,NKMAX
 USE MODD_GRID1, ONLY: XZZ
 ! modules DIACHRO
@@ -267,6 +267,9 @@ IF ( HFLAGFILE(1:3) == 'OPE' ) THEN
 !! ne pas relacher unite logique car compute_r00_pc doit fermer (avec FMCLOS)
 !!le fic.  d entree qui a ete amende des var. Lag.
 !
+! READ JPHEXT
+    CALL FMREAD(CFILEDIAS(NBFILES),'JPHEXT',CLUOUTDIAS(NBFILES),1,JPHEXT,IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
+
 !*       3.1   Reading head of file
 !              --------------------
 !      

tools/diachro/src/FM2DIA/read_dimgridref_fm2dia.f90

@@ -167,6 +167,10 @@ NLENG=1
 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,NBUGFIX,NGRID,NLENCH,CCOMMENT,NRESP)
 IF (NRESP /=0 ) NBUGFIX=0
 !
+CRECFM='JPHEXT'
+NLENG=1
+CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,JPHEXT,NGRID,NLENCH,CCOMMENT,NRESP)
+IF (NRESP /=0 ) JPHEXT=1
 !*	 1.7   Allocates the first bunch of input arrays
 !
 !*       1.7.1  Local variables :

tools/diachro/src/mesonh/write_lfifm1_fordiachro_cv.f90

@@ -265,6 +265,13 @@ IGRID=0
 ILENCH=LEN(YCOMMENT)
 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NKMAX,IGRID,ILENCH,YCOMMENT,IRESP)
 !
+YRECFM='JPHEXT'
+CALL ELIM(YRECFM)
+YCOMMENT=' '
+ILENG=1
+IGRID=0
+ILENCH=LEN(YCOMMENT)
+CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,JPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
 !*       1.2    Grid variables :
 !
 IF (.NOT.LCARTESIAN) THEN

tools/diachro/src/mesonh_MOD/modd_parameters.f90

@@ -38,7 +38,7 @@
 !
 IMPLICIT NONE
 !
-INTEGER, PARAMETER :: JPHEXT = 1      ! Horizontal External points number
+INTEGER, SAVE :: JPHEXT = 1      ! Horizontal External points number
 INTEGER, PARAMETER :: JPVEXT = 1      ! Vertical External points number
 INTEGER, PARAMETER :: JPMODELMAX = 8  ! Maximum allowed number of nested models 
 INTEGER, PARAMETER :: JPCPLFILEMAX = 8 ! Maximum allowed number of CouPLing FILEs 

tools/fmmore/src/readuntouch.f90

@@ -22,7 +22,7 @@ CHARACTER(LEN=*),INTENT(IN) :: HFMFILE,HLUOUT
 !
 !*       0.2    Declarations of local variables
 !
-INTEGER :: IGRID,ILENCH,IRESP,NIMAX,NJMAX,NKMAX,IXOR,IYOR
+INTEGER :: IGRID,ILENCH,IRESP,NIMAX,NJMAX,NKMAX,IXOR,IYOR,JPHEXT
 INTEGER :: ILENG ! en attendant une surcouche officielle...
 INTEGER :: NMASDEV,NBUGFIX,NVERSION_SURFEX,NBUGFIX_SURFEX
 CHARACTER(LEN=100) :: YCOMMENT
@@ -101,6 +101,19 @@ IF (IRESP.EQ.0) THEN
   WRITE(6,*) '####'
 END IF
 !
+IF (NMASDEV>=52) THEN
+  YRECFM='JPHEXT'
+  CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,JPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
+  IF (IRESP.EQ.0) THEN
+    WRITE(6,*) '####  JPHEXT = ',JPHEXT
+    WRITE(6,*) '####'
+  END IF
+ELSE
+  JPHEXT=1
+    WRITE(6,*) '####  JPHEXT = ',JPHEXT
+    WRITE(6,*) '####'
+END IF
+!
 YRECFM='SURF'
 IF (NMASDEV>=46) THEN
   CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,CSURF,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -108,49 +121,50 @@ IF (NMASDEV>=46) THEN
     WRITE(6,*) '####  SURF = ',CSURF
     WRITE(6,*) '####'
   END IF
-    CALL FMREAD(HFMFILE,'DIM_FULL',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
-
-YRECFM='VERSION'
-! en attendant une surcouche officielle...
-CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,NVERSION_SURFEX,IGRID,ILENCH,YCOMMENT,IRESP)
-IF (IRESP.EQ.0) THEN
-  WRITE(6,*) '#### SURFEX VERSION = ',NVERSION_SURFEX
-  WRITE(6,*) '####'
-END IF
-
-YRECFM='BUG'
-! en attendant une surcouche officielle...
-CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,NBUGFIX_SURFEX,IGRID,ILENCH,YCOMMENT,IRESP)
-IF (IRESP.EQ.0) THEN
-  WRITE(6,*) '#### SURFEX BUGFIX = ',NBUGFIX_SURFEX
-  WRITE(6,*) '####'
-END IF
-
-    IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  DIM_FULL = ',IXOR
-    END IF
-    CALL FMREAD(HFMFILE,'DIM_NATURE',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
-    IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  DIM_NATURE = ',IXOR
-    END IF
-    CALL FMREAD(HFMFILE,'DIM_SEA',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
-    IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  DIM_SEA = ',IXOR
-    END IF
-    CALL FMREAD(HFMFILE,'DIM_TOWN',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+  
+  IF (CSURF=="EXTE") THEN
+    YRECFM='VERSION'
+    ! en attendant une surcouche officielle...
+    CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,NVERSION_SURFEX,IGRID,ILENCH,YCOMMENT,IRESP)
     IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  DIM_TOWN = ',IXOR
+      WRITE(6,*) '#### SURFEX VERSION = ',NVERSION_SURFEX
+      WRITE(6,*) '####'
     END IF
-    CALL FMREAD(HFMFILE,'DIM_WATER',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+
+    YRECFM='BUG'
+    ! en attendant une surcouche officielle...
+    CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,NBUGFIX_SURFEX,IGRID,ILENCH,YCOMMENT,IRESP)
     IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  DIM_WATER = ',IXOR
+      WRITE(6,*) '#### SURFEX BUGFIX = ',NBUGFIX_SURFEX
       WRITE(6,*) '####'
-    END IF 
-    CALL FMREAD(HFMFILE,'ECOCLIMAP',HLUOUT,ILENG,LECOCLIMAP,IGRID,ILENCH,YCOMMENT,IRESP)
+    END IF
+    CALL FMREAD(HFMFILE,'DIM_FULL',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
     IF (IRESP.EQ.0) THEN
-      WRITE(6,*) '####  ECOCLIMAP = ',LECOCLIMAP
-      WRITE(6,*) '####'
+      WRITE(6,*) '####  DIM_FULL = ',IXOR
     END IF
+!    CALL FMREAD(HFMFILE,'DIM_NATURE',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+!    IF (IRESP.EQ.0) THEN
+!      WRITE(6,*) '####  DIM_NATURE = ',IXOR
+!    END IF
+!    CALL FMREAD(HFMFILE,'DIM_SEA',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+!    IF (IRESP.EQ.0) THEN
+!      WRITE(6,*) '####  DIM_SEA = ',IXOR
+!    END IF
+!    CALL FMREAD(HFMFILE,'DIM_TOWN',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+!    IF (IRESP.EQ.0) THEN
+!      WRITE(6,*) '####  DIM_TOWN = ',IXOR
+!    END IF
+!    CALL FMREAD(HFMFILE,'DIM_WATER',HLUOUT,ILENG,IXOR,IGRID,ILENCH,YCOMMENT,IRESP)
+!    IF (IRESP.EQ.0) THEN
+!      WRITE(6,*) '####  DIM_WATER = ',IXOR
+!      WRITE(6,*) '####'
+!    END IF 
+!    CALL FMREAD(HFMFILE,'ECOCLIMAP',HLUOUT,ILENG,LECOCLIMAP,IGRID,ILENCH,YCOMMENT,IRESP)
+!    IF (IRESP.EQ.0) THEN
+!      WRITE(6,*) '####  ECOCLIMAP = ',LECOCLIMAP
+!      WRITE(6,*) '####'
+!    END IF
+  END IF
 END IF
 !
 IF (NMASDEV>=46) THEN
@@ -303,7 +317,7 @@ IF (.NOT.LCARTESIAN) THEN
 END IF 
 ! 
 YRECFM='XHAT'
-ALLOCATE(XXHAT(NIMAX+2))
+ALLOCATE(XXHAT(NIMAX+2*JPHEXT))
 ! en attendant une surcouche officielle...
 !CALL FMREAD(HFMFILE,YRECFM,HLUOUT,'--',XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
 ILENG=SIZE(XXHAT)
@@ -312,7 +326,7 @@ WRITE(6,*) '####  X mesh = ',XXHAT(2)-XXHAT(1)
 WRITE(6,*) '####  XHAT(1:2) = ',XXHAT(1),XXHAT(2)
 !
 YRECFM='YHAT'
-ALLOCATE(XYHAT(NJMAX+2))
+ALLOCATE(XYHAT(NJMAX+2*JPHEXT))
 ! en attendant une surcouche officielle...
 !CALL FMREAD(HFMFILE,YRECFM,HLUOUT,'--',XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
 ILENG=SIZE(XYHAT)
@@ -370,9 +384,6 @@ IF (CSTORAGE_TYPE /='PG' .AND. CSTORAGE_TYPE/='SU') THEN
   END IF
 END IF
 !
-    YRECFM='CH_EMIS'
-    CALL FMREAD(HFMFILE,YRECFM,HLUOUT,ILENG,LSLEVE,IGRID,ILENCH,YCOMMENT,IRESP)
-    WRITE(6,*) '####  LCH_EMIS = ',LSLEVE
 
 IF (CSTORAGE_TYPE /='PG' .AND. CSTORAGE_TYPE/='SU') THEN
 !