Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • mesonh/mesonh-code
  • quentin.rodier/mesonh-code-fork
  • benoit.vie/mesonh-code
  • joris.pianezze/mesonh-code
  • 8qq4g5s7/mesonh-code
  • jean.baptiste.filippi/meso-nh-fire-code
  • fdl68d9p/mesonh-code-sophia
7 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 8806 additions and 0 deletions
LIBTOOLS/tools/diachro/Rules.LXpgf90 0 → 100644
View file @ 6bb35ca8
LIBX = -L/usr/X11R6/lib -lX11 -lg2c
LIBV5D = -L/usr/local/lib -lv5d
LIBGRB = -L$(HOME)/make/gribex -lMvEmos_pgf
#LIBGRB = -L$(HOME)/make/gribex/gribex13035 -lemos
#############################################################################
CPPFLAGS += -DLINUX -Dkey_swapio
F77FLAGS +=
F90FLAGS +=
ifeq ($(B),64)
F77FLAGS += -r8
F90FLAGS += -r8
endif
LDFLAGS +=
OBJS2=
LIBTOOLS/tools/diachro/Rules.SGI32 0 → 100644
View file @ 6bb35ca8
LIBX = -lX11
LIBV5D = -L$(DIR_LIB)/vis5d/$(ARCH) -lv5d
#LIBV5D = /scratch/us/usl/vis5d-5.2/src/v5d.o \
# /scratch/us/usl/vis5d-5.2/src/binio.o
LIBGRB = -lemos
#############################################################################
CPPFLAGS += -DO2000
ifeq ($(shell hostname),rhodes)
CPPFLAGS += -DRHODES
endif
F77FLAGS += -O1
F90FLAGS += -O1
ifeq ($(B),64)
F90FLAGS += -r8
endif
LDFLAGS +=
OBJS2 =
LIBTOOLS/tools/diachro/Rules.SGI64 0 → 100644
View file @ 6bb35ca8
LIBEXT = -lX11
#############################################################################
CPPFLAGS += -DO2000
ifeq ($(shell hostname),rhodes)
CPPFLAGS += -DRHODES
endif
F77FLAGS += -O1
F90FLAGS += -O1
ifeq ($(B),64)
F90FLAGS += -r8
endif
OBJS2=
LIBTOOLS/tools/diachro/Rules.SX5 0 → 100644
View file @ 6bb35ca8
#
# Pas de diaprog sur SX5
#
PROGALL = conv2dia
#
#############################################################################
CPPFLAGS += -DVPP
F77FLAGS +=
F90FLAGS +=
LDFLAGS +=
OBJS2=
LIBTOOLS/tools/diachro/Rules.SX8 0 → 100644
View file @ 6bb35ca8
#
# Pas de diaprog sur SX5
#
PROGALL = conv2dia
#
#############################################################################
CPPFLAGS += -DVPP
F77FLAGS +=
ifeq ($(B),64)
F90FLAGS += -dw -Wf, ' -A dbl4 '
endif
LDFLAGS +=
OBJS2=
LIBTOOLS/tools/diachro/Rules.VPP 0 → 100644
View file @ 6bb35ca8
LIBGRB = -L/usr/local/lib -lemos_000200
LIBV5D = -L$(MESONH)/binaries -lv5d_v51
#LIBV5D = -L$(MESONH)/binaries -lv5d_v51 -L/usr/local/lib -lemosR64_1303g
#############################################################################
PROGALL = conv2dia lfi2grb
CPPFLAGS += -DVPP
ifeq ($(B),64)
F77FLAGS += -Ad
F90FLAGS += -Ad
endif
LDFLAGS += -Wl,-zdummy_verbose
OBJS2=
LIBTOOLS/tools/diachro/src/DIAPRO/alloc2_fordiachro.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_ALLOC2_FORDIACHRO
! ##############################
!
INTERFACE
!
SUBROUTINE ALLOC2_FORDIACHRO(KOP)
INTEGER :: KOP
END SUBROUTINE ALLOC2_FORDIACHRO
!
END INTERFACE
!
END MODULE MODI_ALLOC2_FORDIACHRO
! ######spl
SUBROUTINE ALLOC2_FORDIACHRO(KOP)
! #################################
!
!!**** *ALLOC2_FORDIACHRO* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 08/01/96
!! Updated PM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ALLOC_FORDIACHRO
USE MODD_ALLOC2_FORDIACHRO
USE MODD_RESOLVCAR
USE MODD_PT_FOR_CH_FORDIACHRO
USE MODD_FILES_DIACHRO
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
INTEGER :: KOP
!
!* 0.1 Local variables
! ---------------
!
!------------------------------------------------------------------------------
!
IF (KOP == 1)THEN
ALLOCATE(XDATIME2(SIZE(XDATIME,1),SIZE(XDATIME,2)))
XDATIME2(:,:)=XDATIME(:,:)
ALLOCATE(XVAR2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3), &
SIZE(XVAR,4),SIZE(XVAR,5),SIZE(XVAR,6)))
XVAR2(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
! print *,' XVAR2 ',XVAR2
IF(ALLOCATED(XU))THEN
ALLOCATE(XUMEM(SIZE(XU,1),SIZE(XU,2),SIZE(XU,3), &
SIZE(XU,4),SIZE(XU,5),SIZE(XU,6)))
XUMEM(:,:,:,:,:,:)=XU(:,:,:,:,:,:)
if(nverbia > 0)THEN
print *,' ** ALLOC2 XUMEM alloue'
endif
ENDIF
IF(ALLOCATED(XV))THEN
ALLOCATE(XVMEM(SIZE(XV,1),SIZE(XV,2),SIZE(XV,3), &
SIZE(XV,4),SIZE(XV,5),SIZE(XV,6)))
XVMEM(:,:,:,:,:,:)=XV(:,:,:,:,:,:)
ENDIF
ALLOCATE(XTRAJT2(SIZE(XTRAJT,1),SIZE(XTRAJT,2)))
XTRAJT2(:,:)=XTRAJT(:,:)
ALLOCATE(NGRIDIA2(SIZE(NGRIDIA)))
NGRIDIA2(:)=NGRIDIA(:)
ALLOCATE(CTITRE2(SIZE(CTITRE)))
CTITRE2(:)(1:LEN(CTITRE2))=' '
CTITRE2(:)=CTITRE(:)
ALLOCATE(CUNITE2(SIZE(CUNITE)))
CUNITE2(:)(1:LEN(CUNITE2))=' '
CUNITE2(:)=CUNITE(:)
ALLOCATE(CCOMMENT2(SIZE(CCOMMENT)))
CCOMMENT2(:)(1:LEN(CCOMMENT2))=' '
CCOMMENT2(:)=CCOMMENT(:)
IF(ALLOCATED(XTRAJX))THEN
ALLOCATE(XTRAJX2(SIZE(XTRAJX,1),SIZE(XTRAJX,2),SIZE(XTRAJX,3)))
XTRAJX2(:,:,:)=XTRAJX(:,:,:)
ENDIF
IF(ALLOCATED(XTRAJY))THEN
ALLOCATE(XTRAJY2(SIZE(XTRAJY,1),SIZE(XTRAJY,2),SIZE(XTRAJY,3)))
XTRAJY2(:,:,:)=XTRAJY(:,:,:)
ENDIF
IF(ALLOCATED(XTRAJZ))THEN
ALLOCATE(XTRAJZ2(SIZE(XTRAJZ,1),SIZE(XTRAJZ,2),SIZE(XTRAJZ,3)))
XTRAJZ2(:,:,:)=XTRAJZ(:,:,:)
ENDIF
IF (ALLOCATED(XMASK))THEN
ALLOCATE(XMASK2(SIZE(XMASK,1),SIZE(XMASK,2),SIZE(XMASK,3), &
SIZE(XMASK,4),SIZE(XMASK,5),SIZE(XMASK,6)))
XMASK2(:,:,:,:,:,:)=XMASK(:,:,:,:,:,:)
ENDIF
NUMFILECUR2=NUMFILECUR
ELSE
IF (ALLOCATED(XMASK2))THEN
DEALLOCATE(XMASK2)
ENDIF
IF (ALLOCATED(XTRAJZ2))THEN
DEALLOCATE(XTRAJZ2)
ENDIF
IF (ALLOCATED(XTRAJY2))THEN
DEALLOCATE(XTRAJY2)
ENDIF
IF (ALLOCATED(XTRAJX2))THEN
DEALLOCATE(XTRAJX2)
ENDIF
DEALLOCATE(CCOMMENT2,CUNITE2,CTITRE2)
IF(ALLOCATED(NGRIDIA2))THEN
DEALLOCATE(NGRIDIA2)
ENDIF
DEALLOCATE(XTRAJT2)
! DEALLOCATE(XVAR2,XTRAJT2,CTITRE2,CUNITE2,CCOMMENT2)
IF(ALLOCATED(XVMEM))THEN
DEALLOCATE(XVMEM)
ENDIF
IF(ALLOCATED(XUMEM))THEN
DEALLOCATE(XUMEM)
if(nverbia > 0)THEN
print *,' ** ALLOC2 XUMEM desalloue'
endif
ENDIF
DEALLOCATE(XVAR2)
DEALLOCATE(XDATIME2)
ENDIF
!
!-----------------------------------------------------------------------------
!
!* 2. EXITS
! -----
!
RETURN
END SUBROUTINE ALLOC2_FORDIACHRO
LIBTOOLS/tools/diachro/src/DIAPRO/axelogpres.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE AXELOGPRES(PHMIN,PHMAX)
! ##################################
!
!!**** *AXELOGPRES* -
!!****
!!
!! PURPOSE
!! -------
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 20/10/2000
!! Updated PM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!USE MODD_RESOLVCAR
USE MODD_PVT
!
IMPLICIT NONE
!
!* 0.1 Dummy arguments and results
!
REAL :: PHMIN,PHMAX
!
!* 0.2 Local variables
!
INTEGER :: J, JA, ID
!
REAL :: ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
CHARACTER(LEN=5) :: YCAR
!
!-------------------------------------------------------------------------------
!
CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
IF(LPRESY)THEN
IF(XPMAX /= 0. .AND. XPMIN /= 0. .AND. XPINT /= 0.)THEN
IF(XPMIN < 1300.)THEN
XPMAX=XPMAX*100.
XPMIN=XPMIN*100.
XPINT=XPINT*100.
ENDIF
DO J=INT(XPMIN),INT(XPMAX),-INT((ABS(XPINT)))
IF(FLOAT(J) >= ANINT(ZWT) .AND. FLOAT(J) <= ANINT(ZWB))THEN
YCAR=' '
IF(XPINT > 1000.)THEN
WRITE(YCAR,'(F5.0)')FLOAT(J)/100.
ELSE
WRITE(YCAR,'(F5.0)')FLOAT(J)
ENDIF
YCAR=ADJUSTR(YCAR)
CALL PLCHHQ(ZWL-ZWL/110.,FLOAT(J),YCAR,13.,0.,1.)
CALL FRSTPT(ZWL,FLOAT(J))
CALL VECTOR(ZWL+(ZWR-ZWL)/(ZVR-ZVL)*.015,FLOAT(J))
ENDIF
ENDDO
ELSE
IF(PHMIN < 1300)THEN
PHMIN=PHMIN*100
PHMAX=PHMAX*100
ENDIF
DO J=INT(PHMIN),INT(PHMAX),-10000
IF(FLOAT(J) >= ANINT(ZWT) .AND. FLOAT(J) <= ANINT(ZWB))THEN
YCAR=' '
IF(PHMAX > 1300.)THEN
WRITE(YCAR,'(F5.0)')FLOAT(J)/100.
ELSE
WRITE(YCAR,'(F5.0)')FLOAT(J)
ENDIF
YCAR=ADJUSTR(YCAR)
print *,' **axelogpres PHMIN,PHMAX ',PHMIN,PHMAX
print *,' **axelogpres ZWL-ZWL/20.,FLOAT(J),YCAR ',ZWL-ZWL/20.,FLOAT(J),YCAR
CALL PLCHHQ(ZWL-ZWL/100.,FLOAT(J),YCAR,13.,0.,1.)
CALL FRSTPT(ZWL,FLOAT(J))
CALL VECTOR(ZWL+(ZWR-ZWL)/(ZVR-ZVL)*.015,FLOAT(J))
ENDIF
ENDDO
ENDIF
ELSE
ENDIF
!* 2. EXIT
! ----
!
RETURN
END SUBROUTINE AXELOGPRES
LIBTOOLS/tools/diachro/src/DIAPRO/bcgrd_fordiachro.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE BCGRD_FORDIACHRO(K)
! ##############################
!
!!**** *BCGRD* - Displays a cartographic background in horizontal mode
!!
!! PURPOSE
!! -------
! Displays a cartographic background for horizontal cross-section
! contour or arrow maps when the cartographic projection option is
! active.
! The geographical display window is defined, a grid of latitude-
! longitude lines, a set of continental/state outlines and, optionaly,
! a series of landmarks, are plotted on this background.
!
!!** METHOD
!! ------
!!
!! The conformal projection routines of MODE_GRIDPROJ are used to
!! compute the latitude-longitude coordinates of the display box.
!! Next, the NCAR Ezmap projection parameters are set up to
!! correspond to the Meso-NH projection, and a grid of latitude-
! longitude lines, a set of continental/state outlines and, optionaly,
! a series of landmarks, are plotted as an overlay on the current map.
!!
!! EXTERNAL
!! --------
!!
!! MAPSTI ! set an NCAR parameter to a valuei, type INTEGER !
!! MAPSTC ! (cartographic projection package) CHARACTER !
!! MAPROJ selects a type cartographic projection !
!! MAPDRW draws a map as specified by the user parameter !
!! choice !
!! MAPIT draws a polyline on a map, using map coordinates ! NCAR
!! MAPIQ terminates a line drawn by MAPIT !
!! MAPSET defines the plot window using map coordinates !
!! MAPTRN projects a point onto a geographic map using !
!! latitude-longitude to locate the point !
!! !
!! PWRITX prints a text !
!! LABMOD defines the axes label formats (paired with PERIM) !Routines
!! GRIDAL draws grid lines and labels !
!! PERIM draws an unlabeled plot perimeter !
!! SET defines the plot window and viewport using user !
!! and normalized NCAR coordinates !
!! GETSET retrieves the NCAR and user coordinate definitions !
!! PLCHHQ high quality printing facility !
!! GSCLIP clips the plot using the window limits !
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_NMGRID : declares global variable NMGRID
!! NMGRID : Current MESO-NH grid indicator
!!
!! Module MODE_GRIDPROJ: packages a set of cartographic
!! module-procedures
!! SM_LATLON : to compute geographic from conformal (cartographic)
!! cartesian coordinates;
!! SM_XYHAT : to compute conformal (cartographic) cartesian from
!! geographic coordinates;
!! LATREF2 : to compute the second reference latitude
!! in the case of Lambert conformal projection
!!
!! Module MODD_COORD : declares gridpoint coordinates (TRACE use)
!! XXX,XXY : coordinate values FOR ALL the MESO-NH grids
!!
!! Module MODD_GRID1 : declares grid variables (Model module)
!! XXHAT, XYHAT : x, y cartographic coordinates of the model grid
!! XLONOR,XLATOR : longitude and latitude of the (1,1,1) point of
!! the model mass grid
!!
!! Module MODD_GRID : declaration of grid variables for all models
!! XLON0,XLAT0 : reference longitude and latitude for the conformal
!! projection
!! XBETA,XRPK : rotation angle and projection parameter for the
!! conformal projection
!! Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
!! (former NCAR common)
!! NIFDC : Coastline data style (0 none, 1 NCAR, 2 IGN)
!! NLPCAR : Number of land-mark points to be plotted
!! XLONCAR : Longitude of land-mark points
!! XLATCAR : Latitude of land-mark points
!!
!! Module MODN_PARA : Defines NAM_DOMAIN_POS namelist (former PARA common)
!! Module MODD_DIM1 : contains dimensions of data arrays
!! NIINF, NISUP : lower and upper bounds of arrays
!! to be plotted in x direction
!! NJINF, NJSUP : lower and upper bounds of arrays
!! to be plotted in y direction
!!
!! REFERENCE
!! ---------
!!
!! MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
!! + Book1: Concepts and Fundamentals, to appear in 1994;
!! + Book2: Technical Reference and Flowcharts, to appear in 1994;
!! + Book3: Tutorial, November 1994.
!!
!! NCAR Graphics Technical documentation, UNIX version 3.2,
!! Scientific computing division, NCAR/UCAR, Boulder, USA.
!! Volume 1: Fundamentals, Vers. 1, May 1993
!! Volume 2: Contouring and mapping tutorial, Vers. 2, May 1993
!!
!!
!! AUTHOR
!! ------
!!
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 06/06/94
!! Updated PM 12/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_NMGRID
USE MODD_RADAR
USE MODE_GRIDPROJ
USE MODD_COORD
USE MODD_MASK3D
USE MODD_TRAJ3D
USE MODD_RESOLVCAR
USE MODD_GRID1
USE MODD_GRID
USE MODD_CTL_AXES_AND_STYL
USE MODN_NCAR
USE MODN_PARA
USE MODI_CREATLINK
USE MODI_WRITEDIR
IMPLICIT NONE
COMMON/EPAISCONT/ZLWCONT
COMMON/FDC/IFDC
INTEGER :: K
!
!* 0.1 Local variables
!
REAL :: ZLWCONT
REAL :: ZLAT2, ZLAT, ZLON
REAL,SAVE :: ZZLAT, ZZLON
REAL :: ZPL1, ZPL2, ZPL3, ZPL4
REAL :: ZX1, ZX2, ZY1, ZY2, ZXX1, ZXX2, ZYY1, ZYY2
REAL :: ZU, ZV, ZSZ, ZPOS, ZCENT
REAL :: ZI, ZJ, ZX, ZY
INTEGER :: ICONVI, ICONVJ
REAL :: ZXMIN, ZXMAX,ZYMIN, ZYMAX
REAL :: ZWIDTH
CHARACTER(LEN=40),SAVE :: YCAR40=' '
CHARACTER(LEN=80),SAVE :: YCAR80=' '
CHARACTER(LEN=1) :: YSYMB
CHARACTER(LEN=20) :: YNOM
CHARACTER(LEN=10) :: FORMAX, FORMAY
INTEGER :: JIP, IT, IDUM, IRPK, JLPCAR,JIJCAR, J,IIT
INTEGER :: IERR, IPOS, ICOLS, ICOLN
INTEGER :: IFDC
!!!!!!!!!!!!!! Modif VD (29/10/2003)
INTEGER :: IDOT,IPT,IDOT0,IPT0,JLOOP
REAL, DIMENSION(200000) :: ZZU,ZZV,ZZU0,ZZV0
!!!!!!!!!!!!!! fin Modif VD
LOGICAL :: GIND,GCONF
!
!-------------------------------------------------------------------------------
!
!* 1. SETS CARTOGRAPHIC PROJECTION AND DRAWS BACKGROUND MAP
! -----------------------------------------------------
!
!
!* 1.1 If Lambert case, computes the second reference latitude
! (required by the NCAR framework for Lambert)
!
IF(L2CONT)THEN
IFDC=NIFDC
ELSE
IF(K == 1)THEN
IFDC=0
ELSE
IFDC=NIFDC
ENDIF
ENDIF
!!!!IFDC=NIFDC
IF(ABS(XRPK).GT.0..AND.ABS(XRPK).LT.1.)THEN
IF(NVERBIA >= 5)THEN
print *,' bcgrd XLAT0,XRPK ',XLAT0,XRPK
ENDIF
ZLAT2=LATREF2(XLAT0,XRPK)
IF(NVERBIA >= 5)THEN
print *,' bcgrd ZLAT2 ',ZLAT2
ENDIF
ENDIF
!
!* 1.2 Convert display window diagonal to cartographic coordinates
!
! (The main diagonal of the displayed domain is given by Meso-NH
! indexes NIINF-NJINF, NISUP-NJSUP)
!
!ZXMIN=100000.
ZXMIN=XXX(NIINF,NMGRID)
ZYMIN=XXY(NJINF,NMGRID)
!ZXMAX=2500000.
ZXMAX=XXX(NISUP,NMGRID)
ZYMAX=XXY(NJSUP,NMGRID)
IF(NVERBIA >= 2)THEN
print *,' ** bcg NIINF,NJINF,NMGRID,NISUP,NJSUP ',NIINF,NJINF,NMGRID,NISUP,NJSUP
ENDIF
!
CALL SM_LATLON_S(XLATORI,XLONORI,ZXMIN,ZYMIN,ZPL1,ZPL2)
CALL SM_LATLON_S(XLATORI,XLONORI,ZXMAX,ZYMAX,ZPL3,ZPL4)
IF(NVERBIA >= 2)THEN
print *,' ZXMIN,ZYMIN,ZXMAX,ZYMAX ',ZXMIN,ZYMIN,ZXMAX,ZYMAX
print *,' XLATORI,XLONORI,ZPL1,ZPL2,ZPL3,ZPL4 ',XLATORI,XLONORI,ZPL1,ZPL2,ZPL3,ZPL4
print *,' XLATO,XLONO ',XLAT0,XLON0
ENDIF
!
!* 1.3 Selects a standard NCAR continental/state outline mode
!* and visual details
!
! -> NCAR default : call mapstc('OU','PO')
! -> None : call mapstc('OU','NO')
!
!IF (NIFDC.NE.1)THEN
IF (NIFDC.EQ.1 .OR. NIFDC.EQ.3)THEN
CALL MAPSTC('OU','PO')
ELSE
CALL MAPSTC('OU','NO')
ENDIF
!
CALL MAPSTI('DO',0) ! Solid coastlines
!CALL MAPSTI('DO',1) ! Dotted coastlines
CALL MAPSTI('RE',10000) ! Plotter resolution
CALL MAPSTI('DL',0) ! MAPIT draws solid lines
!CALL MAPSTI('DL',1) ! MAPIT draws dotted lines
!CALL MAPSTI('GR',NIGRNC) ! Grid spacing in degrees
if(nverbia > 0)then
print *,' **bcgrd AV CALL MAPSTI(GR,0)'
endif
IF(K == 1)THEN
CALL MAPSTI('GR',0) ! Grid spacing in degrees
ELSE IF(K == 2)THEN
IF(LANIMK )THEN
ELSE
CALL MAPSTI('GR',NIGRNC) ! Grid spacing in degrees
ENDIF
ENDIF
!
!* 1.4 Selects NCAR cartographic projection
!
IRPK=2
IF(XRPK.EQ.0.)IRPK=0
! Oct 99 Pole Sud Proj. stereog.
IF(ABS(XRPK).EQ.1.)IRPK=1
! Oct 99 Pole Sud Proj. stereog.
!IF(XRPK.EQ.1.)IRPK=1
!write(0,*)' BCGRD IRPK ',IRPK
!
SELECT CASE(IRPK)
CASE(0)
CALL MAPROJ('ME',0.,XLON0,XBETA) ! Mercator
CASE(1)
CALL MAPROJ('ST',90.,XLON0,-XBETA) ! Polar Stereographic
! Oct 99 Pole Sud Proj. stereog.
! BESOIN DE VERIFIER si dans ce cas on met XBETA ou -XBETA
IF(XRPK < 0.)CALL MAPROJ('ST',-90.,XLON0,-XBETA)
! Oct 99 Pole Sud Proj. stereog.
CASE DEFAULT
CALL MAPROJ('LC',XLAT0,XLON0+XBETA/XRPK,ZLAT2) ! Lambert
END SELECT
!
!* 1.5 Sets map transformation, map display window
!* and draws lat-lon grid
!
IF(LVPTUSER)THEN
CALL MAPPOS(XVPTL,XVPTR,XVPTB,XVPTT)
ELSE
CALL MAPPOS(.05,.95,.05,.95)
ENDIF
CALL MAPSET('CO',ZPL1,ZPL2,ZPL3,ZPL4)
IF(XLWCONT /= 0.)THEN
ZLWCONT=XLWCONT
ELSE
ZLWCONT=5.
ENDIF
!
! Pour V4.1.1 A la place de CALL MAPDRW a mettre en commentaire
! Non c'est fait EN PRINCIPE dans MAPDRW qui est inclus dans le fichier frame
!CALL MAPINT
!CALL MAPGRD
!CALL MAPLBL
!CALL MPLNDR('Earth..1',3)
if(nverbia > 0)then
print *,' **bcgrd AV CALL MAPDRW'
endif
CALL MAPDRW
!
!* 1.6 Use of non-NCAR coastline data sets if available
!* (ex. IGN ones) on fortran unit 1
!
! NOTICE: The use of fortran unit 1 here does not
! fit Meso-NH file access norm
!
IF((NIFDC.EQ.2 .OR. NIFDC.EQ.3) .AND. K.EQ.2)THEN
IF(YCAR40(1:LEN(YCAR40)) == ' ')THEN
print *,'ENTREZ le nom du fichier des contours (geograp. ou polit....) '
!print *,' avec un PATH ABSOLU (40 caracteres maximum) et entre quotes'
print *,' entre quotes (40 caracteres maximum)'
READ(5,*)YCAR40
YCAR40=ADJUSTL(YCAR40)
YCAR80(1:1)="'"
YCAR80(2:LEN_TRIM(YCAR40)+1)=YCAR40(1:LEN_TRIM(YCAR40))
YCAR80(LEN_TRIM(YCAR40)+2:LEN_TRIM(YCAR40)+2)="'"
!WRITE(NDIR,'(A80)')YCAR80
CALL WRITEDIR(NDIR,YCAR80)
CALL CREATLINK('DIRFDC',YCAR40(1:LEN_TRIM(YCAR40)),'CREAT',NVERBIA)
! print *,YCAR40
ENDIF
OPEN(1,FILE=YCAR40(1:LEN_TRIM(YCAR40)),FORM='FORMATTED',STATUS='OLD') ! Opens coastline file
! OPEN(1,FILE='/u/m/mrmh/mrmh005/mesonh/data/cotign') ! Opens coastline file
CALL GSCLIP(0)
CALL GQLWSC(IERR,ZWIDTH)
IF(XLWCONT /= 0.)THEN
ZLWCONT=XLWCONT
ELSE
ZLWCONT=4.
ENDIF
CALL GSLWSC(ZLWCONT)
!
!!!!!!!!! MODIF VD TO introduce dashed lines with NIFDC=2 (29/10/2003)
! Initial coordinate transformation saved
CALL GETSET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
! Initial coordinate transformation restored
CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,IDUM)
IPT=0
IPT0=0
IDOT=838860 ! dashed pattern used for dashed lines (IT=2 or 3)
IDOT0=65535 ! dashed pattern used for solid lines (IT=0 or 1)
DO JIP=1,200000
READ(1,*,END=50)ZLAT,ZLON,IT ! Reads coastline file
IF(JIP == 1)print *,' 1er enr. ',ZLAT,ZLON,IT
! IF(ABS(ZZLAT-ZLAT) > .2 .OR. ABS(ZZLON-ZLON) > .2)THEN
! print *,'ZZLAT,ZLAT,ZZLON,ZLON ',ZZLAT,ZLAT,ZZLON,ZLON
! IT=0
! CALL MAPIT(ZLAT,ZLON,IT) ! Draws IGN one coastline point
! ELSE
! CALL MAPIT(ZLAT,ZLON,IT) ! Draws IGN one coastline point
! ENDIF
!ZZLAT=ZLAT
!ZZLON=ZLON
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
!
IF (IT==2 .OR. IT==3) THEN
IF (IT==2) THEN
IF (IPT>0) THEN
CALL DASHDB(IDOT)
CALL CURVED(ZZU,ZZV,IPT)
ENDIF
IPT=0
IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
IPT=IPT+1
ZZU(IPT)=ZU
ZZV(IPT)=ZV
ENDIF
ELSE
IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
IPT=IPT+1
ZZU(IPT)=ZU
ZZV(IPT)=ZV
END IF
ENDIF
ELSE
IF (IT==0) THEN ! begin of the definition of the
IF (IPT0>0) THEN
CALL DASHDB(IDOT0)
CALL CURVED(ZZU0,ZZV0,IPT0)
ENDIF
IPT0=0
IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
IPT0=IPT0+1
ZZU0(IPT0)=ZU
ZZV0(IPT0)=ZV
ENDIF
ELSE
IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
IPT0=IPT0+1
ZZU0(IPT0)=ZU
ZZV0(IPT0)=ZV
END IF
ENDIF
ENDIF
!
ENDDO
50 CONTINUE
! finish to draw the last curves :
print *,' Dernier enr. ',ZLAT,ZLON,IT
!CALL MAPIQ
IF (IPT>0) THEN
CALL DASHDB(IDOT)
CALL CURVED(ZZU,ZZV,IPT)
ENDIF
IF (IPT0>0) THEN
CALL DASHDB(IDOT0)
CALL CURVED(ZZU0,ZZV0,IPT0)
ENDIF
!!!!!!!!!!!!!!!!!!! fin modif VD
CALL GSCLIP(1) ! Clipping of extra coastline
CLOSE(1)
CALL GSLN(1) ! restore solid line
CALL GSLWSC(ZWIDTH)
ENDIF
!
!* 1.7 Formats and write Map axes with appropriate labels
!* and axes scale labels
!
! Initial coordinate transformation saved
CALL GETSET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
! Sets NCAR user coordinates
GIND=.NOT.LGEOG .OR. &
!!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
(.NOT.LGEOG .AND. &
(LXYZ00 .OR. LMASK3D .OR. LMASK3D_XY .OR. LMASK3D_XZ .OR. LMASK3D_YZ &
! .OR. LMARKER .OR. LTRAJ3D .OR. LFLUX3D)
.OR. LMSKTOP .OR. LTRAJ3D .OR. LFLUX3D) .AND. LINDAX )
GCONF= .NOT.LGEOG .AND. &
(LXYZ00 .OR. LMASK3D .OR. LMASK3D_XY .OR. LMASK3D_XZ .OR. LMASK3D_YZ &
! .OR. LMARKER .OR. LTRAJ3D .OR. LFLUX3D)
.OR. LMSKTOP .OR. LTRAJ3D .OR. LFLUX3D) .AND. .NOT.LINDAX
IF (GCONF) GIND=.FALSE.
!!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
! limites du domaine en indices de grille
IF(GIND)THEN
CALL SET(ZX1,ZX2,ZY1,ZY2,FLOAT(NIINF),FLOAT(NISUP), &
FLOAT(NJINF),FLOAT(NJSUP),IDUM)
!>>>>>>>>>>>>This section is to be revised***********************
FORMAX=' '
IF(LFMTAXEX)THEN
FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
ELSE
FORMAX='(F5.1)'
ENDIF
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(F5.1)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
! CALL LABMOD('(F5.1)','(F5.1)',0,0,10,10,0,0,0)
!CALL GASETI('LTY',1)
IF(NCHPCITVXMJ /= 0 .OR. NCHPCITVYMJ /=0 .OR. NCHPCITVXMN /= 0 .OR. &
NCHPCITVXMN /= 0)THEN
!Avril 2002
IF(LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,0,5,0.,0.)
ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,1,5,0.,0.)
ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,0,5,0.,0.)
ELSE
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,1,5,0.,0.)
ENDIF
!Avril 2002
ELSE
IF(NISUP > 99)THEN
FORMAX=' '
IF(LFMTAXEX)THEN
FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
ELSE
FORMAX='(I4)'
ENDIF
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(I2)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
! CALL LABMOD('(I3)','(I2)',0,0,10,10,0,0,0)
! CALL LABMOD('(I3)','(I2)',3,2,10,10,0,0,0)
IF(NJSUP > 99)THEN
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(I4)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
! CALL LABMOD('(I3)','(I3)',0,0,10,10,0,0,0)
! CALL LABMOD('(I3)','(I3)',3,3,10,10,0,0,0)
ENDIF
ELSE
FORMAX=' '
IF(LFMTAXEX)THEN
FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
ELSE
FORMAX='(I2)'
ENDIF
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(I2)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
! CALL LABMOD('(I2)','(I2)',0,0,10,10,0,0,0)
! CALL LABMOD('(I2)','(I2)',2,2,10,10,0,0,0)
IF(NJSUP > 99)THEN
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(I4)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
! CALL LABMOD('(I2)','(I3)',0,0,10,10,0,0,0)
! CALL LABMOD('(I2)','(I3)',2,3,10,10,0,0,0)
ENDIF
ENDIF
!Avril 2002
IF(LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,0,0,5,0.,0.)
ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,0,1,5,0.,0.)
ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,0,5,0.,0.)
ELSE
CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,1,5,0.,0.)
!CALL PERIM(NISUP-NIINF,1,NJSUP-NJINF,1)
ENDIF
!Avril 2002
ENDIF
ENDIF
!
!!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
! limites du domaine en coord. conf. (pour lachers de part. LMASK3D)
IF(GCONF) THEN
CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,1)
CALL LABMOD('(F8.0)','(F8.0)',0,0,NSZLBX,NSZLBY,12,0,0)
CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,1,5,0.,0.)
ENDIF
!!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
!
! limites du domaine en lat/lon
IF (LGEOG) THEN
CALL SET(ZX1,ZX2,ZY1,ZY2,ZPL2,ZPL4,ZPL1,ZPL3,IDUM)
FORMAY=' '
IF(LFMTAXEY)THEN
FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
ELSE
FORMAY='(F5.1)'
ENDIF
IF(ZPL2 < -99. .OR. ZPL4 < -99.)THEN
FORMAX=' '
IF(LFMTAXEX)THEN
FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
ELSE
FORMAX='(F6.1)'
ENDIF
! Ai mis 12 pour rapprocher les labels Y de l'axe; sinon troncature
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,12,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,12,0,0)
! CALL LABMOD('(F6.1)','(F5.1)',0,0,10,10,12,0,0)
! CALL LABMOD('(F6.1)','(F5.1)',6,5,10,10,0,0,0)
ELSE
FORMAX=' '
IF(LFMTAXEX)THEN
FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
ELSE
FORMAX='(F6.2)'
ENDIF
CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,12,0,0)
! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,12,0,0)
! CALL LABMOD('(F6.2)','(F5.1)',0,0,10,10,12,0,0)
! CALL LABMOD('(F6.2)','(F5.1)',6,5,10,10,0,0,0)
ENDIF
!Avril 2002
IF(LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,0,5,0.,0.)
ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,1,5,0.,0.)
ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,0,5,0.,0.)
ELSE
CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,1,5,0.,0.)
ENDIF
!Avril 2002
ENDIF
! Initial coordinate transformation restored
CALL SET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
!
!* 1.8 A series of landmarks is added to the plot when required
!
!!! Enleve le 30/8/99 pour travailler avec les coordonnees conformes ci-apres
! verifie que idem
!IF(NLPCAR.GE.1)THEN
! DO JLPCAR=1,NLPCAR
! CALL MAPTRN(XLATCAR(JLPCAR),XLONCAR(JLPCAR),ZU,ZV)
!>>>>>>>May be, this section is to be revised*******************
! CALL NGWSYM('N',8,ZU,ZV,.012,1,0)
! Obsolete CALL PWRITX(ZU,ZV,'''KGU''-',6,20,0,0)
! ENDDO
!ENDIF
! Initial coordinate transformation restored
CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,IDUM)
if(nverbia > 0)then
print *,' **bcgrd AP CALL SET'
endif
IF(K == 2)THEN
IF(NLPCAR.GE.1)THEN
IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE)THEN
call tabcol_fordiachro
ENDIF
IF(LUMVM .OR. LUTVT .AND. NSUPERDIA == 1)THEN
call tabcol_fordiachro
ENDIF
DO JLPCAR=1,NLPCAR
ZLAT=XLATCAR(JLPCAR)
ZLON=XLONCAR(JLPCAR)
YSYMB=CSYMCAR(JLPCAR)
ZPOS=XPOSNOM(JLPCAR)
ICOLS=ICOLSYM(JLPCAR)
ICOLN=ICOLNOM(JLPCAR)
IF(XSZSYM(JLPCAR) /= 0.)THEN
ZSZ=XSZSYM(JLPCAR)
IF(ZSZ == 9999.)ZSZ=.012
ELSE
ZSZ=.012
ENDIF
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
! CALL GSTXCI(ICOLS)
CALL PCSETI('OC',ICOLS)
IF(YSYMB == '.')THEN
CALL NGWSYM('N',8,ZU,ZV,ZSZ,ICOLS,0)
! CALL NGWSYM('N',8,ZU,ZV,ZSZ,1,0)
ELSE
CALL PCSETI('OF',2)
CALL PCSETR('OL',1.5)
CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
CALL PCSETI('OF',0)
CALL PCSETR('OL',0.)
ENDIF
CALL PCSETI('OC',1)
IF(XSZNOM(JLPCAR) /= 0.)THEN
ZSZ=XSZNOM(JLPCAR)
IF(ZSZ == 9999.)ZSZ=.012
ELSE
ZSZ=.012
ENDIF
IPOS=ZPOS
! print *,' ZSZ NOM ',ZSZ
SELECT CASE(IPOS)
CASE(0)
ZCENT=-1.
ZU=ZU+ZSZ*1.1*(ZXMAX-ZXMIN)
CASE(45)
ZCENT=-1.
ZU=ZU+ZSZ*1.0*(ZXMAX-ZXMIN)
ZV=ZV+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(90)
ZCENT=0.
ZV=ZV+ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
! ZV=ZV+ZSZ*1.5*(ZYMAX-ZYMIN)
CASE(135)
ZCENT=1.
ZU=ZU-ZSZ*1.0*(ZXMAX-ZXMIN)
ZV=ZV+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
! ZV=ZV+ZSZ*1.0*(ZYMAX-ZYMIN)
CASE(180)
ZCENT=1.
ZU=ZU-ZSZ*1.1*(ZXMAX-ZXMIN)
CASE(225)
ZCENT=1.
ZU=ZU-ZSZ*1.0*(ZXMAX-ZXMIN)
ZV=ZV-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
! ZV=ZV-ZSZ*1.0*(ZYMAX-ZYMIN)
CASE(270)
ZCENT=0.
ZV=ZV-ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
! ZV=ZV-ZSZ*1.5*(ZYMAX-ZYMIN)
CASE(315)
ZCENT=-1.
ZU=ZU+ZSZ*1.0*(ZXMAX-ZXMIN)
ZV=ZV-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
! ZV=ZV-ZSZ*1.0*(ZYMAX-ZYMIN)
END SELECT
IF(CNOMCAR(JLPCAR) /= ' ')THEN
YNOM=CNOMCAR(JLPCAR)
YNOM=ADJUSTL(YNOM)
CALL PCSETI('OF',2)
CALL PCSETI('OC',ICOLN)
!CALL PCSETR('OL',1.5)
!MODIF SYLVIE D.: epaisseur des caracteres de CNOMSYM -> XLWNOM
CALL PCSETR('OL',XLWCONT)
! CALL GSTXCI(ICOLN)
! CALL GSPLCI(ICOLN)
CALL PLCHHQ(ZU,ZV,YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
! CALL PLCHHQ(ZU,ZV+ZSZ*1.5*(ZYMAX-ZYMIN),YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
ENDIF
CALL PCSETI('OF',0)
CALL PCSETR('OL',0.)
CALL PCSETI('OC',1)
CALL GSTXCI(1)
ENDDO
ENDIF
IF(NIJCAR.GE.1)THEN
IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE)THEN
call tabcol_fordiachro
ENDIF
DO JIJCAR=1,NIJCAR
ZI=XICAR(JIJCAR)
ZJ=XJCAR(JIJCAR)
print *,' **bcgrd_fordiachro ZI,ZJ ',ZI,ZJ
YSYMB=CSYMCAR(JIJCAR)
ZPOS=XPOSNOM(JIJCAR)
ICOLS=ICOLSYM(JIJCAR)
ICOLN=ICOLNOM(JIJCAR)
IF(XSZSYM(JIJCAR) /= 0.)THEN
ZSZ=XSZSYM(JIJCAR)
IF(ZSZ == 9999.)ZSZ=.012
ELSE
ZSZ=.012
ENDIF
ICONVI=INT(ZI)
ICONVJ=INT(ZJ)
if(nverbia > 0)then
print *,' **bcgrd_fordiachro ICONVI, ICONVJ ',ICONVI,ICONVJ
endif
ZX=XXX(ICONVI,NMGRID)+(XXX(MIN(ICONVI+1,SIZE(XXX,1)),NMGRID)-XXX(ICONVI,NMGRID))*(ZI-FLOAT(ICONVI))
ZY=XXY(ICONVJ,NMGRID)+(XXY(MIN(ICONVJ+1,SIZE(XXY,1)),NMGRID)-XXY(ICONVJ,NMGRID))*(ZJ-FLOAT(ICONVJ))
if(nverbia > 0)then
print *,' **bcgrd_fordiachro ZX,ZY ',ZX,ZY
endif
CALL PCSETI('OC',ICOLS)
IF(YSYMB == '.')THEN
CALL NGWSYM('N',8,ZX,ZY,ZSZ,ICOLS,0)
ELSE
CALL PCSETI('OF',2)
CALL PCSETR('OL',1.5)
CALL PLCHHQ(ZX,ZY,YSYMB,ZSZ,0.,0.)
CALL PCSETI('OF',0)
CALL PCSETR('OL',0.)
ENDIF
CALL PCSETI('OC',1)
IF(XSZNOM(JIJCAR) /= 0.)THEN
ZSZ=XSZNOM(JIJCAR)
IF(ZSZ == 9999.)ZSZ=.012
ELSE
ZSZ=.012
ENDIF
IPOS=ZPOS
SELECT CASE(IPOS)
CASE(0)
ZCENT=-1.
ZX=ZX+ZSZ*1.1*(ZXMAX-ZXMIN)
CASE(45)
ZCENT=-1.
ZX=ZX+ZSZ*1.0*(ZXMAX-ZXMIN)
ZY=ZY+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(90)
ZCENT=0.
ZY=ZY+ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(135)
ZCENT=1.
ZX=ZX-ZSZ*1.0*(ZXMAX-ZXMIN)
ZY=ZY+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(180)
ZCENT=1.
ZX=ZX-ZSZ*1.1*(ZXMAX-ZXMIN)
CASE(225)
ZCENT=1.
ZX=ZX-ZSZ*1.0*(ZXMAX-ZXMIN)
ZY=ZY-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(270)
ZCENT=0.
ZY=ZY-ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
CASE(315)
ZCENT=-1.
ZX=ZX+ZSZ*1.0*(ZXMAX-ZXMIN)
ZY=ZY-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
END SELECT
IF(CNOMCAR(JIJCAR) /= ' ')THEN
YNOM=CNOMCAR(JIJCAR)
YNOM=ADJUSTL(YNOM)
CALL PCSETI('OF',2)
CALL PCSETI('OC',ICOLN)
CALL PCSETR('OL',1.5)
CALL PLCHHQ(ZX,ZY,YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
ENDIF
CALL PCSETI('OF',0)
CALL PCSETR('OL',0.)
CALL PCSETI('OC',1)
CALL GSTXCI(1)
ENDDO
ENDIF
IF(LRADAR)THEN
CALL GQLWSC(IERR,ZWIDTH)
ZSZ=.012
CALL GSLWSC(3.)
IF(NPORTRAD1 /= 0)THEN
ZLAT=XLATRAD1
ZLON=XLONRAD1
YSYMB=CSYMRAD1
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
DO J=1,NPORTRAD1
CALL TRACIRCLE(ZU,ZV,XPORTRAD1(J),XLWRAD1(J))
CALL SFLUSH
ENDDO
ENDIF
IF(NPORTRAD2 /= 0)THEN
ZLAT=XLATRAD2
ZLON=XLONRAD2
YSYMB=CSYMRAD2
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
DO J=1,NPORTRAD2
CALL TRACIRCLE(ZU,ZV,XPORTRAD2(J),XLWRAD2(J))
CALL SFLUSH
ENDDO
ENDIF
IF(NPORTRAD3 /= 0)THEN
ZLAT=XLATRAD3
ZLON=XLONRAD3
YSYMB=CSYMRAD3
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
DO J=1,NPORTRAD3
CALL TRACIRCLE(ZU,ZV,XPORTRAD3(J),XLWRAD3(J))
CALL SFLUSH
ENDDO
ENDIF
IF(NPORTRAD4 /= 0)THEN
ZLAT=XLATRAD4
ZLON=XLONRAD4
YSYMB=CSYMRAD4
CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
DO J=1,NPORTRAD4
CALL TRACIRCLE(ZU,ZV,XPORTRAD4(J),XLWRAD4(J))
CALL SFLUSH
ENDDO
ENDIF
CALL GSLWSC(ZWIDTH)
ENDIF
ENDIF
!
!----------------------------------------------------------------------
!
!* 2. EXIT
! ----
!
RETURN
END SUBROUTINE BCGRD_FORDIACHRO
LIBTOOLS/tools/diachro/src/DIAPRO/caluv_fordiachro.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE CALUV_FORDIACHRO(KLOOP)
! ##################################
!
!!**** *CALUV_FORDIACHRO* - Computes a wind, and moisture
!! sounding for the emagram mode
!!
!! PURPOSE
!! -------
! For the emagram plots case only, reads U, V, and mix. ratio
! from the Diachro file, and
! relocates the results on the mass gridpoint, to obtain a colocated
! emagram sounding data set.
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! MXM, MYM, MXF, MYF : Shuman averaging operators
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODI_SHUMAN : Contains Shuman operator interfaces
!!
!! MXM : mean operator in x direction for a mass variable
!! MYM : mean operator in y direction for a mass variable
!! MXF : mean operator in x direction for a velocity variable
!! MYF : mean operator in y direction for a velocity variable
!!
!! Module MODD_DIM1 : Contains dimensions
!!
!! NIMAX,NJMAX,NKMAX : x, y, and z array dimensions
!!
!! Module MODD_PARAMETERS : Declares array border depths
!!
!! JPHEXT : Horizontal external points number
!! JPVEXT : Vertical external points number
!!
!! Module MODD_LUNIT1 : Declares names and log. unit of files
!!
!! CLUOUT : Name of output_listing file
!!
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!!
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 06/06/94
!! Updated PM 01/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!USE MODI_SHUMAN
USE MODI_VERIF_GROUP
USE MODI_REALLOC_AND_LOAD
USE MODD_DIM1
USE MODD_COORD
USE MODD_PARAMETERS
USE MODD_RESOLVCAR
USE MODD_FILES_DIACHRO
USE MODD_ALLOC_FORDIACHRO
USE MODD_SEVERAL_RECORDS
USE MODD_TYPE_AND_LH
USE MODD_PT_FOR_CH_FORDIACHRO
IMPLICIT NONE
!
! Dummy arguments
!
INTEGER :: KLOOP
!
! Local variables
!
INTEGER :: IIU, IJU, IKU
INTEGER :: IT, IN, IP
INTEGER :: J, JM, I, IXXX, IXXY
INTEGER :: IRS1, IRSP1, IRS2, IRSP2, IRS3, IRSP3
INTEGER :: JRS1, JRSP1, JRS2, JRSP2, JRS3, JRSP3
CHARACTER(LEN=16) :: YGROUP
REAL :: ZCIINF, ZCISUP, ZCJINF, ZCJSUP
REAL,DIMENSION(:,:,:,:,:,:),ALLOCATABLE,SAVE :: ZMEANR, ZVAL
REAL,DIMENSION(:,:,:,:),ALLOCATABLE,SAVE :: ZV
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES SIZES AND RE-ALLOCATES ARRAYS
! --------------------------------------
IIU=NIMAX+2*JPHEXT
IJU=NJMAX+2*JPHEXT
IKU=NKMAX+2*JPVEXT
!
!
!
!-------------------------------------------------------------------------------
!
!* 2. READS DATA FROM DIACHRO FILE
! ----------------------------
!
!
NUMFILECUR=NFILESCUR(KLOOP)
DO J=1,NBFILES
IF(NUMFILES(J) == NUMFILECUR)THEN
JM=J
ENDIF
ENDDO
DO J = 1,3
YGROUP(1:LEN(YGROUP))=' '
IF(NMT == 1)THEN
IF(J == 1)YGROUP = 'UM'
IF(J == 2)YGROUP = 'VM'
IF(J == 3)YGROUP = 'RVM'
ELSE
IF(J == 1)YGROUP = 'UT'
IF(J == 2)YGROUP = 'VT'
IF(J == 3)YGROUP = 'RVT'
ENDIF
YGROUP=ADJUSTL(YGROUP)
CALL VERIF_GROUP(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
IF(LPBREAD)THEN
print *,YGROUP(1:LEN_TRIM(YGROUP)),' N''EXISTE PAS'
EXIT
ENDIF
IF(LGROUP)THEN
CALL READ_DIACHRO(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
ENDIF
IF(.NOT.LFIC1)THEN
CALL REALLOC_AND_LOAD(YGROUP)
IF(LPBREAD)THEN
! LPBREAD=.FALSE.
print *,YGROUP(1:LEN_TRIM(YGROUP)),' N''EXISTE PAS DANS', &
' L''UN DES FICHIERS '
EXIT
ENDIF
ENDIF
IF(J == 1)THEN
ALLOCATE(XU(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
SIZE(XVAR,5),SIZE(XVAR,6)))
XU(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
ELSE IF(J == 2)THEN
ALLOCATE(XV(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
SIZE(XVAR,5),SIZE(XVAR,6)))
XV(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
ELSE
ALLOCATE(XRVJD(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
SIZE(XVAR,5),SIZE(XVAR,6)))
XRVJD(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
! VOLONTAIREMENT Je ne desalloue pas parce besoin de XDATIME et desallocation
! dans le pg pal comme pour les autres cas.
! CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
ENDIF
ENDDO
!
!
!------------------------------------------------------------------------------
!
!* 3. RELOCATES THE EMAGRAM POINTS (when profile is defined with
! ---------------------------- NIRS et NJRS)
!
!
IF(XIRS /= -999.)THEN
IXXX=SIZE(XXX,1)
IXXY=SIZE(XXY,1)
DO I=1,IXXX-1
IF(XIRSCC >= XXX(I,1) .AND. XIRSCC < XXX(I+1,1))THEN
IRS1=I
IRSP1=MIN(I+1,NIH)
if(nverbia > 0)then
print *,' XIRSCC,XXX(I,1),XXX(IRSP1,1) ',XIRSCC,XXX(I,1),XXX(IRSP1,1)
endif
EXIT
ENDIF
ENDDO
DO J=1,IXXY-1
IF(XJRSCC >= XXY(J,1) .AND. XJRSCC < XXY(J+1,1))THEN
JRS1=J
JRSP1=MIN(J+1,NJH)
if(nverbia > 0)then
print *,' XJRSCC,XXY(J,1),XXY(JRSP1,1) ',XJRSCC,XXY(J,1),XXY(JRSP1,1)
endif
EXIT
ENDIF
ENDDO
DO I=1,IXXX-1
IF(XIRSCC >= XXX(I,2) .AND. XIRSCC < XXX(I+1,2))THEN
IRS2=I
IRSP2=MIN(I+1,NIH)
EXIT
ENDIF
ENDDO
DO J=1,IXXY-1
IF(XJRSCC >= XXY(J,2) .AND. XJRSCC < XXY(J+1,2))THEN
JRS2=J
JRSP2=MIN(J+1,NJH)
EXIT
ENDIF
ENDDO
DO I=1,IXXX-1
IF(XIRSCC >= XXX(I,3) .AND. XIRSCC < XXX(I+1,3))THEN
IRS3=I
IRSP3=MIN(I+1,NIH)
EXIT
ENDIF
ENDDO
DO J=1,IXXY-1
IF(XJRSCC >= XXY(J,3) .AND. XJRSCC < XXY(J+1,3))THEN
JRS3=J
JRSP3=MIN(J+1,NJH)
EXIT
ENDIF
ENDDO
! Je mets toutes les informations du RS arbitrairement au point NIRS=2,NJRS=2
! qd le profil est defini avec XIRS et XJRS. Cela m'evite d'avoir a modifier
! la partie dans oper (ou je sauvegarde et restitue ap. le RS NIRS et NJRS)
NIRS=2; NJRS=2
! Grille 1
IF(IRS1 == IRSP1)THEN
ZCIINF=0.
ZCISUP=0.
ELSE
ZCIINF=(XXX(IRSP1,1)-XIRSCC)/MAX(1.E-10,(XXX(IRSP1,1)-XXX(IRS1,1)))
ZCISUP=(XIRSCC-XXX(IRS1,1))/MAX(1.E-10,(XXX(IRSP1,1)-XXX(IRS1,1)))
ENDIF
IF(JRS1 == JRSP1)THEN
ZCJINF=0.
ZCJSUP=0.
ELSE
ZCJINF=(XXY(JRSP1,1)-XJRSCC)/MAX(1.E-10,(XXY(JRSP1,1)-XXY(JRS1,1)))
ZCJSUP=(XJRSCC-XXY(JRS1,1))/MAX(1.E-10,(XXY(JRSP1,1)-XXY(JRS1,1)))
ENDIF
IF(NVERBIA == 10)THEN
print *,' ZCIINF...',ZCIINF,ZCISUP,ZCJINF,ZCJSUP
print *,' IRS1,JRS1,IRSP1,JRSP1 ',IRS1,JRS1,IRSP1,JRSP1
print *,' TH 1 2 3 4 ',XTH(IRS1,JRS1,:,:,:,:)
print *,' TH 1 2 3 4 ',XTH(IRSP1,JRS1,:,:,:,:)
print *,' TH 1 2 3 4 ',XTH(IRS1,JRSP1,:,:,:,:)
print *,' TH 1 2 3 4 ',XTH(IRSP1,JRSP1,:,:,:,:)
print *,' PRES 1 2 3 4 ',XPRES(IRS1,JRS1,:,:,:,:)
print *,' PRES 1 2 3 4 ',XPRES(IRSP1,JRS1,:,:,:,:)
print *,' PRES 1 2 3 4 ',XPRES(IRS1,JRSP1,:,:,:,:)
print *,' PRES 1 2 3 4 ',XPRES(IRSP1,JRSP1,:,:,:,:)
print *,' RVJD 1 2 3 4 ',XRVJD(IRS1,JRS1,:,:,:,:)
print *,' RVJD 1 2 3 4 ',XRVJD(IRSP1,JRS1,:,:,:,:)
print *,' RVJD 1 2 3 4 ',XRVJD(IRS1,JRSP1,:,:,:,:)
print *,' RVJD 1 2 3 4 ',XRVJD(IRSP1,JRSP1,:,:,:,:)
ENDIF
IF(NVERBIA == 10)THEN
print *,' U 1 2 3 4 ',XU(IRS2,JRS2,:,:,:,:), &
XU(IRSP2,JRS2,:,:,:,:),XU(IRS2,JRSP2,:,:,:,:),&
XU(IRSP2,JRSP2,:,:,:,:)
print *,' V 1 2 3 4 ',XV(IRS3,JRS3,:,:,:,:), &
XV(IRSP3,JRS3,:,:,:,:),XV(IRS3,JRSP3,:,:,:,:),&
XV(IRSP3,JRSP3,:,:,:,:)
ENDIF
ALLOCATE(ZVAL(SIZE(XTH,1),SIZE(XTH,2),SIZE(XTH,3),SIZE(XTH,4),SIZE(XTH,5),SIZE(XTH,6)))
ALLOCATE(ZV(SIZE(XTH,3),SIZE(XTH,4),SIZE(XTH,5),SIZE(XTH,6)))
! XTH
! ZVAL(IRS1,JRS1,:,:,:,:)=ZCIINF*ZCJINF*XTH(IRS1,JRS1,:,:,:,:)+ &
DO IP=1,SIZE(XTH,6)
DO IN=1,SIZE(XTH,5)
DO IT=1,SIZE(XTH,4)
ZV(:,IT,IN,IP)=ZCIINF*ZCJINF*XTH(IRS1,JRS1,:,IT,IN,IP)+ &
ZCIINF*ZCJSUP*XTH(IRS1,JRSP1,:,IT,IN,IP)+ &
ZCISUP*ZCJINF*XTH(IRSP1,JRS1,:,IT,IN,IP)+ &
ZCISUP*ZCJSUP*XTH(IRSP1,JRSP1,:,IT,IN,IP)
! ZV(:,IT,IN,IP)=ZVAL(IRS1,JRS1,:,IT,IN,IP)
XTH(NIRS,NJRS,:,IT,IN,IP)=ZV(:,IT,IN,IP)
print *,' XTH(NIRS,NJRS,:,IT,IN,IP) ',XTH(NIRS,NJRS,:,IT,IN,IP)
ENDDO
ENDDO
ENDDO
! XPRES
ZVAL(IRS1,JRS1,:,:,:,:)=ZCIINF*ZCJINF*XPRES(IRS1,JRS1,:,:,:,:)+ &
ZCIINF*ZCJSUP*XPRES(IRS1,JRSP1,:,:,:,:)+ &
ZCISUP*ZCJINF*XPRES(IRSP1,JRS1,:,:,:,:)+ &
ZCISUP*ZCJSUP*XPRES(IRSP1,JRSP1,:,:,:,:)
ZV(:,:,:,:)=ZVAL(IRS1,JRS1,:,:,:,:)
XPRES(NIRS,NJRS,:,:,:,:)=ZV(:,:,:,:)
! XRVJD
ZVAL(IRS1,JRS1,:,:,:,:)=ZCIINF*ZCJINF*XRVJD(IRS1,JRS1,:,:,:,:)+ &
ZCIINF*ZCJSUP*XRVJD(IRS1,JRSP1,:,:,:,:)+ &
ZCISUP*ZCJINF*XRVJD(IRSP1,JRS1,:,:,:,:)+ &
ZCISUP*ZCJSUP*XRVJD(IRSP1,JRSP1,:,:,:,:)
ZV(:,:,:,:)=ZVAL(IRS1,JRS1,:,:,:,:)
XRVJD(NIRS,NJRS,:,:,:,:)=ZV(:,:,:,:)
! Grille 2
IF(IRS2 == IRSP2)THEN
ZCIINF=0.
ZCISUP=0.
ELSE
ZCIINF=(XXX(IRSP2,2)-XIRSCC)/MAX(1.E-10,(XXX(IRSP2,2)-XXX(IRS2,2)))
ZCISUP=(XIRSCC-XXX(IRS2,2))/MAX(1.E-10,(XXX(IRSP2,2)-XXX(IRS2,2)))
ENDIF
IF(JRS2 == JRSP2)THEN
ZCJINF=0.
ZCJSUP=0.
ELSE
ZCJINF=(XXY(JRSP2,2)-XJRSCC)/MAX(1.E-10,(XXY(JRSP2,2)-XXY(JRS2,2)))
ZCJSUP=(XJRSCC-XXY(JRS2,2))/MAX(1.E-10,(XXY(JRSP2,2)-XXY(JRS2,2)))
ENDIF
! XU
ZVAL(IRS2,JRS2,:,:,:,:)=ZCIINF*ZCJINF*XU(IRS2,JRS2,:,:,:,:)+ &
ZCIINF*ZCJSUP*XU(IRS2,JRSP2,:,:,:,:)+ &
ZCISUP*ZCJINF*XU(IRSP2,JRS2,:,:,:,:)+ &
ZCISUP*ZCJSUP*XU(IRSP2,JRSP2,:,:,:,:)
ZV(:,:,:,:)=ZVAL(IRS2,JRS2,:,:,:,:)
XU(NIRS,NJRS,:,:,:,:)=ZV(:,:,:,:)
! Grille 3
IF(IRS3 == IRSP3)THEN
ZCIINF=0.
ZCISUP=0.
ELSE
ZCIINF=(XXX(IRSP3,3)-XIRSCC)/MAX(1.E-10,(XXX(IRSP3,3)-XXX(IRS3,3)))
ZCISUP=(XIRSCC-XXX(IRS3,3))/MAX(1.E-10,(XXX(IRSP3,3)-XXX(IRS3,3)))
ENDIF
IF(JRS3 == JRSP3)THEN
ZCJINF=0.
ZCJSUP=0.
ELSE
ZCJINF=(XXY(JRSP3,3)-XJRSCC)/MAX(1.E-10,(XXY(JRSP3,3)-XXY(JRS3,3)))
ZCJSUP=(XJRSCC-XXY(JRS3,3))/MAX(1.E-10,(XXY(JRSP3,3)-XXY(JRS3,3)))
ENDIF
! XV
ZVAL(IRS3,JRS3,:,:,:,:)=ZCIINF*ZCJINF*XV(IRS3,JRS3,:,:,:,:)+ &
ZCIINF*ZCJSUP*XV(IRS3,JRSP3,:,:,:,:)+ &
ZCISUP*ZCJINF*XV(IRSP3,JRS3,:,:,:,:)+ &
ZCISUP*ZCJSUP*XV(IRSP3,JRSP3,:,:,:,:)
ZV(:,:,:,:)=ZVAL(IRS3,JRS3,:,:,:,:)
XV(NIRS,NJRS,:,:,:,:)=ZV(:,:,:,:)
DEALLOCATE(ZVAL,ZV)
IF(NVERBIA == 10)THEN
print *,' TH,PRES,RVJD,U,V interpoles ',XTH(NIRS,NJRS,:,:,:,:),' ', &
XPRES(NIRS,NJRS,:,:,:,:),' ',XRVJD(NIRS,NJRS,:,:,:,:),' ',&
XU(NIRS,NJRS,:,:,:,:),' ',XV(NIRS,NJRS,:,:,:,:)
ENDIF
ELSE
IF(.NOT.ALLOCATED(ZMEANR))THEN
ALLOCATE(ZMEANR(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
SIZE(XVAR,5),SIZE(XVAR,6)))
END IF
! A CORRIGER (Fait le 6/1/97)
ZMEANR(1:IIU-1,:,:,:,:,:)=.5*(XU(1:IIU-1,:,:,:,:,:)+XU(2:IIU,:,:,:,:,:))
!ZMEANR(:,:,:,:,:,:)=MXF(XU)
ZMEANR(IIU,:,:,:,:,:)=2.*ZMEANR(IIU-1,:,:,:,:,:)-ZMEANR(IIU-2,:,:,:,:,:)
XU(:,:,:,:,:,:)=ZMEANR(:,:,:,:,:,:)
!
!ZMEANR(:,:,:,:,:,:)=MYF(XV)
! A CORRIGER (Fait le 6/1/97)
ZMEANR(:,1:IJU-1,:,:,:,:)=.5*(XV(:,1:IJU-1,:,:,:,:)+XV(:,2:IJU,:,:,:,:))
ZMEANR(:,IJU,:,:,:,:)=2.*ZMEANR(:,IJU-1,:,:,:,:)-ZMEANR(:,IJU-2,:,:,:,:)
XV(:,:,:,:,:,:)=ZMEANR(:,:,:,:,:,:)
!
!
!-----------------------------------------------------------------------------
!
!* 4. EXIT
! ----
!
DEALLOCATE(ZMEANR)
ENDIF
!
RETURN
END SUBROUTINE CALUV_FORDIACHRO
LIBTOOLS/tools/diachro/src/DIAPRO/careal.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_CAREAL
! ##################
!
INTERFACE
!
SUBROUTINE CAREAL(HCAR,POUT)
CHARACTER(LEN=*) :: HCAR
REAL :: POUT
END SUBROUTINE CAREAL
!
END INTERFACE
!
END MODULE MODI_CAREAL
! ######spl
SUBROUTINE CAREAL(HCAR,POUT)
! ############################
!
!!**** *CAREAL* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 24/11/95
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_RESOLVCAR
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
CHARACTER(LEN=*) :: HCAR
REAL :: POUT
!
!* 0.1 Local variables
! ---------------
!
CHARACTER(LEN=LEN(HCAR)) :: YCAR
!------------------------------------------------------------------------------
!
YCAR=HCAR
READ(YCAR,*)POUT
!* 2. EXITS
! -----
!
RETURN
END SUBROUTINE CAREAL
LIBTOOLS/tools/diachro/src/DIAPRO/caresolv.f90 0 → 100644
View file @ 6bb35ca8
Changes suppressed. Click to show.
! ######spl
MODULE MODI_CARESOLV
! ####################
!
INTERFACE
!
SUBROUTINE CARESOLV(HCARIN)
CHARACTER(LEN=*) :: HCARIN
END SUBROUTINE CARESOLV
!
END INTERFACE
!
END MODULE MODI_CARESOLV
! ######spl
SUBROUTINE CARESOLV(HCARIN)
! ###########################
!
!!**** *CARESOLV* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : declares model physical constants
!!
!! Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
!! (former NCAR common)
!!
!! NIOFFD : Label normalisation (=0 none, =/=0 active)
!! NULBLL : Nb of contours between 2 labelled contours
!! NIOFFM : =0 --> message at picture bottom
!! =/= 0 --> no message
!! NIOFFP : Special point value detection
!! (=0 none, =/=0 active)
!! NHI : Extrema detection
!! (=0 --> H+L, <0 nothing)
!! NINITA : For streamlimes
!! NINITB : Not yet implemented
!! NIGRNC : Not yet implemented
!! NDOT : Line style
!! (=0|1|1023|65535 --> solid lines;
!! <0 --> solid lines for positive values and
!! dotted lines(ABS(NDOT))for negative values;
!! >0 --> dotted lines(ABS(NDOT)) )
!! NIFDC : Coastline data style (0 none, 1 NCAR, 2 IGN)
!! NLPCAR : Number of land-mark points to be plotted
!! NIMNMX : Contour selection option
!! (=-1 Min, max and inc. automatically set;
!! =0 Min, max automatically set; inc. given;
!! >0 Min, max, inc. given by user)
!! NISKIP : Rate for drawing velocity vectors
!! CTYPHOR : Horizontal cross-section type
!! (='K' --> model level section;
!! ='Z' --> constant-altitude section;
!! ='P' --> isobar section (planned)
!! ='T' --> isentrope section (planned)
!! XSPVAL : Special value
!! XSIZEL : Label size
!! XLATCAR, XLONCAR : Lat. and Long. of land-mark points
!! LXY : If =.TRUE., plots a grid-mesh stencil background
!! LXZ : If =.TRUE., plots a model-level stencil background
!!
!! Module MODN_PARA : Defines NAM_DOMAIN_POS namelist
!! (former PARA common)
!!
!! XIDEBCOU, XJDEBCOU : Origin of a vertical cross-section
!! in cartesian (or conformal) real values
!! XHMIN : Altitude of the vert. cross-section
!! bottom (in meters above sea-level)
!! XHMAX : Altitude of the vert. cross-section
!! top (in meters above sea-level)
!!
!! Module MODD_ALLVAR
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 06/06/94
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
#ifdef NAGf95
USE F90_UNIX ! for FLUSH and GETENV
#endif
USE MODD_RESOLVCAR
USE MODE_GRIDPROJ
USE MODD_SUPER
USE MODD_EXPR
USE MODD_RADAR
USE MODD_MASK3D
USE MODN_NCAR
USE MODN_PARA
USE MODI_RESOLVT
USE MODI_RESOLVN
USE MODI_RESOLVON
USE MODI_RESOLVP
USE MODI_RESOLVK
USE MODI_RESOLVZ
USE MODI_RESOLVX
USE MODI_CAREAL
USE MODI_CARINT
USE MODI_RESOLVI
USE MODI_RESOLVIARRAY
USE MODI_RESOLVL
USE MODI_CARMEMORY
USE MODI_RESOLVXISOLEV
USE MODD_FILES_DIACHRO
USE MODD_DIM1
USE MODD_GRID1
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_HACH
USE MODD_PVT
USE MODD_COORD
USE MODD_DEFCV
USE MODD_TIT
USE MODD_RSISOCOL
USE MODD_MEMCV
USE MODD_CTL_AXES_AND_STYL
USE MODD_PARAMETERS
USE MODD_ALLOC_FORDIACHRO
USE MODI_LOADMNMX_FT_PVKT
USE MODI_LOADMNMXINT_ISO
USE MODI_LOADXISOLEVP
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
USE MODD_TRAJ3D
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
USE MODI_WRITEDIR
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
CHARACTER(LEN=*) :: HCARIN
!CHARACTER(LEN=32) :: HGRP
!
!* 0.1 Local variables
! ---------------
!
CHARACTER(LEN=80) :: YCAR80
!CHARACTER(LEN=LEN(HCARIN)+240) :: YCARIN, YCAR
!CHARACTER(LEN=800) :: YCAROUT
CHARACTER(LEN=LEN(HCARIN)) :: YCARIN, YCAROUT, YCAR
!
INTEGER :: INDPARTIEL
INTEGER :: ILENC, ILENGRP, ILENC2, IETOILE, ILOG, ILEN, INDEXPR
INTEGER :: INDP, INDT, INDK, INDZ, INDCV, INDPV, INDPVT, INDPH, INDON, &
INDTOT, INDMIN, INDFI, INDN, INDID, INDPVKT, INDPXT, INDPYT
INTEGER :: INDNDOMAINL, INDNDOMAINR, INDNDOMAINB, INDNDOMAINT
INTEGER :: INDNSZLBX, INDNSZLBY, INDTMP
INTEGER :: INDPVKT1, INDZT, INDXT, INDYT, INDXY, INDZTPVKT1, INDXYZ
INTEGER :: INDFT, INDFT1, INDMASK, INDMASKCUM, INDMASKSUM
INTEGER :: INDTK, INDPR, INDRS, INDRS1, INDEV, INDUMVMPV
INTEGER :: INDIINF, INDJINF, INDISUP, INDJSUP, INDIM, INDNZSTR, INDNARSTR
INTEGER :: INDIDEBCOU, INDJDEBCOU, INDXIDEBCOU, INDXJDEBCOU, INDNLANGLE, &
INDNLMAX, INDXHMIN, INDXHMAX, INDXISOMIN, INDXISOMAX
INTEGER :: INDXPMIN, INDXPMAX, INDXPINT, INDXSSP, INDXLWSTR, INDXARLSTR
INTEGER :: INDXISOMIN_, INDXISOMAX_, INDXDIAINT_, INDXANGULVT
INTEGER :: INDXDIAINT, INDLXY, INDLXZ, INDLISO, INDLMINMAX, INDATFILE, &
INDLCOLAREA, INDLCOLINE, INDLISOWHI, INDLCOLBR, INDLCOLAREASEL, &
INDLSPVALT, INDLSEGM, INDLPRESY, INDLSPSECT, INDLEGVECT , &
INDLINTERPTOP, INDLCOLISONE, INDLCOLRSONE, INDLCOLRS1ONE, &
INDLCOLINESEL, INDLTABCOLDEF, INDVISU, INDNOVISU, INDXSIZEL, &
INDLMNMXUSER, INDLCOLUSER, INDLVECTMNMX, INDLANIMK, INDLANIMT, &
INDLMNMXLOC, INDLULMVTMOLD, INDLTITFTUSER, INDLFMTAXEX, &
INDLTIMEUSER, INDXTIMEMIN, INDXTIMEMAX, INDLSTREAM, &
INDLNOUVRS, INDLMYHEURX, INDNHEURXLBL, INDNHEURXGRAD
INTEGER :: INDLINZEROPV, INDLBLFT1SUP, INDL24H
INTEGER :: INDNVERBIA, INDLISOWHI2, INDLISOWHI3, INDLFMTAXEY
INTEGER :: INDLINVWB , INDLGEOG, INDLMASK3D, INDMSKTOP, INDSV3
INTEGER :: INDLINVPTIR, INDLDOMAIN, INDLNOLABELX, INDLNOLABELY
INTEGER :: INDLNOLBLBAR
INTEGER :: INDLMASK3D_XY,INDLMASK3D_XZ,INDLMASK3D_YZ,INDLXYZ00
INTEGER :: INDLINDSP, INDLOGNEP, INDLTABCOLDEF2, INDLCONT, INDLRELIEF, &
INDLCONV2XY, INDLINDAX, INDLCHREEL,INDLCOLUSERUV,INDL2CONT, &
INDLCONVG2MASS
INTEGER :: INDLSPLO, INDSPO, INDOSPLO, INDPHALO, INDPHAO, INDLFTBAUTO, &
INDLFT1BAUTO
INTEGER :: INDLPRINT, INDLPOINTG, INDL2DBX, INDL2DBY, INDLXYO, INDLPRINTXY
INTEGER :: INDLPRDAT, INDLINTERPOLSTR, INDL3D
INTEGER :: INDLVPTUSER, INDLVPTVUSER, INDLVPTPVUSER, INDLXABSC, INDLXMINTOP
INTEGER :: INDLVPTXYUSER, INDLFACTIMP, INDLFACTAXEX, INDLFACTAXEY
INTEGER :: INDLAXEXUSER, INDLAXEYUSER
INTEGER :: INDLHACH1, INDLHACH2, INDLHACH3, INDLHACH4, INDLHACHSEL
INTEGER :: INDLGREY
INTEGER :: INDLHEURX
INTEGER :: INDLABEL1, INDLBLUSER1, INDLBLUSER2, INDLBLUSER3, INDLBLUSER4
INTEGER :: INDXFACTAXEX, INDXFACTAXEY, INDXAXEXUSERD, INDXAXEYUSERD
INTEGER :: INDXAXEXUSERF, INDXAXEYUSERF
INTEGER :: INDXVPTL, INDXVPTR, INDXVPTB, INDXVPTT
INTEGER :: INDXVPTVL, INDXVPTVR, INDXVPTVB, INDXVPTVT
INTEGER :: INDXVPTPVL, INDXVPTPVR, INDXVPTPVB, INDXVPTPVT
INTEGER :: INDXVPTXYL, INDXVPTXYR, INDXVPTXYB, INDXVPTXYT
INTEGER :: INDXISOLEV, INDXFTMIN, INDXFTMAX, INDXPVKTMIN, INDXPVKTMAX
INTEGER :: INDXFT_ADTIM1, INDXFT_ADTIM2, INDXFT_ADTIM3, INDXFT_ADTIM4
INTEGER :: INDXFT_ADTIM5, INDXFT_ADTIM6, INDXFT_ADTIM7, INDXFT_ADTIM8
INTEGER :: INDXFT1_ADTIM1, INDXFT1_ADTIM2, INDXFT1_ADTIM3, INDXFT1_ADTIM4
INTEGER :: INDXFT1_ADTIM5, INDXFT1_ADTIM6, INDXFT1_ADTIM7, INDXFT1_ADTIM8
INTEGER :: INDXISOLEV_ , INDXPARCOLUV
INTEGER :: INDXFT1MIN, INDXFT1MAX, INDXFT1MIN_, INDXFT1MAX_
INTEGER :: INDXVARMIN, INDXVARMAX, INDXZTMIN, INDXZTMAX
INTEGER :: INDXLATCAR, INDXLONCAR, INDXXL, INDXXH, INDXYL, INDXYH
INTEGER :: INDXICAR, INDXJCAR
INTEGER :: INDCNOMCAR, INDCSYMCAR, INDXPOSNOM, INDXSZNOM, INDXSZSYM
INTEGER :: INDXPOSXVARNPV1TOP,INDXPOSYVARNPV1TOP
INTEGER :: INDXPOSXVARNPV5BOT,INDXPOSYVARNPV5BOT
INTEGER :: INDXSZVARNPVTOP,INDXSZVARNPVBOT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INTEGER :: INDNSZRTRAJ,INDLFMTRTRAJ
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INTEGER :: INDXLWPH1, INDXLWPH2, INDXLWPH3, INDXLWPH4
INTEGER :: INDXLWPH5, INDXLWPH6, INDXLWPH7, INDXLWPH8
INTEGER :: INDXSZTITYT, INDXSZTITYM, INDXSZTITYB
INTEGER :: INDXSZTITT1, INDXSZTITT2, INDXSZTITT3
INTEGER :: INDXSZTITB1, INDXSZTITB2, INDXSZTITB3
INTEGER :: INDXSZTITVAR1, INDXSZTITVAR2, INDXSZTITVAR3, INDXSZTITVAR4
INTEGER :: INDXSZTITVAR5, INDXSZTITVAR6, INDXSZTITVAR7, INDXSZTITVAR8
INTEGER :: INDXPOSTITYT, INDXPOSTITYM, INDXPOSTITYB
INTEGER :: INDXPOSTITT1, INDXPOSTITT2, INDXPOSTITT3
INTEGER :: INDXPOSTITB1, INDXPOSTITB2, INDXPOSTITB3
INTEGER :: INDXPOSTITVAR1, INDXPOSTITVAR2, INDXPOSTITVAR3, INDXPOSTITVAR4
INTEGER :: INDXPOSTITVAR5, INDXPOSTITVAR6, INDXPOSTITVAR7, INDXPOSTITVAR8
INTEGER :: INDXYPOSTITYT, INDXYPOSTITYM, INDXYPOSTITYB
INTEGER :: INDXYPOSTITT1, INDXYPOSTITT2, INDXYPOSTITT3
INTEGER :: INDXYPOSTITB1, INDXYPOSTITB2, INDXYPOSTITB3
INTEGER :: INDXYPOSTITVAR1, INDXYPOSTITVAR2, INDXYPOSTITVAR3,INDXYPOSTITVAR4
INTEGER :: INDXYPOSTITVAR5, INDXYPOSTITVAR6, INDXYPOSTITVAR7,INDXYPOSTITVAR8
INTEGER :: INDICOLNOM, INDICOLSYM
INTEGER :: INDXZL, INDXZH
INTEGER :: INDNIFDC, INDNIGRNC, INDNDOT, INDNISKIP, INDNISKIPVX, INDNISKIPVY
INTEGER :: INDNIOFFD, INDNULBLL, INDNHI, INDNIMNMX, INDNPROFILE, INDNSD
INTEGER :: INDMINUS, INDPLUS, INDNFT1ITVXMJ, INDNFT1ITVXMN
INTEGER :: INDNFT1ITVYMJ, INDNFT1ITVYMN, INDNINDCOLUV
INTEGER :: INDNFTITVXMJ, INDNFTITVXMN, INDNFTITVYMJ, INDNFTITVYMN
INTEGER :: INDNCHITVXMJ, INDNCHITVXMN, INDNCHITVYMJ, INDNCHITVYMN
INTEGER :: INDNCHPCITVXMJ, INDNCHPCITVXMN, INDNCHPCITVYMJ, INDNCHPCITVYMN
INTEGER :: INDNCVITVXMJ, INDNCVITVXMN, INDNCVITVYMJ, INDNCVITVYMN
INTEGER :: INDNPVITVXMJ, INDNPVITVXMN, INDNPVITVYMJ, INDNPVITVYMN
INTEGER :: INDNMASKITVXMJ, INDNMASKITVXMN, INDNMASKITVYMJ, INDNMASKITVYMN
INTEGER :: INDNXYITVXMJ, INDNXYITVXMN, INDNXYITVYMJ, INDNXYITVYMN
INTEGER :: INDXPVMIN, INDXPVMAX, INDXPVMINT, INDXPVMAXT
INTEGER :: INDXLWV, INDXLWDEF, INDXLWVDEF, INDXLWCONT, INDLMARKER
INTEGER :: INDXLWFTALL, INDXLWSEGM
INTEGER :: INDXLW, INDXLW1, INDXLW2, INDXLW3, INDXLW4, INDXLWDOMAIN
INTEGER :: INDXLWPV1, INDXLWPV2, INDXLWPV3, INDXLWPV4, INDXLWPV5
INTEGER :: INDXLWPV6, INDXLWPV7, INDXLWPV8, INDXLWTRACECV
INTEGER :: INDXLWPV9, INDXLWPV10
INTEGER :: INDXLWPV11, INDXLWPV12, INDXLWPV13, INDXLWPV14, INDXLWPV15
INTEGER :: INDXSTYLPV1, INDXSTYLPV2, INDXSTYLPV3, INDXSTYLPV4, INDXSTYLPV5
INTEGER :: INDXSTYLPV6, INDXSTYLPV7, INDXSTYLPV8
INTEGER :: INDXSTYLPV9, INDXSTYLPV10
INTEGER :: INDXSTYLPV11, INDXSTYLPV12, INDXSTYLPV13, INDXSTYLPV14, INDXSTYLPV15
INTEGER :: INDXAMX, INDXVHC, INDXVRL, INDXVLC, INDXVRLPH, INDXVHCPH
INTEGER :: INDNIRS, INDNJRS, INDXIRS, INDXJRS, INDXSPVAL, INDXSPVALT
INTEGER :: INDLCOLZERO, INDNCOLZERO, INDLFT1STYLUSER, INDLFTSTYLUSER
INTEGER :: INDNCOLSEGM, INDLFT3C, INDLFT4C, INDLFTCLIP
INTEGER :: INDNCOLUV1, INDNCOLUV2, INDNCOLUV3, INDNCOLUV4, INDNCOLUV5
INTEGER :: INDNCOLISONE1, INDNCOLISONE2, INDNCOLISONE3,INDNCOLISONE4
INTEGER :: INDNCOLISONE5, INDNCOLRSONE, INDNCOLRS1ONE1,INDNCOLRS1ONE2
INTEGER :: INDNCOLRS1ONE3, INDNCOLRS1ONE4,INDNCOLRS1ONE5
INTEGER :: INDXSZTITXL, INDXSZTITXM, INDXSZTITXR
INTEGER :: INDLDEFCV2, INDLDEFCV2LL, INDLDEFCV2IND
INTEGER :: INDXIDEBCV, INDXIFINCV, INDXJDEBCV, INDXJFINCV
INTEGER :: INDXIDEBCVLL, INDXIFINCVLL, INDXJDEBCVLL, INDXJFINCVLL
INTEGER :: INDNIDEBCV, INDNIFINCV, INDNJDEBCV, INDNJFINCV
INTEGER :: INDLSYMB, INDLTEXTG, INDLTEXTIT, INDLSYMBTEXTG, INDLSTI
INTEGER :: INDLTRACECV, INDLM5S3, INDLCVZOOM, INDLDILW, INDLVST
INTEGER :: INDLVSUPSCA, INDLXYWINCUR, INDLXYNVARTOP, INDLXYSTYLTOP
INTEGER :: INDLRADAR, INDXLATRAD1,INDXLATRAD2,INDXLATRAD3,INDXLATRAD4
INTEGER :: INDLRADIST, INDLRADRAY
INTEGER :: INDXLONRAD1,INDXLONRAD2,INDXLONRAD3,INDXLONRAD4
INTEGER :: INDXPORTRAD1,INDXPORTRAD2,INDXPORTRAD3,INDXPORTRAD4
INTEGER :: INDXLWRAD1,INDXLWRAD2,INDXLWRAD3,INDXLWRAD4
INTEGER :: INDCSYMRAD1,INDCSYMRAD2,INDCSYMRAD3,INDCSYMRAD4
INTEGER :: INDXISOREF,INDXISOREF_,INDLSPOT
INTEGER :: INDLFT1LUSER,INDNFT1STY1,INDNFT1STY2,INDNFT1STY3,INDNFT1STY4
INTEGER :: INDNFT1STY5,INDNFT1STY6,INDNFT1STY7,INDNFT1STY8,INDNFT1STY9
INTEGER :: INDNFT1STY10,INDNFT1STY11,INDNFT1STY12,INDNFT1STY13,INDNFT1STY14
INTEGER :: INDNFT1STY15
INTEGER :: INDNFT1COL1,INDNFT1COL2,INDNFT1COL3,INDNFT1COL4,INDNFT1COL5
INTEGER :: INDNFT1COL6,INDNFT1COL7,INDNFT1COL8,INDNFT1COL9,INDNFT1COL10
INTEGER :: INDNFT1COL11,INDNFT1COL12,INDNFT1COL13,INDNFT1COL14,INDNFT1COL15
INTEGER :: INDXFT1LW1,INDXFT1LW2,INDXFT1LW3,INDXFT1LW4,INDXFT1LW5
INTEGER :: INDXFT1LW6,INDXFT1LW7,INDXFT1LW8,INDXFT1LW9,INDXFT1LW10
INTEGER :: INDXFT1LW11,INDXFT1LW12,INDXFT1LW13,INDXFT1LW14,INDXFT1LW15
INTEGER :: INDCFT1TIT1,INDCFT1TIT2,INDCFT1TIT3,INDCFT1TIT4,INDCFT1TIT5
INTEGER :: INDCFT1TIT6,INDCFT1TIT7,INDCFT1TIT8,INDCFT1TIT9,INDCFT1TIT10
INTEGER :: INDCFT1TIT11,INDCFT1TIT12,INDCFT1TIT13,INDCFT1TIT14,INDCFT1TIT15
INTEGER :: INDXVPTFT1L,INDXVPTFT1R,INDXVPTFT1B,INDXVPTFT1T
INTEGER :: INDLVPTFT1USER, INDLVARNPVUSER, INDNSTYLINZEROPV
INTEGER :: INDCVARNPV1,INDCVARNPV2,INDCVARNPV3,INDCVARNPV4,INDCVARNPV5
INTEGER :: INDCVARNPV6,INDCVARNPV7,INDCVARNPV8,INDCVARNPV9,INDCVARNPV10
INTEGER :: INDCVARNPV11,INDCVARNPV12,INDCVARNPV13,INDCVARNPV14,INDCVARNPV15
INTEGER :: INDCVARNPH1,INDCVARNPH2,INDCVARNPH3,INDCVARNPH4,INDCVARNPH5
INTEGER :: INDCVARNPH6,INDCVARNPH7,INDCVARNPH8,INDLVARNPHUSER
INTEGER :: INDNPHCOL1,INDNPHCOL2,INDNPHCOL3,INDNPHCOL4,INDNPHCOL5
INTEGER :: INDNPHCOL6,INDNPHCOL7,INDNPHCOL8
INTEGER :: INDNPHSTY1,INDNPHSTY2,INDNPHSTY3,INDNPHSTY4,INDNPHSTY5
INTEGER :: INDNPHSTY6,INDNPHSTY7,INDNPHSTY8
INTEGER :: INDLPHCOLUSER,INDLPHSTYUSER
INTEGER :: INDLPATCH
#ifdef RHODES
INTEGER :: ISTAF
#endif
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INTEGER :: INDXXPART,INDXYPART,INDXZPART,INDLTRAJ3D,INDLFLUX3D
INTEGER :: INDLTRAJ_GROUP
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INTEGER :: INBMIN, J, JJ, JM
INTEGER :: ISTA
INTEGER :: INBV, IND9999
INTEGER :: INDQ1,INDQ2
INTEGER,DIMENSION(30,100) :: IIMIN
!!!!!!!!!!!!JOEL!!!!!!!!!!
INTEGER,DIMENSION(603) :: IT
REAL,DIMENSION(100) :: ZISOLEV
REAL :: ZISO, ZX, ZY
LOGICAl :: GXI=.FALSE., GXJ=.FALSE.
!!! NOVEMBRE 2009 G. TANGUY
INTEGER :: INDL90TITYT,INDL90TITYM,INDL90TITYB
!------------------------------------------------------------------------------
!
YCARIN=' '
YCARIN = ADJUSTL(HCARIN)
YCARIN = ADJUSTL(YCARIN)
ILENC = LEN_TRIM(YCARIN)
if(nverbia >0)then
print *,' **entree caresolv YCARIN(1:LEN_TRIM(YCARIN)) ',YCARIN(1:ILENC)
endif
!
INDID = INDEX(YCARIN,'_IDEM')
IF(INDID /= 0)THEN
CALL CARMEMORY(YCAR,2)
YCAR=ADJUSTL(YCAR)
! print *,' AP CARMEMORY YCAR ',YCAR(1:LEN_TRIM(YCAR))
ILENGRP=0
! ILENGRP=INDEX(YCAR,'_')-1
ILENC2 = LEN_TRIM(YCAR)
YCARIN(INDID:INDID+ILENC2-ILENGRP-1)=YCAR(ILENGRP+1:ILENC2)
ILENC = LEN_TRIM(YCARIN)
DO J=1,20
IF((INDID-1+ILENC2-ILENGRP) >= ILENC)THEN
EXIT
ELSE
YCARIN(ILENC:ILENC)=' '
ILENC=ILENC-1
ENDIF
ENDDO
ENDIF
INDNSZLBX=INDEX(YCARIN,'NSZLBX')
INDNSZLBY=INDEX(YCARIN,'NSZLBY')
INDIINF=INDEX(YCARIN,'NIINF')
INDISUP=INDEX(YCARIN,'NISUP')
INDJINF=INDEX(YCARIN,'NJINF')
INDJSUP=INDEX(YCARIN,'NJSUP')
INDNHEURXLBL=INDEX(YCARIN,'NHEURXLBL')
INDNHEURXGRAD=INDEX(YCARIN,'NHEURXGRAD')
INDIDEBCOU=INDEX(YCARIN,'NIDEBCOU')
INDJDEBCOU=INDEX(YCARIN,'NJDEBCOU')
INDXTIMEMIN=INDEX(YCARIN,'XTIMEMIN')
INDXTIMEMAX=INDEX(YCARIN,'XTIMEMAX')
INDXIDEBCOU=INDEX(YCARIN,'XIDEBCOU')
INDXJDEBCOU=INDEX(YCARIN,'XJDEBCOU')
INDXSSP=INDEX(YCARIN,'XSSP')
INDXARLSTR=INDEX(YCARIN,'XARLSTR')
INDXLWSTR=INDEX(YCARIN,'XLWSTR')
INDXANGULVT=INDEX(YCARIN,'XANGULVT')
INDXFACTAXEX=INDEX(YCARIN,'XFACTAXEX')
INDXFACTAXEY=INDEX(YCARIN,'XFACTAXEY')
INDXAXEXUSERD=INDEX(YCARIN,'XAXEXUSERD')
INDXAXEYUSERD=INDEX(YCARIN,'XAXEYUSERD')
INDXAXEXUSERF=INDEX(YCARIN,'XAXEXUSERF')
INDXAXEYUSERF=INDEX(YCARIN,'XAXEYUSERF')
INDXSIZEL=INDEX(YCARIN,'XSIZEL')
INDXSZTITXL=INDEX(YCARIN,'XSZTITXL')
INDXSZTITXM=INDEX(YCARIN,'XSZTITXM')
INDXSZTITXR=INDEX(YCARIN,'XSZTITXR')
INDXSZTITYT=INDEX(YCARIN,'XSZTITYT')
INDXSZTITYM=INDEX(YCARIN,'XSZTITYM')
INDXSZTITYB=INDEX(YCARIN,'XSZTITYB')
INDXSZTITT1=INDEX(YCARIN,'XSZTITT1')
INDXSZTITT2=INDEX(YCARIN,'XSZTITT2')
INDXSZTITT3=INDEX(YCARIN,'XSZTITT3')
INDXPOSTITYT=INDEX(YCARIN,'XPOSTITYT')
INDXPOSTITYM=INDEX(YCARIN,'XPOSTITYM')
INDXPOSTITYB=INDEX(YCARIN,'XPOSTITYB')
INDXPOSTITT1=INDEX(YCARIN,'XPOSTITT1')
INDXPOSTITT2=INDEX(YCARIN,'XPOSTITT2')
INDXPOSTITT3=INDEX(YCARIN,'XPOSTITT3')
INDXYPOSTITT1=INDEX(YCARIN,'XYPOSTITT1')
INDXYPOSTITT2=INDEX(YCARIN,'XYPOSTITT2')
INDXYPOSTITT3=INDEX(YCARIN,'XYPOSTITT3')
INDXSZTITB1=INDEX(YCARIN,'XSZTITB1')
INDXSZTITB2=INDEX(YCARIN,'XSZTITB2')
INDXSZTITB3=INDEX(YCARIN,'XSZTITB3')
INDXPOSTITB1=INDEX(YCARIN,'XPOSTITB1')
INDXPOSTITB2=INDEX(YCARIN,'XPOSTITB2')
INDXPOSTITB3=INDEX(YCARIN,'XPOSTITB3')
INDXYPOSTITYT=INDEX(YCARIN,'XYPOSTITYT')
INDXYPOSTITYM=INDEX(YCARIN,'XYPOSTITYM')
INDXYPOSTITYB=INDEX(YCARIN,'XYPOSTITYB')
INDXYPOSTITB1=INDEX(YCARIN,'XYPOSTITB1')
INDXYPOSTITB2=INDEX(YCARIN,'XYPOSTITB2')
INDXYPOSTITB3=INDEX(YCARIN,'XYPOSTITB3')
INDXSZTITVAR1=INDEX(YCARIN,'XSZTITVAR1')
INDXSZTITVAR2=INDEX(YCARIN,'XSZTITVAR2')
INDXSZTITVAR3=INDEX(YCARIN,'XSZTITVAR3')
INDXSZTITVAR4=INDEX(YCARIN,'XSZTITVAR4')
INDXSZTITVAR5=INDEX(YCARIN,'XSZTITVAR5')
INDXSZTITVAR6=INDEX(YCARIN,'XSZTITVAR6')
INDXSZTITVAR7=INDEX(YCARIN,'XSZTITVAR7')
INDXSZTITVAR8=INDEX(YCARIN,'XSZTITVAR8')
INDXPOSTITVAR1=INDEX(YCARIN,'XPOSTITVAR1')
INDXPOSTITVAR2=INDEX(YCARIN,'XPOSTITVAR2')
INDXPOSTITVAR3=INDEX(YCARIN,'XPOSTITVAR3')
INDXYPOSTITVAR1=INDEX(YCARIN,'XYPOSTITVAR1')
INDXYPOSTITVAR2=INDEX(YCARIN,'XYPOSTITVAR2')
INDXYPOSTITVAR3=INDEX(YCARIN,'XYPOSTITVAR3')
INDXPOSTITVAR4=INDEX(YCARIN,'XPOSTITVAR4')
INDXPOSTITVAR5=INDEX(YCARIN,'XPOSTITVAR5')
INDXPOSTITVAR6=INDEX(YCARIN,'XPOSTITVAR6')
INDXYPOSTITVAR4=INDEX(YCARIN,'XYPOSTITVAR4')
INDXYPOSTITVAR5=INDEX(YCARIN,'XYPOSTITVAR5')
INDXYPOSTITVAR6=INDEX(YCARIN,'XYPOSTITVAR6')
INDXPOSTITVAR7=INDEX(YCARIN,'XPOSTITVAR7')
INDXPOSTITVAR8=INDEX(YCARIN,'XPOSTITVAR8')
INDXYPOSTITVAR7=INDEX(YCARIN,'XYPOSTITVAR7')
INDXYPOSTITVAR8=INDEX(YCARIN,'XYPOSTITVAR8')
!*JD*Mars 2009
INDXPOSXVARNPV1TOP=INDEX(YCARIN,'XPOSXVARNPV1TOP')
INDXPOSYVARNPV1TOP=INDEX(YCARIN,'XPOSYVARNPV1TOP')
INDXPOSXVARNPV5BOT=INDEX(YCARIN,'XPOSXVARNPV5BOT')
INDXPOSYVARNPV5BOT=INDEX(YCARIN,'XPOSYVARNPV5BOT')
INDXSZVARNPVTOP=INDEX(YCARIN,'XSZVARNPVTOP')
INDXSZVARNPVBOT=INDEX(YCARIN,'XSZVARNPVBOT')
!*JD*Mars 2009
INDXIDEBCVLL=INDEX(YCARIN,'XIDEBCVLL')
INDXIDEBCV=0
IF(INDXIDEBCVLL == 0)THEN
INDXIDEBCV=INDEX(YCARIN,'XIDEBCV')
ENDIF
INDXJDEBCVLL=INDEX(YCARIN,'XJDEBCVLL')
INDXJDEBCV=0
IF(INDXJDEBCVLL == 0)THEN
INDXJDEBCV=INDEX(YCARIN,'XJDEBCV')
ENDIF
INDXIFINCVLL=INDEX(YCARIN,'XIFINCVLL')
INDXIFINCV=0
IF(INDXIFINCVLL == 0)THEN
INDXIFINCV=INDEX(YCARIN,'XIFINCV')
ENDIF
INDXJFINCVLL=INDEX(YCARIN,'XJFINCVLL')
INDXJFINCV=0
IF(INDXJFINCVLL == 0)THEN
INDXJFINCV=INDEX(YCARIN,'XJFINCV')
ENDIF
INDNIDEBCV=INDEX(YCARIN,'NIDEBCV')
INDNJDEBCV=INDEX(YCARIN,'NJDEBCV')
INDNIFINCV=INDEX(YCARIN,'NIFINCV')
INDNJFINCV=INDEX(YCARIN,'NJFINCV')
INDXAMX=INDEX(YCARIN,'XAMX')
INDXVHC=INDEX(YCARIN,'XVHC=')
IF(INDXVHC == 0)THEN
INDXVHC=INDEX(YCARIN,'XVHC =')
ENDIF
INDXVHCPH=INDEX(YCARIN,'XVHCPH')
INDXVLC=INDEX(YCARIN,'XVLC')
INDXVRL=INDEX(YCARIN,'XVRL=')
IF(INDXVRL == 0)THEN
INDXVRL=INDEX(YCARIN,'XVRL =')
ENDIF
INDXVRLPH=INDEX(YCARIN,'XVRLPH')
INDVISU=INDEX(YCARIN,'VISU')
INDNOVISU=INDEX(YCARIN,'NOVISU')
INDNVERBIA=INDEX(YCARIN,'NVERBIA')
INDXPMIN=INDEX(YCARIN,'XPMIN')
INDXPMAX=INDEX(YCARIN,'XPMAX')
INDXPINT=INDEX(YCARIN,'XPINT')
INDXHMIN=INDEX(YCARIN,'XHMIN')
INDXHMAX=INDEX(YCARIN,'XHMAX')
INDXLATRAD1=INDEX(YCARIN,'XLATRAD1')
INDXLATRAD2=INDEX(YCARIN,'XLATRAD2')
INDXLATRAD3=INDEX(YCARIN,'XLATRAD3')
INDXLATRAD4=INDEX(YCARIN,'XLATRAD4')
INDXLONRAD1=INDEX(YCARIN,'XLONRAD1')
INDXLONRAD2=INDEX(YCARIN,'XLONRAD2')
INDXLONRAD3=INDEX(YCARIN,'XLONRAD3')
INDXLONRAD4=INDEX(YCARIN,'XLONRAD4')
INDXSPVALT=INDEX(YCARIN,'XSPVALT')
INDXSPVAL=INDEX(YCARIN,'XSPVAL=')
IF(INDXSPVAL == 0)THEN
INDXSPVAL=INDEX(YCARIN,'XSPVAL =')
IF(INDXSPVAL == 0)THEN
INDXSPVAL=INDEX(YCARIN,'XSPVAL =')
ENDIF
ENDIF
INDXPORTRAD1=INDEX(YCARIN,'XPORTRAD1')
INDXPORTRAD2=INDEX(YCARIN,'XPORTRAD2')
INDXPORTRAD3=INDEX(YCARIN,'XPORTRAD3')
INDXPORTRAD4=INDEX(YCARIN,'XPORTRAD4')
INDXLWRAD1=INDEX(YCARIN,'XLWRAD1')
INDXLWRAD2=INDEX(YCARIN,'XLWRAD2')
INDXLWRAD3=INDEX(YCARIN,'XLWRAD3')
INDXLWRAD4=INDEX(YCARIN,'XLWRAD4')
INDXISOMIN_=INDEX(YCARIN,'XISOMIN_')
INDXISOMAX_=INDEX(YCARIN,'XISOMAX_')
INDXISOMIN=INDEX(YCARIN,'XISOMIN')
INDXISOMAX=INDEX(YCARIN,'XISOMAX')
IF(INDXISOMIN_ /= 0)THEN
INDXISOMIN=0
ENDIF
IF(INDXISOMAX_ /= 0)THEN
INDXISOMAX=0
ENDIF
INDNLANGLE=INDEX(YCARIN,'NLANGLE')
INDNLMAX=INDEX(YCARIN,'NLMAX')
INDNZSTR=INDEX(YCARIN,'NZSTR')
INDNARSTR=INDEX(YCARIN,'NARSTR')
INDNIOFFD=INDEX(YCARIN,'NIOFFD')
INDNSD=INDEX(YCARIN,'NSD')
INDNULBLL=INDEX(YCARIN,'NULBLL')
INDNDOT=INDEX(YCARIN,'NDOT')
INDNISKIP=INDEX(YCARIN,'NISKIP=')
IF(INDNISKIP == 0)THEN
INDNISKIP=INDEX(YCARIN,'NISKIP =')
ENDIF
INDNISKIPVX=INDEX(YCARIN,'NISKIPVX')
INDNISKIPVY=INDEX(YCARIN,'NISKIPVY')
INDNHI=INDEX(YCARIN,'NHI')
INDNIMNMX=INDEX(YCARIN,'NIMNMX')
INDNFT1ITVXMJ=INDEX(YCARIN,'NFT1ITVXMJ')
INDNFT1ITVXMN=INDEX(YCARIN,'NFT1ITVXMN')
INDNFT1ITVYMJ=INDEX(YCARIN,'NFT1ITVYMJ')
INDNFT1ITVYMN=INDEX(YCARIN,'NFT1ITVYMN')
INDNFTITVXMJ=INDEX(YCARIN,'NFTITVXMJ')
INDNFTITVXMN=INDEX(YCARIN,'NFTITVXMN')
INDNFTITVYMJ=INDEX(YCARIN,'NFTITVYMJ')
INDNFTITVYMN=INDEX(YCARIN,'NFTITVYMN')
INDNCHITVXMJ=INDEX(YCARIN,'NCHITVXMJ')
INDNCHITVXMN=INDEX(YCARIN,'NCHITVXMN')
INDNCHITVYMJ=INDEX(YCARIN,'NCHITVYMJ')
INDNCHITVYMN=INDEX(YCARIN,'NCHITVYMN')
INDNCHPCITVXMJ=INDEX(YCARIN,'NCHPCITVXMJ')
INDNCHPCITVXMN=INDEX(YCARIN,'NCHPCITVXMN')
INDNCHPCITVYMJ=INDEX(YCARIN,'NCHPCITVYMJ')
INDNCHPCITVYMN=INDEX(YCARIN,'NCHPCITVYMN')
INDNCVITVXMJ=INDEX(YCARIN,'NCVITVXMJ')
INDNCVITVXMN=INDEX(YCARIN,'NCVITVXMN')
INDNCVITVYMJ=INDEX(YCARIN,'NCVITVYMJ')
INDNCVITVYMN=INDEX(YCARIN,'NCVITVYMN')
INDNPVITVXMJ=INDEX(YCARIN,'NPVITVXMJ')
INDNPVITVXMN=INDEX(YCARIN,'NPVITVXMN')
INDNPVITVYMJ=INDEX(YCARIN,'NPVITVYMJ')
INDNPVITVYMN=INDEX(YCARIN,'NPVITVYMN')
INDNXYITVXMJ=INDEX(YCARIN,'NXYITVXMJ')
INDNXYITVXMN=INDEX(YCARIN,'NXYITVXMN')
INDNXYITVYMJ=INDEX(YCARIN,'NXYITVYMJ')
INDNXYITVYMN=INDEX(YCARIN,'NXYITVYMN')
INDNMASKITVXMJ=INDEX(YCARIN,'NMASKITVXMJ')
INDNMASKITVXMN=INDEX(YCARIN,'NMASKITVXMN')
INDNMASKITVYMJ=INDEX(YCARIN,'NMASKITVYMJ')
INDNMASKITVYMN=INDEX(YCARIN,'NMASKITVYMN')
INDXDIAINT_=INDEX(YCARIN,'XDIAINT_')
INDXDIAINT=INDEX(YCARIN,'XDIAINT')
IF(INDXDIAINT_ /= 0)THEN
INDXDIAINT=0
ENDIF
!!!!!!!!!!
INDLVARNPVUSER=INDEX(YCARIN,'LVARNPVUSER')
INDLVPTFT1USER=INDEX(YCARIN,'LVPTFT1USER')
INDLVARNPHUSER=INDEX(YCARIN,'LVARNPHUSER')
!!!!!!!!!!
INDLM5S3=INDEX(YCARIN,'LM5S3')
INDLSYMBTEXTG=INDEX(YCARIN,'LSYMBTEXTG')
INDLCVZOOM=INDEX(YCARIN,'LCVZOOM')
INDLVST=INDEX(YCARIN,'LVST')
INDLDILW=INDEX(YCARIN,'LDILW')
INDLXYNVARTOP=INDEX(YCARIN,'LXYNVARTOP')
INDLXYSTYLTOP=INDEX(YCARIN,'LXYSTYLTOP')
INDLXYWINCUR=INDEX(YCARIN,'LXYWINCUR')
INDLVSUPSCA=INDEX(YCARIN,'LVSUPSCA')
INDLSYMB=INDEX(YCARIN,'LSYMB=')
IF(INDLSYMB == 0)THEN
INDLSYMB=INDEX(YCARIN,'LSYMB =')
ENDIF
INDLTEXTG=INDEX(YCARIN,'LTEXTG')
INDLTEXTIT=INDEX(YCARIN,'LTEXTIT')
INDLTRACECV=INDEX(YCARIN,'LTRACECV')
INDLSTI=INDEX(YCARIN,'LSTI')
INDLSEGM=INDEX(YCARIN,'OLSEGM')
IF(INDLSEGM == 0)THEN
INDLSEGM=INDEX(YCARIN,'LSEGM')
ELSE
INDLSEGM=0
ENDIF
INDLXY=INDEX(YCARIN,'LXY=')
IF(INDLXY == 0)THEN
INDLXY=INDEX(YCARIN,'LXY =')
ENDIF
INDLXZ=INDEX(YCARIN,'LXZ')
INDLVECTMNMX=INDEX(YCARIN,'LVECTMNMX')
INDLISO=INDEX(YCARIN,'LISO=')
IF(INDLISO == 0)THEN
INDLISO=INDEX(YCARIN,'LISO =')
ENDIF
INDLANIMK=INDEX(YCARIN,'LANIMK')
INDLANIMT=INDEX(YCARIN,'LANIMT')
INDLMINMAX=INDEX(YCARIN,'LMINMAX')
INDATFILE=INDEX(YCARIN,'LDATFILE')
INDLINTERPTOP=INDEX(YCARIN,'LINTERPTOP=')
INDLSPSECT=INDEX(YCARIN,'LSPSECT')
INDLSPVALT=INDEX(YCARIN,'LSPVALT')
INDLPRESY=INDEX(YCARIN,'LPRESY')
INDLEGVECT=INDEX(YCARIN,'LEGVECT')
INDLSTREAM=INDEX(YCARIN,'LSTREAM')
INDLINTERPOLSTR=INDEX(YCARIN,'LINTERPOLSTR')
INDLNOLBLBAR=INDEX(YCARIN,'LNOLBLBAR')
INDLNOLABELX=INDEX(YCARIN,'LNOLABELX')
INDLNOLABELY=INDEX(YCARIN,'LNOLABELY')
INDLNOUVRS=INDEX(YCARIN,'LNOUVRS')
INDLMYHEURX=INDEX(YCARIN,'LMYHEURX')
INDLRADAR=INDEX(YCARIN,'LRADAR')
INDLRADIST=INDEX(YCARIN,'LRADIST')
INDLRADRAY=INDEX(YCARIN,'LRADRAY')
INDLCOLAREA=INDEX(YCARIN,'LCOLAREA=')
IF(INDLCOLAREA == 0)THEN
INDLCOLAREA=INDEX(YCARIN,'LCOLAREA =')
ENDIF
INDLFT1LUSER=INDEX(YCARIN,'LFT1LUSER')
INDLFTBAUTO=INDEX(YCARIN,'LFTBAUTO')
INDLFT1BAUTO=INDEX(YCARIN,'LFT1BAUTO')
INDLTITFTUSER=INDEX(YCARIN,'LTITFTUSER')
INDLPHCOLUSER=INDEX(YCARIN,'LPHCOLUSER')
INDLPHSTYUSER=INDEX(YCARIN,'LPHSTYUSER')
INDLXABSC=INDEX(YCARIN,'LXABSC')
INDLXMINTOP=INDEX(YCARIN,'LXMINTOP')
INDLABEL1=INDEX(YCARIN,'LABEL1')
INDLDEFCV2LL=INDEX(YCARIN,'LDEFCV2LL')
INDLDEFCV2IND=INDEX(YCARIN,'LDEFCV2IND')
INDLDEFCV2=0
INDLDEFCV2=INDEX(YCARIN,'LDEFCV2=')
IF(INDLDEFCV2 == 0)THEN
INDLDEFCV2=INDEX(YCARIN,'LDEFCV2 =')
ENDIF
IF(INDLDEFCV2 == 0)THEN
INDLDEFCV2=INDEX(YCARIN,'LDEFCV2 =')
ENDIF
IF(NVERBIA > 0)THEN
print *,' INDLDEFCV2LL,INDLDEFCV2IND,INDLDEFCV2 ',INDLDEFCV2LL,INDLDEFCV2IND,INDLDEFCV2
ENDIF
INDLBLUSER1=INDEX(YCARIN,'LBLUSER1')
INDLBLUSER2=INDEX(YCARIN,'LBLUSER2')
INDLBLUSER3=INDEX(YCARIN,'LBLUSER3')
INDLBLUSER4=INDEX(YCARIN,'LBLUSER4')
INDLINDSP=INDEX(YCARIN,'LINDSP')
INDLINDAX=INDEX(YCARIN,'LINDAX')
INDLCOLUSERUV=INDEX(YCARIN,'LCOLUSERUV')
INDLTIMEUSER=INDEX(YCARIN,'LTIMEUSER')
INDLCHREEL=INDEX(YCARIN,'LCHREEL')
INDLOGNEP=INDEX(YCARIN,'LOGNEP')
INDLCOLISONE=INDEX(YCARIN,'LCOLISONE')
INDLCOLRSONE=INDEX(YCARIN,'LCOLRSONE')
INDLCOLRS1ONE=INDEX(YCARIN,'LCOLRS1ONE')
INDLCOLINE=INDEX(YCARIN,'LCOLINE')
INDL24H=INDEX(YCARIN,'L24H')
INDLCONT=INDEX(YCARIN,'LCONT')
INDL2CONT=INDEX(YCARIN,'L2CONT')
INDLRELIEF=INDEX(YCARIN,'LRELIEF')
INDLCONV2XY=INDEX(YCARIN,'LCONV2XY')
INDLCONVG2MASS=INDEX(YCARIN,'LCONVG2MASS')
INDLCOLZERO=INDEX(YCARIN,'LCOLZERO')
INDL3D=INDEX(YCARIN,'L3D')
INDLMARKER=INDEX(YCARIN,'LMARKER')
INDLPRDAT=INDEX(YCARIN,'LPRDAT')
INDLPRINTXY=INDEX(YCARIN,'LPRINTXY')
INDLPRINT=INDEX(YCARIN,'LPRINT')
IF((INDLPRINTXY == 0 .AND. INDLPRINT == 0) .OR. (INDLPRINTXY /= INDLPRINT))THEN
ELSE
INDLPRINT=INDEX(YCARIN(INDLPRINTXY+1:LEN_TRIM(YCARIN)),'LPRINT')
IF(INDLPRINT /= 0)THEN
INDLPRINT=INDLPRINT+INDLPRINTXY
ENDIF
ENDIF
INDLPOINTG=INDEX(YCARIN,'LPOINTG')
INDLXYO=INDEX(YCARIN,'LXYO')
INDL2DBX=INDEX(YCARIN,'L2DBX')
INDL2DBY=INDEX(YCARIN,'L2DBY')
INDLTIMEUSER=INDEX(YCARIN,'LTIMEUSER=')
INDLCOLUSER=INDEX(YCARIN,'LCOLUSER=')
IF(INDLCOLUSER == 0)THEN
INDLCOLUSER=INDEX(YCARIN,'LCOLUSER =')
ENDIF
IF(INDLCOLUSER == 0)THEN
INDLCOLUSER=INDEX(YCARIN,'LCOLUSER =')
ENDIF
INDLISOWHI2=INDEX(YCARIN,'LISOWHI2')
INDLISOWHI3=INDEX(YCARIN,'LISOWHI3')
INDLISOWHI=INDEX(YCARIN,'LISOWHI=')
IF(INDLISOWHI == 0)THEN
INDLISOWHI=INDEX(YCARIN,'LISOWHI =')
ENDIF
IF(INDLISOWHI == 0)THEN
INDLISOWHI=INDEX(YCARIN,'LISOWHI =')
ENDIF
IF(INDLISOWHI == 0)THEN
INDLISOWHI=INDEX(YCARIN,'LISOWHI =')
ENDIF
INDLCOLBR=INDEX(YCARIN,'LCOLBR')
INDLCOLAREASEL=INDEX(YCARIN,'LCOLAREASEL')
INDLCOLINESEL=INDEX(YCARIN,'LCOLINESEL')
INDLINVWB=INDEX(YCARIN,'LINVWB')
INDLINVPTIR=INDEX(YCARIN,'LINVPTIR')
INDLDOMAIN=INDEX(YCARIN,'LDOMAIN')
INDLGEOG=INDEX(YCARIN,'LGEOG')
INDLBLFT1SUP=INDEX(YCARIN,'LBLFT1SUP')
INDLMASK3D_XY=INDEX(YCARIN,'LMASK3D_XY')
INDLMASK3D_XZ=INDEX(YCARIN,'LMASK3D_XZ')
INDLMASK3D_YZ=INDEX(YCARIN,'LMASK3D_YZ')
INDLMASK3D=INDEX(YCARIN,'LMASK3D=')
IF(INDLMASK3D == 0)THEN
INDLMASK3D=INDEX(YCARIN,'LMASK3D =')
ENDIF
IF(INDLMASK3D == 0)THEN
INDLMASK3D=INDEX(YCARIN,'LMASK3D =')
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INDLTRAJ3D=INDEX(YCARIN,'LTRAJ3D=')
IF(INDLTRAJ3D == 0)THEN
INDLTRAJ3D=INDEX(YCARIN,'LTRAJ3D =')
ENDIF
IF(INDLTRAJ3D == 0)THEN
INDLTRAJ3D=INDEX(YCARIN,'LTRAJ3D =')
ENDIF
!
INDLFLUX3D=INDEX(YCARIN,'LFLUX3D=')
IF(INDLFLUX3D == 0)THEN
INDLFLUX3D=INDEX(YCARIN,'LFLUX3D =')
ENDIF
IF(INDLFLUX3D == 0)THEN
INDLFLUX3D=INDEX(YCARIN,'LFLUX3D =')
ENDIF
!
INDLTRAJ_GROUP=INDEX(YCARIN,'LTRAJ_GROUP=')
IF(INDLTRAJ_GROUP == 0)THEN
INDLTRAJ_GROUP=INDEX(YCARIN,'LTRAJ_GROUP =')
ENDIF
IF(INDLTRAJ_GROUP == 0)THEN
INDLTRAJ_GROUP=INDEX(YCARIN,'LTRAJ_GROUP =')
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
!IF(INDLMASK3D /= 0)THEN
! LMASK3D_XY=.TRUE.
! LMASK3D_XZ=.TRUE.
! LMASK3D_YZ=.TRUE.
!ENDIF
INDLXYZ00=INDEX(YCARIN,'LXYZ00')
INDLFT3C=INDEX(YCARIN,'LFT3C')
INDLFT4C=INDEX(YCARIN,'LFT4C')
INDLFTCLIP=INDEX(YCARIN,'LFTCLIP')
INDLFT1STYLUSER=INDEX(YCARIN,'LFT1STYLUSER')
INDLFTSTYLUSER=INDEX(YCARIN,'LFTSTYLUSER')
INDLHEURX=INDEX(YCARIN,'LHEURX')
INDLHACH1=INDEX(YCARIN,'LHACH1')
INDLHACH2=INDEX(YCARIN,'LHACH2')
INDLHACH3=INDEX(YCARIN,'LHACH3')
INDLHACH4=INDEX(YCARIN,'LHACH4')
INDLHACHSEL=INDEX(YCARIN,'LHACHSEL')
INDLGREY=INDEX(YCARIN,'LGREY')
INDLTABCOLDEF2=INDEX(YCARIN,'LTABCOLDEF2')
IF(INDLTABCOLDEF2 == 0)THEN
INDLTABCOLDEF=INDEX(YCARIN,'LTABCOLDEF')
ELSE
LTABCOLDEF=.TRUE.
ENDIF
INDLTABCOLDEF=INDEX(YCARIN,'LTABCOLDEF=')
IF(INDLTABCOLDEF == 0)THEN
INDLTABCOLDEF=INDEX(YCARIN,'LTABCOLDEF =')
ENDIF
INDLMNMXUSER=INDEX(YCARIN,'LMNMXUSER')
!Mars 2009
INDLINZEROPV=INDEX(YCARIN,'LINZEROPV')
INDNSTYLINZEROPV=INDEX(YCARIN,'NSTYLINZEROPV')
IF(INDNSTYLINZEROPV /= 0 .AND. (ABS(INDNSTYLINZEROPV-INDLINZEROPV) == 4))THEN
INDLINZEROPV=0
ENDIF
!Mars 2009
INDLMNMXLOC=INDEX(YCARIN,'LMNMXLOC')
INDLULMVTMOLD=INDEX(YCARIN,'LULMVTMOLD')
INDLVPTUSER=INDEX(YCARIN,'LVPTUSER')
INDLVPTVUSER=INDEX(YCARIN,'LVPTVUSER')
INDLVPTPVUSER=INDEX(YCARIN,'LVPTPVUSER')
INDLVPTXYUSER=INDEX(YCARIN,'LVPTXYUSER')
INDLFACTIMP=INDEX(YCARIN,'LFACTIMP')
INDLFACTAXEX=INDEX(YCARIN,'LFACTAXEX')
INDLFACTAXEY=INDEX(YCARIN,'LFACTAXEY')
INDLAXEYUSER=INDEX(YCARIN,'LAXEYUSER')
INDLAXEXUSER=INDEX(YCARIN,'LAXEXUSER')
INDLFMTAXEX=INDEX(YCARIN,'LFMTAXEX')
INDLFMTAXEY=INDEX(YCARIN,'LFMTAXEY')
INDLSPOT=INDEX(YCARIN,'LSPOT')
INDNIFDC=INDEX(YCARIN,'NIFDC')
INDNDOMAINL=INDEX(YCARIN,'NDOMAINL')
INDNDOMAINR=INDEX(YCARIN,'NDOMAINR')
INDNDOMAINB=INDEX(YCARIN,'NDOMAINB')
INDNDOMAINT=INDEX(YCARIN,'NDOMAINT')
INDNIGRNC=INDEX(YCARIN,'NIGRNC')
INDNPROFILE=INDEX(YCARIN,'PROFILE')
INDXPVMIN=INDEX(YCARIN,'XPVMIN_')
INDXPVMAX=INDEX(YCARIN,'XPVMAX_')
INDXPVMINT=INDEX(YCARIN,'XPVMINT')
INDXPVMAXT=INDEX(YCARIN,'XPVMAXT')
INDXLWFTALL=INDEX(YCARIN,'XLWFTALL')
INDXLWSEGM=INDEX(YCARIN,'XLWSEGM')
INDXLWDOMAIN=INDEX(YCARIN,'XLWDOMAIN')
INDXLWTRACECV=INDEX(YCARIN,'XLWTRACECV')
INDXLWV=INDEX(YCARIN,'XLWV=')
IF(INDXLWV == 0)THEN
INDXLWV=INDEX(YCARIN,'XLWV =')
ENDIF
IF(INDXLWV == 0)THEN
INDXLWV=INDEX(YCARIN,'XLWV =')
ENDIF
IF(INDXLWV == 0)THEN
INDXLWV=INDEX(YCARIN,'XLWV =')
ENDIF
INDXLW=INDEX(YCARIN,'XLW=')
IF(INDXLW == 0)THEN
INDXLW=INDEX(YCARIN,'XLW =')
ENDIF
IF(INDXLW == 0)THEN
INDXLW=INDEX(YCARIN,'XLW =')
ENDIF
IF(INDXLW == 0)THEN
INDXLW=INDEX(YCARIN,'XLW =')
ENDIF
INDXLW1=INDEX(YCARIN,'XLW1')
INDXLW2=INDEX(YCARIN,'XLW2')
INDXLW3=INDEX(YCARIN,'XLW3')
INDXLW4=INDEX(YCARIN,'XLW4')
INDXLWDEF=INDEX(YCARIN,'XLWDEF')
INDXLWVDEF=INDEX(YCARIN,'XLWVDEF')
INDXLWCONT=INDEX(YCARIN,'XLWCONT')
INDXLWPV1=INDEX(YCARIN,'XLWPV1')
INDXLWPV2=INDEX(YCARIN,'XLWPV2')
INDXLWPV3=INDEX(YCARIN,'XLWPV3')
INDXLWPV4=INDEX(YCARIN,'XLWPV4')
INDXLWPV5=INDEX(YCARIN,'XLWPV5')
INDXLWPV6=INDEX(YCARIN,'XLWPV6')
INDXLWPV7=INDEX(YCARIN,'XLWPV7')
INDXLWPV8=INDEX(YCARIN,'XLWPV8')
INDXLWPV9=INDEX(YCARIN,'XLWPV9')
INDXLWPV10=INDEX(YCARIN,'XLWPV10')
INDXLWPV11=INDEX(YCARIN,'XLWPV11')
INDXLWPV12=INDEX(YCARIN,'XLWPV12')
INDXLWPV13=INDEX(YCARIN,'XLWPV13')
INDXLWPV14=INDEX(YCARIN,'XLWPV14')
INDXLWPV15=INDEX(YCARIN,'XLWPV15')
INDXSTYLPV1=INDEX(YCARIN,'XSTYLPV1')
INDXSTYLPV2=INDEX(YCARIN,'XSTYLPV2')
INDXSTYLPV3=INDEX(YCARIN,'XSTYLPV3')
INDXSTYLPV4=INDEX(YCARIN,'XSTYLPV4')
INDXSTYLPV5=INDEX(YCARIN,'XSTYLPV5')
INDXSTYLPV6=INDEX(YCARIN,'XSTYLPV6')
INDXSTYLPV7=INDEX(YCARIN,'XSTYLPV7')
INDXSTYLPV8=INDEX(YCARIN,'XSTYLPV8')
INDXSTYLPV9=INDEX(YCARIN,'XSTYLPV9')
INDXSTYLPV10=INDEX(YCARIN,'XSTYLPV10')
INDXSTYLPV11=INDEX(YCARIN,'XSTYLPV11')
INDXSTYLPV12=INDEX(YCARIN,'XSTYLPV12')
INDXSTYLPV13=INDEX(YCARIN,'XSTYLPV13')
INDXSTYLPV14=INDEX(YCARIN,'XSTYLPV14')
INDXSTYLPV15=INDEX(YCARIN,'XSTYLPV15')
INDXPARCOLUV=INDEX(YCARIN,'XPARCOLUV')
INDXISOLEV_=INDEX(YCARIN,'XISOLEV_')
INDXISOLEV=INDEX(YCARIN,'XISOLEV')
IF(INDXISOLEV_ /= 0)THEN
INDXISOLEV=0
ENDIF
INDXICAR=INDEX(YCARIN,'XICAR')
INDXJCAR=INDEX(YCARIN,'XJCAR')
INDXLWPH1=INDEX(YCARIN,'XLWPH1')
INDXLWPH2=INDEX(YCARIN,'XLWPH2')
INDXLWPH3=INDEX(YCARIN,'XLWPH3')
INDXLWPH4=INDEX(YCARIN,'XLWPH4')
INDXLWPH5=INDEX(YCARIN,'XLWPH5')
INDXLWPH6=INDEX(YCARIN,'XLWPH6')
INDXLWPH7=INDEX(YCARIN,'XLWPH7')
INDXLWPH8=INDEX(YCARIN,'XLWPH8')
INDXLATCAR=INDEX(YCARIN,'XLATCAR')
INDXLONCAR=INDEX(YCARIN,'XLONCAR')
INDCNOMCAR=INDEX(YCARIN,'CNOMCAR')
INDCSYMCAR=INDEX(YCARIN,'CSYMCAR')
INDCSYMRAD1=INDEX(YCARIN,'CSYMRAD1')
INDCSYMRAD2=INDEX(YCARIN,'CSYMRAD2')
INDCSYMRAD3=INDEX(YCARIN,'CSYMRAD3')
INDCSYMRAD4=INDEX(YCARIN,'CSYMRAD4')
INDXPOSNOM=INDEX(YCARIN,'XPOSNOM')
INDXSZNOM=INDEX(YCARIN,'XSZNOM')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INDNSZRTRAJ=INDEX(YCARIN,'NSZRTRAJ')
INDLFMTRTRAJ=INDEX(YCARIN,'LFMTRTRAJ')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INDXSZSYM=INDEX(YCARIN,'XSZSYM')
INDICOLNOM=INDEX(YCARIN,'ICOLNOM')
INDICOLSYM=INDEX(YCARIN,'ICOLSYM')
INDNINDCOLUV=INDEX(YCARIN,'NINDCOLUV')
INDXXL=INDEX(YCARIN,'XXL')
INDXXH=INDEX(YCARIN,'XXH')
INDXVPTXYL=INDEX(YCARIN,'XVPTXYL')
INDXYL=0
IF(INDXVPTXYL == 0)THEN
INDXYL=INDEX(YCARIN,'XYL')
! Aout 2001 Pour tenir compte de EMIS_XYLE (xylene chimie)
IF(INDXYL /= 0)THEN
INDTMP=0
INDTMP=INDEX(YCARIN,'_XYLE')
IF(INDTMP /= 0)THEN
INDXYL=0
ENDIF
ENDIF
! Aout 2001 Pour tenir compte de EMIS_XYLE (xylene chimie)
ENDIF
INDXYH=INDEX(YCARIN,'XYH')
INDXZL=INDEX(YCARIN,'XZL')
INDXZH=INDEX(YCARIN,'XZH')
INDXFT_ADTIM1=INDEX(YCARIN,'XFT_ADTIM1')
INDXFT_ADTIM2=INDEX(YCARIN,'XFT_ADTIM2')
INDXFT_ADTIM3=INDEX(YCARIN,'XFT_ADTIM3')
INDXFT_ADTIM4=INDEX(YCARIN,'XFT_ADTIM4')
INDXFT_ADTIM5=INDEX(YCARIN,'XFT_ADTIM5')
INDXFT_ADTIM6=INDEX(YCARIN,'XFT_ADTIM6')
INDXFT_ADTIM7=INDEX(YCARIN,'XFT_ADTIM7')
INDXFT_ADTIM8=INDEX(YCARIN,'XFT_ADTIM8')
INDXFT1_ADTIM1=INDEX(YCARIN,'XFT1_ADTIM1')
INDXFT1_ADTIM2=INDEX(YCARIN,'XFT1_ADTIM2')
INDXFT1_ADTIM3=INDEX(YCARIN,'XFT1_ADTIM3')
INDXFT1_ADTIM4=INDEX(YCARIN,'XFT1_ADTIM4')
INDXFT1_ADTIM5=INDEX(YCARIN,'XFT1_ADTIM5')
INDXFT1_ADTIM6=INDEX(YCARIN,'XFT1_ADTIM6')
INDXFT1_ADTIM7=INDEX(YCARIN,'XFT1_ADTIM7')
INDXFT1_ADTIM8=INDEX(YCARIN,'XFT1_ADTIM8')
INDXFTMIN=INDEX(YCARIN,'XFTMIN')
INDXFTMAX=INDEX(YCARIN,'XFTMAX')
INDXFT1MIN=INDEX(YCARIN,'XFT1MIN')
INDXFT1MAX=INDEX(YCARIN,'XFT1MAX')
print *,' ***CARESOLV INDXFT1MIN,INDXFT1MAX ',INDXFT1MIN,INDXFT1MAX
INDXFT1MIN_=INDEX(YCARIN,'XFT1MIN_')
INDXFT1MAX_=INDEX(YCARIN,'XFT1MAX_')
IF(INDXFT1MIN_ /= 0)THEN
INDXFT1MIN=0
ENDIF
IF(INDXFT1MAX_ /= 0)THEN
INDXFT1MAX=0
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INDXXPART=INDEX(YCARIN,'XXPART')
INDXYPART=INDEX(YCARIN,'XYPART')
INDXZPART=INDEX(YCARIN,'XZPART')
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INDXPVKTMIN=INDEX(YCARIN,'XPVKTMIN')
INDXPVKTMAX=INDEX(YCARIN,'XPVKTMAX')
INDXVARMIN=INDEX(YCARIN,'XVARMIN')
INDXVARMAX=INDEX(YCARIN,'XVARMAX')
INDXZTMIN=INDEX(YCARIN,'XZTMIN')
INDXZTMAX=INDEX(YCARIN,'XZTMAX')
INDXVPTL=INDEX(YCARIN,'XVPTL')
INDXVPTR=INDEX(YCARIN,'XVPTR')
INDXVPTB=INDEX(YCARIN,'XVPTB')
INDXVPTT=INDEX(YCARIN,'XVPTT')
INDXVPTVL=INDEX(YCARIN,'XVPTVL')
INDXVPTVR=INDEX(YCARIN,'XVPTVR')
INDXVPTVB=INDEX(YCARIN,'XVPTVB')
INDXVPTVT=INDEX(YCARIN,'XVPTVT')
INDXVPTPVL=INDEX(YCARIN,'XVPTPVL')
INDXVPTPVR=INDEX(YCARIN,'XVPTPVR')
INDXVPTPVB=INDEX(YCARIN,'XVPTPVB')
INDXVPTPVT=INDEX(YCARIN,'XVPTPVT')
INDXVPTXYL=INDEX(YCARIN,'XVPTXYL')
INDXVPTXYR=INDEX(YCARIN,'XVPTXYR')
INDXVPTXYB=INDEX(YCARIN,'XVPTXYB')
INDXVPTXYT=INDEX(YCARIN,'XVPTXYT')
!!!!!!!!!!!!!
INDXVPTFT1L=INDEX(YCARIN,'XVPTFT1L')
INDXVPTFT1R=INDEX(YCARIN,'XVPTFT1R')
INDXVPTFT1B=INDEX(YCARIN,'XVPTFT1B')
INDXVPTFT1T=INDEX(YCARIN,'XVPTFT1T')
!!!!!!!!!!!!!
INDNIRS=INDEX(YCARIN,'NIRS')
INDNJRS=INDEX(YCARIN,'NJRS')
INDXIRS=INDEX(YCARIN,'XIRS')
INDXJRS=INDEX(YCARIN,'XJRS')
INDNCOLZERO=INDEX(YCARIN,'NCOLZERO')
INDNCOLUV1=INDEX(YCARIN,'NCOLUV1')
INDNCOLUV2=INDEX(YCARIN,'NCOLUV2')
INDNCOLUV3=INDEX(YCARIN,'NCOLUV3')
INDNCOLUV4=INDEX(YCARIN,'NCOLUV4')
INDNCOLUV5=INDEX(YCARIN,'NCOLUV5')
INDNCOLSEGM=INDEX(YCARIN,'NCOLSEGMS')
INDNCOLISONE1=INDEX(YCARIN,'NCOLISONE1')
INDNCOLISONE2=INDEX(YCARIN,'NCOLISONE2')
INDNCOLISONE3=INDEX(YCARIN,'NCOLISONE3')
INDNCOLISONE4=INDEX(YCARIN,'NCOLISONE4')
INDNCOLISONE5=INDEX(YCARIN,'NCOLISONE5')
INDNCOLRS1ONE1=INDEX(YCARIN,'NCOLRS1ONE1')
INDNCOLRS1ONE2=INDEX(YCARIN,'NCOLRS1ONE2')
INDNCOLRS1ONE3=INDEX(YCARIN,'NCOLRS1ONE3')
INDNCOLRS1ONE4=INDEX(YCARIN,'NCOLRS1ONE4')
INDNCOLRS1ONE5=INDEX(YCARIN,'NCOLRS1ONE5')
INDNCOLRSONE=INDEX(YCARIN,'NCOLRSONE')
INDXISOREF_=INDEX(YCARIN,'XISOREF_')
INDXISOREF=INDEX(YCARIN,'XISOREF')
IF(INDXISOREF_ /= 0)THEN
INDXISOLEV=0
ENDIF
!*JD* Mars 2009
INDNFT1STY1=INDEX(YCARIN,'NFT1STY1')
INDNFT1STY2=INDEX(YCARIN,'NFT1STY2')
INDNFT1STY3=INDEX(YCARIN,'NFT1STY3')
INDNFT1STY4=INDEX(YCARIN,'NFT1STY4')
INDNFT1STY5=INDEX(YCARIN,'NFT1STY5')
INDNFT1STY6=INDEX(YCARIN,'NFT1STY6')
INDNFT1STY7=INDEX(YCARIN,'NFT1STY7')
INDNFT1STY8=INDEX(YCARIN,'NFT1STY8')
INDNFT1STY9=INDEX(YCARIN,'NFT1STY9')
INDNFT1STY10=INDEX(YCARIN,'NFT1STY10')
INDNFT1STY11=INDEX(YCARIN,'NFT1STY11')
INDNFT1STY12=INDEX(YCARIN,'NFT1STY12')
INDNFT1STY13=INDEX(YCARIN,'NFT1STY13')
INDNFT1STY14=INDEX(YCARIN,'NFT1STY14')
INDNFT1STY15=INDEX(YCARIN,'NFT1STY15')
!
INDNFT1COL1=INDEX(YCARIN,'NFT1COL1')
INDNFT1COL2=INDEX(YCARIN,'NFT1COL2')
INDNFT1COL3=INDEX(YCARIN,'NFT1COL3')
INDNFT1COL4=INDEX(YCARIN,'NFT1COL4')
INDNFT1COL5=INDEX(YCARIN,'NFT1COL5')
INDNFT1COL6=INDEX(YCARIN,'NFT1COL6')
INDNFT1COL7=INDEX(YCARIN,'NFT1COL7')
INDNFT1COL8=INDEX(YCARIN,'NFT1COL8')
INDNFT1COL9=INDEX(YCARIN,'NFT1COL9')
INDNFT1COL10=INDEX(YCARIN,'NFT1COL10')
INDNFT1COL11=INDEX(YCARIN,'NFT1COL11')
INDNFT1COL12=INDEX(YCARIN,'NFT1COL12')
INDNFT1COL13=INDEX(YCARIN,'NFT1COL13')
INDNFT1COL14=INDEX(YCARIN,'NFT1COL14')
INDNFT1COL15=INDEX(YCARIN,'NFT1COL15')
!
INDXFT1LW1=INDEX(YCARIN,'XFT1LW1')
INDXFT1LW2=INDEX(YCARIN,'XFT1LW2')
INDXFT1LW3=INDEX(YCARIN,'XFT1LW3')
INDXFT1LW4=INDEX(YCARIN,'XFT1LW4')
INDXFT1LW5=INDEX(YCARIN,'XFT1LW5')
INDXFT1LW6=INDEX(YCARIN,'XFT1LW6')
INDXFT1LW7=INDEX(YCARIN,'XFT1LW7')
INDXFT1LW8=INDEX(YCARIN,'XFT1LW8')
INDXFT1LW9=INDEX(YCARIN,'XFT1LW9')
INDXFT1LW10=INDEX(YCARIN,'XFT1LW10')
INDXFT1LW11=INDEX(YCARIN,'XFT1LW11')
INDXFT1LW12=INDEX(YCARIN,'XFT1LW12')
INDXFT1LW13=INDEX(YCARIN,'XFT1LW13')
INDXFT1LW14=INDEX(YCARIN,'XFT1LW14')
INDXFT1LW15=INDEX(YCARIN,'XFT1LW15')
!
INDCFT1TIT1=INDEX(YCARIN,'CFT1TIT1')
INDCFT1TIT2=INDEX(YCARIN,'CFT1TIT2')
INDCFT1TIT3=INDEX(YCARIN,'CFT1TIT3')
INDCFT1TIT4=INDEX(YCARIN,'CFT1TIT4')
INDCFT1TIT5=INDEX(YCARIN,'CFT1TIT5')
INDCFT1TIT6=INDEX(YCARIN,'CFT1TIT6')
INDCFT1TIT7=INDEX(YCARIN,'CFT1TIT7')
INDCFT1TIT8=INDEX(YCARIN,'CFT1TIT8')
INDCFT1TIT9=INDEX(YCARIN,'CFT1TIT9')
INDCFT1TIT10=INDEX(YCARIN,'CFT1TIT10')
INDCFT1TIT11=INDEX(YCARIN,'CFT1TIT11')
INDCFT1TIT12=INDEX(YCARIN,'CFT1TIT12')
INDCFT1TIT13=INDEX(YCARIN,'CFT1TIT13')
INDCFT1TIT14=INDEX(YCARIN,'CFT1TIT14')
INDCFT1TIT15=INDEX(YCARIN,'CFT1TIT15')
!
INDCVARNPV1=INDEX(YCARIN,'CVARNPV1')
INDCVARNPV2=INDEX(YCARIN,'CVARNPV2')
INDCVARNPV3=INDEX(YCARIN,'CVARNPV3')
INDCVARNPV4=INDEX(YCARIN,'CVARNPV4')
INDCVARNPV5=INDEX(YCARIN,'CVARNPV5')
INDCVARNPV6=INDEX(YCARIN,'CVARNPV6')
INDCVARNPV7=INDEX(YCARIN,'CVARNPV7')
INDCVARNPV8=INDEX(YCARIN,'CVARNPV8')
INDCVARNPV9=INDEX(YCARIN,'CVARNPV9')
INDCVARNPV10=INDEX(YCARIN,'CVARNPV10')
INDCVARNPV11=INDEX(YCARIN,'CVARNPV11')
INDCVARNPV12=INDEX(YCARIN,'CVARNPV12')
INDCVARNPV13=INDEX(YCARIN,'CVARNPV13')
INDCVARNPV14=INDEX(YCARIN,'CVARNPV14')
INDCVARNPV15=INDEX(YCARIN,'CVARNPV15')
!
INDCVARNPH1=INDEX(YCARIN,'CVARNPH1')
INDCVARNPH2=INDEX(YCARIN,'CVARNPH2')
INDCVARNPH3=INDEX(YCARIN,'CVARNPH3')
INDCVARNPH4=INDEX(YCARIN,'CVARNPH4')
INDCVARNPH5=INDEX(YCARIN,'CVARNPH5')
INDCVARNPH6=INDEX(YCARIN,'CVARNPH6')
INDCVARNPH7=INDEX(YCARIN,'CVARNPH7')
INDCVARNPH8=INDEX(YCARIN,'CVARNPH8')
!
INDNPHCOL1=INDEX(YCARIN,'NPHCOL1')
INDNPHCOL2=INDEX(YCARIN,'NPHCOL2')
INDNPHCOL3=INDEX(YCARIN,'NPHCOL3')
INDNPHCOL4=INDEX(YCARIN,'NPHCOL4')
INDNPHCOL5=INDEX(YCARIN,'NPHCOL5')
INDNPHCOL6=INDEX(YCARIN,'NPHCOL6')
INDNPHCOL7=INDEX(YCARIN,'NPHCOL7')
INDNPHCOL8=INDEX(YCARIN,'NPHCOL8')
!
INDNPHSTY1=INDEX(YCARIN,'NPHSTY1')
INDNPHSTY2=INDEX(YCARIN,'NPHSTY2')
INDNPHSTY3=INDEX(YCARIN,'NPHSTY3')
INDNPHSTY4=INDEX(YCARIN,'NPHSTY4')
INDNPHSTY5=INDEX(YCARIN,'NPHSTY5')
INDNPHSTY6=INDEX(YCARIN,'NPHSTY6')
INDNPHSTY7=INDEX(YCARIN,'NPHSTY7')
INDNPHSTY8=INDEX(YCARIN,'NPHSTY8')
!*JD* Mars 2009
!
!G. TANGUY NOVEMBRE 2009
INDL90TITYT=INDEX(YCARIN,'L90TITYT')
INDL90TITYM=INDEX(YCARIN,'L90TITYM')
INDL90TITYB=INDEX(YCARIN,'L90TITYB')
!
INDLPATCH=INDEX(YCARIN,'LPATCH')
if(nverbia >0)then
print *,' ***caresolv AV CARMEMORY'
endif
!!!0701
INDPARTIEL=0
INDPARTIEL= &
INDIINF+INDISUP+INDJINF+INDJSUP+INDIDEBCOU+INDJDEBCOU+INDXIDEBCOU+ &
INDXTIMEMIN + INDXTIMEMAX + INDNSZLBX + INDNSZLBY + &
INDXJDEBCOU+INDNLANGLE+INDNLMAX+INDNIOFFD+INDNULBLL+INDNHI+INDNIMNMX &
+INDNFT1ITVXMJ+INDNFT1ITVXMN+INDNFT1ITVYMJ+INDNFT1ITVYMN &
+INDNFTITVXMJ+INDNFTITVXMN+INDNFTITVYMJ+INDNFTITVYMN + INDNSD &
+INDNCHITVXMJ+INDNCHITVXMN+INDNCHITVYMJ+INDNCHITVYMN &
+INDNCHPCITVXMJ+INDNCHPCITVXMN+INDNCHPCITVYMJ+INDNCHPCITVYMN &
+INDNCVITVXMJ+INDNCVITVXMN+INDNCVITVYMJ+INDNCVITVYMN &
+INDNPVITVXMJ+INDNPVITVXMN+INDNPVITVYMJ+INDNPVITVYMN &
+INDNXYITVXMJ+INDNXYITVXMN+INDNXYITVYMJ+INDNXYITVYMN &
+INDNMASKITVXMJ+INDNMASKITVXMN+INDNMASKITVYMJ+INDNMASKITVYMN &
+INDXDIAINT+INDLXY+INDLXZ+INDLISO+INDLMINMAX+INDLCOLAREA+INDATFILE &
+INDLINTERPTOP+ INDLCOLISONE + INDLCOLRSONE+ INDLCOLRS1ONE+INDLRADAR &
+INDLRADIST+ INDLRADRAY + INDLFTBAUTO + INDLFT1BAUTO+ INDLSPOT &
+INDLNOUVRS + INDLMYHEURX + INDNHEURXLBL + INDNHEURXGRAD &
+INDLCOLINE+INDLISOWHI+INDLCOLBR+INDLCOLAREASEL+INDLCOLINESEL+ &
INDLSPVALT + INDLSEGM + INDLPRESY + INDLSPSECT + INDLEGVECT + &
INDLVECTMNMX + INDLANIMK +INDLANIMT + INDLPRINT + INDLPRINTXY + &
INDLPOINTG + INDL2DBX + INDL2DBY + INDLXYO + INDLISOWHI2+INDLISOWHI3 + &
INDLTABCOLDEF+INDNIFDC+INDNIGRNC+INDXHMIN+INDXHMAX+INDXISOMIN+ &
INDXPMIN + INDXPMAX + INDXPINT + INDLSTREAM + INDLNOLABELX + INDLNOLABELY + &
INDLMNMXUSER + INDLCOLUSER + INDNDOT + INDNISKIP + INDLMNMXLOC + &
INDNISKIPVX + INDNISKIPVY + INDLTIMEUSER + INDLINTERPOLSTR +&
INDLULMVTMOLD + INDNIRS + INDNJRS + INDXIRS + INDXJRS + INDXSPVAL + &
INDXSPVALT + INDLPRDAT + INDNARSTR + INDNZSTR + &
INDXISOMAX+INDVISU+INDNOVISU+INDXSIZEL+INDNPROFILE+INDXPVMIN+ &
INDXAMX+INDXVHC+INDXVRL+INDXLATCAR+INDXLONCAR+ INDNVERBIA + &
INDXICAR + INDXJCAR + INDXLWPH1 + INDXLWPH2 + INDXLWPH3 + INDXLWPH4 + &
INDXLWPH5 + INDXLWPH6 + INDXLWPH7 + INDXLWPH8 + &
INDICOLNOM + INDICOLSYM + INDXSZTITT1 + INDXSZTITT2 +INDXSZTITT3 + &
INDXSZTITYT + INDXSZTITYM +INDXSZTITYB + &
INDNINDCOLUV + INDXVRLPH + INDXVHCPH + INDXSSP + INDXARLSTR + INDXLWSTR + &
INDXSZTITB1 + INDXSZTITB2 + INDXSZTITB3 + INDXSZTITVAR1 + &
INDXSZTITVAR2 + INDXSZTITVAR3 + INDXSZTITVAR4 + INDXSZTITVAR5 + &
INDXSZTITVAR6 + INDXSZTITVAR7 + INDXSZTITVAR8 + INDXPOSTITYT + &
INDXPOSTITYM + INDXPOSTITYB + INDXPOSTITT1 + &
INDXPOSTITT2 + INDXPOSTITT3 + INDXPOSTITB1 + INDXPOSTITB2 + &
INDXPOSTITB3 + INDXYPOSTITT1 + INDLCOLUSERUV + INDLNOLBLBAR + &
INDXYPOSTITT2 + INDXYPOSTITT3 + INDXYPOSTITYT + INDXYPOSTITYM + &
INDXYPOSTITYB + INDXYPOSTITB1 + INDXYPOSTITB2 + &
INDXYPOSTITB3 + INDXPOSTITVAR1 +INDXPOSTITVAR2 + INDXPOSTITVAR3 + INDXPOSTITVAR4
! INDXYPOSTITB3 + INDXPOSTITVAR1 +INDXPOSTITVAR2 + INDXPOSTITVAR3 + INDXPOSTITVAR4 + &
!!!0701
INDPARTIEL=INDPARTIEL + &
INDXPOSTITVAR5 + INDXPOSTITVAR6 + INDXPOSTITVAR7 + INDXPOSTITVAR8 + &
INDXYPOSTITVAR1 + INDXYPOSTITVAR2 + INDXYPOSTITVAR3 + INDXYPOSTITVAR4 + &
INDXYPOSTITVAR5 + INDXYPOSTITVAR6 + INDXYPOSTITVAR7 + INDXYPOSTITVAR8 + &
INDCSYMRAD1+INDCSYMRAD2+INDCSYMRAD3+INDCSYMRAD4+ &
INDXLATRAD1+INDXLATRAD2+INDXLATRAD3+INDXLATRAD4+ &
INDXLONRAD1+INDXLONRAD2+INDXLONRAD3+INDXLONRAD4+ &
INDXISOMIN_ + INDXISOMAX_ + INDXDIAINT_ + INDLABEL1 + INDXVLC + &
INDXPORTRAD1+INDXPORTRAD2+INDXPORTRAD3+INDXPORTRAD4+ &
INDXLWRAD1+INDXLWRAD2+INDXLWRAD3+INDXLWRAD4+ &
INDCNOMCAR + INDCSYMCAR + INDXPOSNOM + INDXSZNOM + INDXSZSYM + &
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INDNSZRTRAJ + INDLFMTRTRAJ + &
!!!!!!!!!!!!!!!!!!!!!
INDXPVMAX+INDXISOLEV+INDXFTMAX+INDXFTMIN+INDXPVKTMIN+INDXPVKTMAX+ &
INDXPARCOLUV + &
INDXFT_ADTIM1+ INDXFT_ADTIM2+INDXFT_ADTIM3 +INDXFT_ADTIM4 + &
INDXFT_ADTIM5 + INDXFT_ADTIM6 + INDXFT_ADTIM7 + INDXFT_ADTIM8 + &
INDXFT1_ADTIM1 + INDXFT1_ADTIM2 + INDXFT1_ADTIM3 + INDXFT1_ADTIM4 + &
INDXFT1_ADTIM5 + INDXFT1_ADTIM6 + INDXFT1_ADTIM7 + INDXFT1_ADTIM8 + &
INDXFT1MIN+INDXFT1MAX+INDXFT1MIN_+INDXFT1MAX_+INDXISOLEV_+ &
INDLVPTUSER + INDLVPTVUSER + INDLVPTPVUSER + INDLXABSC + INDLXMINTOP +&
INDXVPTL + INDXVPTR + INDXVPTB + INDXVPTT + INDLVPTXYUSER + &
INDXVPTVL + INDXVPTVR + INDXVPTVB + INDXVPTVT + INDLFACTIMP + &
INDXVPTPVL + INDXVPTPVR + INDXVPTPVB + INDXVPTPVT + INDLFMTAXEX + &
INDXVPTXYL + INDXVPTXYR + INDXVPTXYB + INDXVPTXYT + INDLFMTAXEY + &
INDLFACTAXEX + INDLFACTAXEY + INDLAXEXUSER + INDLAXEYUSER + &
INDXFACTAXEX + INDXFACTAXEY + INDXAXEXUSERD + INDXAXEXUSERF + &
INDXAXEYUSERD + INDXAXEYUSERF + INDLBLFT1SUP + &
INDXLWV + INDXLWDEF + INDXLWVDEF + INDLINVWB + INDLGEOG + INDLMASK3D + &
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INDXXPART+INDXYPART+INDXZPART+INDLTRAJ3D+INDLFLUX3D+INDLTRAJ_GROUP
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
INDPARTIEL=INDPARTIEL + &
INDLINVPTIR + INDLDOMAIN + INDXLWFTALL + INDXLWSEGM + INDNSTYLINZEROPV + &
INDNDOMAINL + INDNDOMAINR + INDNDOMAINB + INDNDOMAINT + &
INDLMASK3D_XY + INDLMASK3D_XZ + INDLMASK3D_YZ + INDLXYZ00 + &
INDXLWPV1 + INDXLWPV2 + INDXLWPV3 + INDXLWPV4 + INDXLWPV5 + &
INDXLWPV6 + INDXLWPV7 + INDXLWPV8 + INDXLWTRACECV + INDXLWDOMAIN + &
INDXLWPV9 + INDXLWPV10 + &
INDXLWPV11 + INDXLWPV12 + INDXLWPV13 + INDXLWPV14 + INDXLWPV15 + &
INDXSTYLPV1 + INDXSTYLPV2 + INDXSTYLPV3 + INDXSTYLPV4 + INDXSTYLPV5 + &
INDXSTYLPV6 + INDXSTYLPV7 + INDXSTYLPV8 + &
INDXSTYLPV9 + INDXSTYLPV10 + &
INDXSTYLPV11 + INDXSTYLPV12 + INDXSTYLPV13 + INDXSTYLPV14 + INDXSTYLPV15 + &
INDLFT1STYLUSER + INDLFTSTYLUSER + INDLTITFTUSER + INDXLWCONT + &
INDLPHCOLUSER + INDLPHSTYUSER + INDL24H + &
INDXLW + INDXLW1 + INDXLW2 + INDXLW3 + INDXLW4 + INDLMARKER + INDLFTCLIP + &
INDLCOLZERO + INDNCOLZERO + INDLHACH1 + INDLHACH2 + INDLHACH3 + INDL3D + &
INDNCOLISONE1 + INDNCOLISONE2 + INDNCOLISONE3+INDNCOLISONE4+INDNCOLISONE5+ &
INDNCOLRS1ONE1+INDNCOLRS1ONE2+INDNCOLRS1ONE3+INDNCOLRS1ONE4+INDNCOLRS1ONE5+ &
INDNCOLRSONE + INDLHEURX + INDNCOLSEGM + &
!!!0701
INDXISOREF + INDXISOREF_ + INDLSPOT
! print *,' ***caresolv INDPARTIEL C ',INDPARTIEL
!JD240209
INDPARTIEL=INDPARTIEL + &
INDLFT1LUSER+INDNFT1STY1+INDNFT1STY2+INDNFT1STY3+INDNFT1STY4+ &
INDNFT1STY5+INDNFT1STY6+INDNFT1STY7+INDNFT1STY8+INDNFT1STY9+ &
INDNFT1STY10+INDNFT1STY11+INDNFT1STY12+INDNFT1STY13+INDNFT1STY14+ &
INDNFT1STY15+INDNFT1COL1+INDNFT1COL2+INDNFT1COL3+INDNFT1COL4+INDNFT1COL5
! print *,' ***caresolv INDPARTIEL CA ',INDPARTIEL
INDPARTIEL=INDPARTIEL + &
INDNFT1COL6+INDNFT1COL7+INDNFT1COL8+INDNFT1COL9+INDNFT1COL10+ &
INDNFT1COL11+INDNFT1COL12+INDNFT1COL13+INDNFT1COL14+INDNFT1COL15
! print *,' ***caresolv INDPARTIEL CB ',INDPARTIEL
INDPARTIEL=INDPARTIEL + &
INDXFT1LW1+INDXFT1LW2+INDXFT1LW3+INDXFT1LW4+INDXFT1LW5+ &
INDXFT1LW6+INDXFT1LW7+INDXFT1LW8+INDXFT1LW9+INDXFT1LW10+ &
INDXFT1LW11+INDXFT1LW12+INDXFT1LW13+INDXFT1LW14+INDXFT1LW15
! print *,' ***caresolv INDPARTIEL CC',INDPARTIEL
INDPARTIEL=INDPARTIEL + &
INDCFT1TIT1+INDCFT1TIT2+INDCFT1TIT3+INDCFT1TIT4+INDCFT1TIT5+ &
INDCFT1TIT6+INDCFT1TIT7+INDCFT1TIT8+INDCFT1TIT9+INDCFT1TIT10+ &
INDCFT1TIT11+INDCFT1TIT12+INDCFT1TIT13+INDCFT1TIT14+INDCFT1TIT15+ &
INDLVPTFT1USER+INDXVPTFT1L+INDXVPTFT1R+INDXVPTFT1B+INDXVPTFT1T + &
INDXSZVARNPVTOP + INDXSZVARNPVBOT + &
INDXPOSXVARNPV5BOT + INDXPOSYVARNPV5BOT + INDLINZEROPV + &
INDLVARNPVUSER + INDXPOSXVARNPV1TOP + INDXPOSYVARNPV1TOP +&
INDCVARNPV1+INDCVARNPV2+INDCVARNPV3+INDCVARNPV4+INDCVARNPV5+ &
INDCVARNPV6+INDCVARNPV7+INDCVARNPV8+INDCVARNPV9+INDCVARNPV10+ &
INDCVARNPV11+INDCVARNPV12+INDCVARNPV13+INDCVARNPV14+INDCVARNPV15+&
INDL90TITYT+INDL90TITYM+INDL90TITYB+&
INDLVARNPHUSER + INDCVARNPH1+INDCVARNPH2+INDCVARNPH3+INDCVARNPH4+&
INDCVARNPH5+ INDCVARNPH6+INDCVARNPH7+INDCVARNPH8+INDLPATCH
! print *,' ***caresolv INDPARTIEL D ',INDPARTIEL
!
IF(INDPARTIEL + &
INDNPHSTY1+INDNPHSTY2+INDNPHSTY3+INDNPHSTY4+ &
INDNPHSTY5+INDNPHSTY6+INDNPHSTY7+INDNPHSTY8+ &
INDNPHCOL1+INDNPHCOL2+INDNPHCOL3+INDNPHCOL4+ &
INDNPHCOL5+INDNPHCOL6+INDNPHCOL7+INDNPHCOL8+ &
INDLGREY + INDLXYNVARTOP + INDLXYSTYLTOP +&
INDLHACH4 + INDLHACHSEL + INDLBLUSER1 + INDLBLUSER2 + &
INDLBLUSER3 + INDLBLUSER4 + INDLINDSP + INDLOGNEP + INDLTABCOLDEF2+ &
INDXVARMIN +INDXVARMAX + INDXZTMIN + INDXZTMAX + INDLINDAX + INDLCHREEL+ &
INDXSZTITXL + INDXSZTITXM + INDXSZTITXR + INDXANGULVT + &
INDLDEFCV2 + INDLDEFCV2LL + INDLDEFCV2IND + &
INDXIDEBCV + INDXJDEBCV + INDXIFINCV + INDXJFINCV + &
INDXXL + INDXXH + INDXYL + INDXYH + INDXZL + INDXZH + &
INDXIDEBCVLL + INDXJDEBCVLL + INDXIFINCVLL + INDXJFINCVLL + &
INDLCONVG2MASS +&
INDNIDEBCV + INDNJDEBCV + INDNIFINCV + INDNJFINCV + INDLM5S3 + &
INDLSYMB + INDLSYMBTEXTG + INDLSTI + INDLTEXTIT +INDLTEXTG + INDLTRACECV +&
INDLCVZOOM + INDLVST + INDLDILW + INDLVSUPSCA + INDLXYWINCUR + &
INDL2CONT + INDNCOLUV1 + INDNCOLUV2 + INDNCOLUV3 + INDNCOLUV4+ INDNCOLUV5 +&
INDLCONT + INDLRELIEF +INDLCONV2XY + INDXPVMINT + INDXPVMAXT == 0)THEN
CALL CARMEMORY(YCARIN,1)
ENDIF
if(nverbia >0)then
print *,' ***caresolv INDPARTIEL ',INDPARTIEL
print *,' ***caresolv AP CARMEMORY'
endif
LCH =.TRUE.
LCHXY=.FALSE.
LCV =.FALSE.
LCVXZ=.FALSE.
LCVYZ=.FALSE.
LPV =.FALSE.
LPH =.FALSE.
LPVT =.FALSE.
LPXT =.FALSE.
LPYT =.FALSE.
LPVKT =.FALSE.
LCN = .FALSE.
LCNCUM = .FALSE.
LCNSUM = .FALSE.
LFT = .FALSE.
LFT1 = .FALSE.
L1K=.FALSE.
LMINUS=.FALSE.
LPLUS=.FALSE.
LTK= .FALSE.
LEV= .FALSE.
LPR= .FALSE.
LRS= .FALSE.
LRS1= .FALSE.
LPVKT1 =.FALSE.
LZTPVKT1 =.FALSE.
LMSKTOP=.FALSE.
LSV3=.FALSE.
LZT=.FALSE.
LXT=.FALSE.
LYT=.FALSE.
LXYZ=.FALSE.
LUMVMPV=.FALSE.
LXYDIA=.FALSE.
!LANIMK=.FALSE.
!LANIMT=.FALSE.
LSPLO=.FALSE.
LSPO=.FALSE.
LOSPLO=.FALSE.
LPHALO=.FALSE.
LPHAO=.FALSE.
!LCONV2XY=.FALSE.
if(nverbia > 0)then
print *,' **caresolv LTK,LPR,LEV,LSV3 ',LTK,LPR,LEV,LSV3
endif
LSUPERDIA=.FALSE.
NSUPERDIA=0
CARSUP(:)(1:LEN(CARSUP))=' '
LSUPER=.FALSE.
NSUPER=0
LARROVL=.FALSE.
NBNDIA(:)=0
NNDIA(:,:)=0
LNDIALL(:)=.FALSE.
NBPROCDIA(:)=0
NPROCDIA(:,:)=0
LPROCDIALL(:)=.FALSE.
NBLVLKDIA(:,:)=0
NLVLKDIA(:,:,:)=0
LVLKDIALL(:,:)=.FALSE.
NBLVLZDIA(:)=0
XLVLZDIA(:,:)=0.
NBTIMEDIA(:,:)=0
NTIMEDIA(:,:,:)=0
XTIMEDIA(:,:,:)=0.
LTIMEDIALL(:,:)=.FALSE.
NHISTORY(:)=0
NBPM=1
NBPMT=0
NUMPM(:)=0
NGRIDIAM=0
NOPE(:)=0
NOPEL=0
XCONSTANTE(:)=0.
CFACT(:)(1:LEN(CFACT))=' '
if(nverbia >0)then
print *,' ***caresolv AP INIT Logiques'
endif
! Juillet 2001
NMULTDIV(:)=0
CMULTDIV(:)(1:LEN(CMULTDIV))=' '
! Juillet 2001
IF(INDIINF /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDIINF,NIINF)
IF(NIINF /= 999999999)THEN
PRINT *,' NIINF FOURNI ',NIINF
ENDIF
ENDIF
IF(INDJINF /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDJINF,NJINF)
IF(NJINF /= 999999999)THEN
PRINT *,' NJINF FOURNI ',NJINF
ENDIF
ENDIF
IF(INDNSZLBX /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNSZLBX,NSZLBX)
PRINT *,' NSZLBX FOURNI ',NSZLBX
ENDIF
IF(INDNSZLBY /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNSZLBY,NSZLBY)
PRINT *,' NSZLBY FOURNI ',NSZLBY
ENDIF
if(nverbia >5)then
print *,' caresolv AV RESOLVI(INDISUP)'
endif
IF(INDISUP /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDISUP,NISUP)
IF(NISUP /= 999999999)THEN
PRINT *,' NISUP FOURNI ',NISUP
ENDIF
ENDIF
IF(INDJSUP /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDJSUP,NJSUP)
IF(NJSUP /= 999999999)THEN
PRINT *,' NJSUP FOURNI ',NJSUP
ENDIF
ENDIF
IF(INDIDEBCOU /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDIDEBCOU,NIDEBCOU)
IF(NIDEBCOU /= 999999999)THEN
PRINT *,' NIDEBCOU FOURNI ',NIDEBCOU
ENDIF
ENDIF
IF(INDJDEBCOU /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDJDEBCOU,NJDEBCOU)
IF(NJDEBCOU /= 999999999)THEN
PRINT *,' NJDEBCOU FOURNI ',NJDEBCOU
ENDIF
ENDIF
IF(INDNIDEBCV /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIDEBCV,NIDEBCV)
print *,' VALEUR NIDEBCV FOURNIE : ',NIDEBCV
ENDIF
IF(INDNJDEBCV /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNJDEBCV,NJDEBCV)
print *,' VALEUR NJDEBCV FOURNIE : ',NJDEBCV
ENDIF
IF(INDNHEURXLBL /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNHEURXLBL,NHEURXLBL)
print *,' VALEUR NHEURXLBL FOURNIE : ',NHEURXLBL
ENDIF
IF(INDNHEURXGRAD /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNHEURXGRAD,NHEURXGRAD)
print *,' VALEUR NHEURXGRAD FOURNIE : ',NHEURXGRAD
ENDIF
IF(INDNIFINCV /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIFINCV,NIFINCV)
print *,' VALEUR NIFINCV FOURNIE : ',NIFINCV
ENDIF
if(nverbia >5)then
print *,' caresolv AV RESOLVI(INDNJFINCV)'
endif
IF(INDNJFINCV /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNJFINCV,NJFINCV)
print *,' VALEUR NJFINCV FOURNIE : ',NJFINCV
ENDIF
IF(INDXFACTAXEX /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFACTAXEX,XFACTAXEX)
print *,' VALEUR XFACTAXEX FOURNIE : ',XFACTAXEX
ENDIF
IF(INDXFACTAXEY /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFACTAXEY,XFACTAXEY)
print *,' VALEUR XFACTAXEY FOURNIE : ',XFACTAXEY
ENDIF
IF(INDXAXEXUSERD /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXAXEXUSERD,XAXEXUSERD)
print *,' VALEUR XAXEXUSERD FOURNIE : ',XAXEXUSERD
ENDIF
IF(INDXAXEYUSERD /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXAXEYUSERD,XAXEYUSERD)
print *,' VALEUR XAXEYUSERD FOURNIE : ',XAXEYUSERD
ENDIF
IF(INDXAXEXUSERF /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXAXEXUSERF,XAXEXUSERF)
print *,' VALEUR XAXEXUSERF FOURNIE : ',XAXEXUSERF
ENDIF
IF(INDXAXEYUSERF /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXAXEYUSERF,XAXEYUSERF)
print *,' VALEUR XAXEYUSERF FOURNIE : ',XAXEYUSERF
ENDIF
IF(INDXANGULVT /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXANGULVT,XANGULVT)
print *,' VALEUR XANGULVT FOURNIE : ',XANGULVT
ENDIF
if(nverbia >5)then
print *,' caresolv AV RESOLVX(INDXIDEBCV)',INDXIDEBCV
endif
IF(INDXSSP /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSSP,XSSP)
print *,' VALEUR XSSP FOURNIE : ',XSSP
ENDIF
IF(INDXARLSTR /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXARLSTR,XARLSTR)
print *,' VALEUR XARLSTR FOURNIE : ',XARLSTR
ENDIF
IF(INDXLWSTR /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWSTR,XLWSTR)
print *,' VALEUR XLWSTR FOURNIE : ',XLWSTR
ENDIF
IF(INDXIDEBCV /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIDEBCV,XIDEBCV)
print *,' VALEUR XIDEBCV FOURNIE : ',XIDEBCV
ENDIF
if(nverbia >5)then
print *,' caresolv AV RESOLVX(INDXJDEBCV)',INDXJDEBCV
endif
IF(INDXJDEBCV /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJDEBCV,XJDEBCV)
print *,' VALEUR XJDEBCV FOURNIE : ',XJDEBCV
ENDIF
if(nverbia >5)then
print *,' caresolv AV RESOLVX(INDXIDEBCVLL)',INDXIDEBCVLL
endif
IF(INDXIDEBCVLL /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIDEBCVLL,XIDEBCVLL)
print *,' VALEUR XIDEBCVLL FOURNIE : ',XIDEBCVLL
ENDIF
IF(INDXJDEBCVLL /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJDEBCVLL,XJDEBCVLL)
print *,' VALEUR XJDEBCVLL FOURNIE : ',XJDEBCVLL
ENDIF
IF(INDXIFINCV /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIFINCV,XIFINCV)
print *,' VALEUR XIFINCV FOURNIE : ',XIFINCV
ENDIF
IF(INDXJFINCV /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJFINCV,XJFINCV)
print *,' VALEUR XJFINCV FOURNIE : ',XJFINCV
ENDIF
IF(INDXIFINCVLL /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIFINCVLL,XIFINCVLL)
print *,' VALEUR XIFINCVLL FOURNIE : ',XIFINCVLL
ENDIF
IF(INDXJFINCVLL /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJFINCVLL,XJFINCVLL)
print *,' VALEUR XJFINCVLL FOURNIE : ',XJFINCVLL
ENDIF
IF(INDXTIMEMIN /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXTIMEMIN,XTIMEMIN)
print *,' VALEUR XTIMEMIN FOURNIE : ',XTIMEMIN
ENDIF
IF(INDXTIMEMAX /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXTIMEMAX,XTIMEMAX)
print *,' VALEUR XTIMEMAX FOURNIE : ',XTIMEMAX
ENDIF
IF(INDXIDEBCOU /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIDEBCOU,XIDEBCOU)
print *,' VALEUR XIDEBCOU FOURNIE : ',XIDEBCOU
ENDIF
IF(INDXJDEBCOU /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJDEBCOU,XJDEBCOU)
print *,' VALEUR XJDEBCOU FOURNIE : ',XJDEBCOU
ENDIF
IF(INDXPMIN /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPMIN,XPMIN)
print *,' VALEUR XPMIN FOURNIE : ',XPMIN
ENDIF
IF(INDXPMAX /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPMAX,XPMAX)
print *,' VALEUR XPMAX FOURNIE : ',XPMAX
ENDIF
IF(INDXPINT /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPINT,XPINT)
print *,' VALEUR XPINT FOURNIE : ',XPINT
ENDIF
IF(INDXHMIN /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXHMIN,XHMIN)
print *,' VALEUR XHMIN FOURNIE : ',XHMIN
ENDIF
IF(INDXHMAX /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXHMAX,XHMAX)
print *,' VALEUR XHMAX FOURNIE : ',XHMAX
ENDIF
IF(INDXLATRAD1 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLATRAD1,XLATRAD1)
print *,' VALEUR XLATRAD1 FOURNIE : ',XLATRAD1
ENDIF
IF(INDXLATRAD2 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLATRAD2,XLATRAD2)
print *,' VALEUR XLATRAD2 FOURNIE : ',XLATRAD2
ENDIF
IF(INDXLATRAD3 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLATRAD3,XLATRAD3)
print *,' VALEUR XLATRAD3 FOURNIE : ',XLATRAD3
ENDIF
IF(INDXLATRAD4 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLATRAD4,XLATRAD4)
print *,' VALEUR XLATRAD4 FOURNIE : ',XLATRAD4
ENDIF
IF(INDXLONRAD1 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLONRAD1,XLONRAD1)
print *,' VALEUR XLONRAD1 FOURNIE : ',XLONRAD1
ENDIF
IF(INDXLONRAD2 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLONRAD2,XLONRAD2)
print *,' VALEUR XLONRAD2 FOURNIE : ',XLONRAD2
ENDIF
IF(INDXLONRAD3 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLONRAD3,XLONRAD3)
print *,' VALEUR XLONRAD3 FOURNIE : ',XLONRAD3
ENDIF
IF(INDXLONRAD4 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLONRAD4,XLONRAD4)
print *,' VALEUR XLONRAD4 FOURNIE : ',XLONRAD4
ENDIF
IF(INDXSPVAL /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSPVAL,XSPVAL)
print *,' VALEUR XSPVAL FOURNIE : ',XSPVAL
ENDIF
IF(INDXSPVALT /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSPVALT,XSPVALT)
print *,' VALEUR XSPVALT FOURNIE : ',XSPVALT
ENDIF
IF(INDXISOMIN /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMIN,XISOMIN)
print *,' VALEUR XISOMIN FOURNIE : ',XISOMIN
ENDIF
IF(INDXISOMAX /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMAX,XISOMAX)
print *,' VALEUR XISOMAX FOURNIE : ',XISOMAX
ENDIF
IF(INDXISOMIN_ /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMIN_,ZISO)
CALL LOADMNMXINT_ISO(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMIN_,ZISO,1)
print *,' VALEUR XISOMIN_ FOURNIE : ',ZISO
ENDIF
IF(INDXISOMAX_ /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMAX_,ZISO)
CALL LOADMNMXINT_ISO(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOMAX_,ZISO,2)
print *,' VALEUR XISOMAX_ FOURNIE : ',ZISO
ENDIF
IF(INDXDIAINT /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXDIAINT,XDIAINT)
print *,' VALEUR XDIAINT FOURNIE : ',XDIAINT
ENDIF
IF(INDXDIAINT_ /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXDIAINT_,ZISO)
CALL LOADMNMXINT_ISO(YCARIN(1:LEN_TRIM(YCARIN)),INDXDIAINT_,ZISO,3)
print *,' VALEUR XDIAINT_ FOURNIE : ',ZISO
ENDIF
IF(INDXISOREF /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOREF,XISOREF)
print *,' VALEUR XISOREF FOURNIE : ',XISOREF
ENDIF
IF(INDXISOREF_ /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOREF_,ZISO)
CALL LOADMNMXINT_ISO(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOREF_,ZISO,4)
print *,' VALEUR XISOREF_ FOURNIE : ',ZISO
ENDIF
IF(INDNLANGLE /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNLANGLE,NLANGLE)
IF(NLANGLE /= 999999999)THEN
PRINT *,' NLANGLE FOURNI ',NLANGLE
ENDIF
ENDIF
IF(INDNLMAX /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNLMAX,NLMAX)
IF(NLMAX /= 999999999)THEN
PRINT *,' NLMAX FOURNI ',NLMAX
ENDIF
ENDIF
IF(INDNZSTR /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNZSTR,NZSTR)
IF(NZSTR /= 999999999)THEN
PRINT *,' NZSTR FOURNI ',NZSTR
ENDIF
ENDIF
IF(INDNARSTR /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNARSTR,NARSTR)
IF(NARSTR /= 999999999)THEN
PRINT *,' NARSTR FOURNI ',NARSTR
ENDIF
ENDIF
IF(INDNIOFFD /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIOFFD,NIOFFD)
IF(NIOFFD /= 999999999)THEN
PRINT *,' NIOFFD FOURNI ',NIOFFD
ENDIF
ENDIF
IF(INDNSD /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNSD,NSD)
IF(NSD /= 999999999)THEN
PRINT *,' NSD FOURNI ',NSD
ENDIF
ENDIF
!*JD* Mars 2009
IF(INDNSTYLINZEROPV /=0)THEN
if(nverbia >0)then
print *,' **caresolv INDNSTYLINZEROPV,YCARIN ',INDNSTYLINZEROPV,YCARIN(1:LEN_TRIM(YCARIN))
endif
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNSTYLINZEROPV,NSTYLINZEROPV)
print *,' VALEUR NSTYLINZEROPV FOURNIE : ',NSTYLINZEROPV
ENDIF
!*JD* Mars 2009
IF(INDNULBLL /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNULBLL,NULBLL)
IF(NULBLL /= 999999999)THEN
PRINT *,' NULBLL FOURNI ',NULBLL
ENDIF
ENDIF
IF(INDNDOT /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNDOT,NDOT)
IF(NDOT /= 999999999)THEN
PRINT *,' NDOT FOURNI ',NDOT
ENDIF
ENDIF
IF(INDNISKIP /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNISKIP,NISKIP)
IF(NISKIP /= 999999999)THEN
PRINT *,' NISKIP FOURNI ',NISKIP
ENDIF
ENDIF
IF(INDNCOLSEGM /= 0)THEN
CALL RESOLVIARRAY(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLSEGM,NCOLSEGMS,NCOLSEGM)
PRINT *,' NCOLSEGMS FOURNI ',NCOLSEGMS(1:NCOLSEGM)
DO J=NCOLSEGM+1,SIZE(NCOLSEGMS)
NCOLSEGMS(J)=1
ENDDO
if(nverbia > 0)THEN
print *,' ** NCOLSEGMS ',NCOLSEGMS
endif
ENDIF
!IF(INDNCOLSEGM /= 0)THEN
! CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLSEGM,NCOLSEGM)
! PRINT *,' NCOLSEGM FOURNI ',NCOLSEGM
!ENDIF
IF(INDNISKIPVY /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNISKIPVY,NISKIPVY)
IF(NISKIPVY /= 999999999)THEN
PRINT *,' NISKIPVY FOURNI ',NISKIPVY
ENDIF
ENDIF
IF(INDNISKIPVX /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNISKIPVX,NISKIPVX)
IF(NISKIPVX /= 999999999)THEN
PRINT *,' NISKIPVX FOURNI ',NISKIPVX
ENDIF
ENDIF
IF(INDNHI /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNHI,NHI)
IF(NHI /= 999999999)THEN
PRINT *,' NHI FOURNI ',NHI
ENDIF
ENDIF
IF(INDNIMNMX /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIMNMX,NIMNMX)
IF(NIMNMX /= 999999999)THEN
PRINT *,' NIMNMX FOURNI ',NIMNMX
ENDIF
ENDIF
IF(INDNFT1ITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1ITVXMJ,NFT1ITVXMJ)
IF(NFT1ITVXMJ /= 999999999)THEN
PRINT *,' NFT1ITVXMJ FOURNI ',NFT1ITVXMJ
ENDIF
ENDIF
IF(INDNFT1ITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1ITVXMN,NFT1ITVXMN)
IF(NFT1ITVXMN /= 999999999)THEN
PRINT *,' NFT1ITVXMN FOURNI ',NFT1ITVXMN
ENDIF
ENDIF
IF(INDNFT1ITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1ITVYMJ,NFT1ITVYMJ)
IF(NFT1ITVYMJ /= 999999999)THEN
PRINT *,' NFT1ITVYMJ FOURNI ',NFT1ITVYMJ
ENDIF
ENDIF
IF(INDNFT1ITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1ITVYMN,NFT1ITVYMN)
IF(NFT1ITVYMN /= 999999999)THEN
PRINT *,' NFT1ITVYMN FOURNI ',NFT1ITVYMN
ENDIF
ENDIF
IF(INDNFTITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFTITVXMJ,NFTITVXMJ)
IF(NFTITVXMJ /= 999999999)THEN
PRINT *,' NFTITVXMJ FOURNI ',NFTITVXMJ
ENDIF
ENDIF
IF(INDNFTITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFTITVXMN,NFTITVXMN)
IF(NFTITVXMN /= 999999999)THEN
PRINT *,' NFTITVXMN FOURNI ',NFTITVXMN
ENDIF
ENDIF
IF(INDNFTITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFTITVYMJ,NFTITVYMJ)
IF(NFTITVYMJ /= 999999999)THEN
PRINT *,' NFTITVYMJ FOURNI ',NFTITVYMJ
ENDIF
ENDIF
IF(INDNFTITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFTITVYMN,NFTITVYMN)
IF(NFTITVYMN /= 999999999)THEN
PRINT *,' NFTITVYMN FOURNI ',NFTITVYMN
ENDIF
ENDIF
IF(INDNCHITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHITVXMJ,NCHITVXMJ)
IF(NCHITVXMJ /= 999999999)THEN
PRINT *,' NCHITVXMJ FOURNI ',NCHITVXMJ
ENDIF
ENDIF
IF(INDNCHITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHITVXMN,NCHITVXMN)
IF(NCHITVXMN /= 999999999)THEN
PRINT *,' NCHITVXMN FOURNI ',NCHITVXMN
ENDIF
ENDIF
IF(INDNCHITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHITVYMJ,NCHITVYMJ)
IF(NCHITVYMJ /= 999999999)THEN
PRINT *,' NCHITVYMJ FOURNI ',NCHITVYMJ
ENDIF
ENDIF
IF(INDNCHITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHITVYMN,NCHITVYMN)
IF(NCHITVYMN /= 999999999)THEN
PRINT *,' NCHITVYMN FOURNI ',NCHITVYMN
ENDIF
ENDIF
IF(INDNCHPCITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHPCITVXMJ,NCHPCITVXMJ)
IF(NCHPCITVXMJ /= 999999999)THEN
PRINT *,' NCHPCITVXMJ FOURNI ',NCHPCITVXMJ
ENDIF
ENDIF
IF(INDNCHPCITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHPCITVXMN,NCHPCITVXMN)
IF(NCHPCITVXMN /= 999999999)THEN
PRINT *,' NCHPCITVXMN FOURNI ',NCHPCITVXMN
ENDIF
ENDIF
IF(INDNCHPCITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHPCITVYMJ,NCHPCITVYMJ)
IF(NCHPCITVYMJ /= 999999999)THEN
PRINT *,' NCHPCITVYMJ FOURNI ',NCHPCITVYMJ
ENDIF
ENDIF
IF(INDNCHPCITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCHPCITVYMN,NCHPCITVYMN)
IF(NCHPCITVYMN /= 999999999)THEN
PRINT *,' NCHPCITVYMN FOURNI ',NCHPCITVYMN
ENDIF
ENDIF
IF(INDNCVITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCVITVXMJ,NCVITVXMJ)
IF(NCVITVXMJ /= 999999999)THEN
PRINT *,' NCVITVXMJ FOURNI ',NCVITVXMJ
ENDIF
ENDIF
IF(INDNCVITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCVITVXMN,NCVITVXMN)
IF(NCVITVXMN /= 999999999)THEN
PRINT *,' NCVITVXMN FOURNI ',NCVITVXMN
ENDIF
ENDIF
IF(INDNCVITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCVITVYMJ,NCVITVYMJ)
IF(NCVITVYMJ /= 999999999)THEN
PRINT *,' NCVITVYMJ FOURNI ',NCVITVYMJ
ENDIF
ENDIF
IF(INDNCVITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCVITVYMN,NCVITVYMN)
IF(NCVITVYMN /= 999999999)THEN
PRINT *,' NCVITVYMN FOURNI ',NCVITVYMN
ENDIF
ENDIF
IF(INDNPVITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPVITVXMJ,NPVITVXMJ)
IF(NPVITVXMJ /= 999999999)THEN
PRINT *,' NPVITVXMJ FOURNI ',NPVITVXMJ
ENDIF
ENDIF
IF(INDNPVITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPVITVXMN,NPVITVXMN)
IF(NPVITVXMN /= 999999999)THEN
PRINT *,' NPVITVXMN FOURNI ',NPVITVXMN
ENDIF
ENDIF
IF(INDNPVITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPVITVYMJ,NPVITVYMJ)
IF(NPVITVYMJ /= 999999999)THEN
PRINT *,' NPVITVYMJ FOURNI ',NPVITVYMJ
ENDIF
ENDIF
IF(INDNPVITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPVITVYMN,NPVITVYMN)
IF(NPVITVYMN /= 999999999)THEN
PRINT *,' NPVITVYMN FOURNI ',NPVITVYMN
ENDIF
ENDIF
IF(INDNXYITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNXYITVXMJ,NXYITVXMJ)
IF(NXYITVXMJ /= 999999999)THEN
PRINT *,' NXYITVXMJ FOURNI ',NXYITVXMJ
ENDIF
ENDIF
IF(INDNXYITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNXYITVXMN,NXYITVXMN)
IF(NXYITVXMN /= 999999999)THEN
PRINT *,' NXYITVXMN FOURNI ',NXYITVXMN
ENDIF
ENDIF
IF(INDNXYITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNXYITVYMJ,NXYITVYMJ)
IF(NXYITVYMJ /= 999999999)THEN
PRINT *,' NXYITVYMJ FOURNI ',NXYITVYMJ
ENDIF
ENDIF
IF(INDNXYITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNXYITVYMN,NXYITVYMN)
IF(NXYITVYMN /= 999999999)THEN
PRINT *,' NXYITVYMN FOURNI ',NXYITVYMN
ENDIF
ENDIF
IF(INDNMASKITVXMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNMASKITVXMJ,NMASKITVXMJ)
IF(NMASKITVXMJ /= 999999999)THEN
PRINT *,' NMASKITVXMJ FOURNI ',NMASKITVXMJ
ENDIF
ENDIF
IF(INDNMASKITVXMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNMASKITVXMN,NMASKITVXMN)
IF(NMASKITVXMN /= 999999999)THEN
PRINT *,' NMASKITVXMN FOURNI ',NMASKITVXMN
ENDIF
ENDIF
IF(INDNMASKITVYMJ /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNMASKITVYMJ,NMASKITVYMJ)
IF(NMASKITVYMJ /= 999999999)THEN
PRINT *,' NMASKITVYMJ FOURNI ',NMASKITVYMJ
ENDIF
ENDIF
IF(INDNMASKITVYMN /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNMASKITVYMN,NMASKITVYMN)
IF(NMASKITVYMN /= 999999999)THEN
PRINT *,' NMASKITVYMN FOURNI ',NMASKITVYMN
ENDIF
ENDIF
!!!!!!!!!!!
IF(INDLINZEROPV /= 0)THEN
if(nverbia >0)then
print *,' ++caresolv AV RESOLVL(INDLINZEROPV ',INDLINZEROPV
endif
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINZEROPV,LINZEROPV)
ENDIF
IF(INDLVARNPVUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVARNPVUSER,LVARNPVUSER)
ENDIF
IF(INDLVARNPHUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVARNPHUSER,LVARNPHUSER)
ENDIF
IF(INDLVPTFT1USER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVPTFT1USER,LVPTFT1USER)
ENDIF
!!!!!!!!!!!
IF(INDLM5S3 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLM5S3,LM5S3)
ENDIF
IF(INDLCVZOOM /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCVZOOM,LCVZOOM)
ENDIF
IF(INDLVST /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVST,LVST)
ENDIF
IF(INDLDILW /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLDILW,LDILW)
ENDIF
IF(INDLXYNVARTOP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXYNVARTOP,LXYNVARTOP)
ENDIF
IF(INDLXYSTYLTOP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXYSTYLTOP,LXYSTYLTOP)
ENDIF
IF(INDLXYWINCUR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXYWINCUR,LXYWINCUR)
ENDIF
IF(INDLVSUPSCA /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVSUPSCA,LVSUPSCA)
ENDIF
IF(INDLSYMB /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSYMB,LSYMB)
ENDIF
IF(INDLSYMBTEXTG /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSYMBTEXTG,LSYMBTEXTG)
ENDIF
IF(INDLTEXTG /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTEXTG,LTEXTG)
ENDIF
IF(INDLSTI /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSTI,LSTI)
ENDIF
IF(INDLTEXTIT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTEXTIT,LTEXTIT)
ENDIF
IF(INDLTRACECV /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTRACECV,LTRACECV)
ENDIF
IF(INDLSEGM /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSEGM,LSEGM)
ENDIF
IF(INDLXY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXY,LXY)
ENDIF
IF(INDLXZ /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXZ,LXZ)
ENDIF
IF(INDLISO /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLISO,LISO)
ENDIF
IF(INDLANIMK /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLANIMK,LANIMK)
ENDIF
IF(INDLANIMT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLANIMT,LANIMT)
ENDIF
IF(INDLMINMAX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMINMAX,LMINMAX)
ENDIF
IF(INDATFILE /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDATFILE,LDATFILE)
ENDIF
IF(INDLINTERPTOP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINTERPTOP,LINTERPTOP)
ENDIF
IF(INDLRADAR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLRADAR,LRADAR)
ENDIF
IF(INDLRADRAY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLRADRAY,LRADRAY)
ENDIF
IF(INDLRADIST /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLRADIST,LRADIST)
ENDIF
IF(INDLFTBAUTO /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFTBAUTO,LFTBAUTO)
ENDIF
IF(INDLFT1BAUTO /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFT1BAUTO,LFT1BAUTO)
ENDIF
IF(INDLCOLAREA /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLAREA,LCOLAREA)
! IF(.NOT.LCOLAREA)CALL TABCOL_FORDIACHRO
ENDIF
IF(INDLEGVECT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLEGVECT,LEGVECT)
ENDIF
IF(INDLSTREAM /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSTREAM,LSTREAM)
ENDIF
IF(INDLINTERPOLSTR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINTERPOLSTR,LINTERPOLSTR)
ENDIF
IF(INDLNOLBLBAR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLNOLBLBAR,LNOLBLBAR)
ENDIF
IF(INDLNOLABELX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLNOLABELX,LNOLABELX)
ENDIF
IF(INDLNOLABELY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLNOLABELY,LNOLABELY)
ENDIF
IF(INDLPRESY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPRESY,LPRESY)
ENDIF
IF(INDLSPSECT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSPSECT,LSPSECT)
ENDIF
IF(INDLSPVALT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSPVALT,LSPVALT)
ENDIF
IF(INDLXABSC /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXABSC,LXABSC)
ENDIF
IF(INDLTITFTUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTITFTUSER,LTITFTUSER)
ENDIF
IF(INDLPHCOLUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPHCOLUSER,LPHCOLUSER)
ENDIF
IF(INDLPHSTYUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPHSTYUSER,LPHSTYUSER)
ENDIF
IF(INDLXMINTOP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXMINTOP,LXMINTOP)
ENDIF
IF(INDLABEL1 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLABEL1,LABEL1)
ENDIF
IF(INDLDEFCV2 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLDEFCV2,LDEFCV2)
IF(LDEFCV2)THEN
LDEFCV2LL=.FALSE.
LDEFCV2IND=.FALSE.
ENDIF
ENDIF
IF(INDLDEFCV2LL /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLDEFCV2LL,LDEFCV2LL)
IF(LDEFCV2LL)THEN
LDEFCV2=.FALSE.
LDEFCV2IND=.FALSE.
ENDIF
ENDIF
IF(INDLDEFCV2IND /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLDEFCV2IND,LDEFCV2IND)
IF(LDEFCV2IND)THEN
LDEFCV2=.FALSE.
LDEFCV2LL=.FALSE.
ENDIF
ENDIF
! NOV 2009 G. TANGUY
IF(INDL90TITYT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL90TITYT,L90TITYT)
ENDIF
IF(INDL90TITYM /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL90TITYM,L90TITYM)
ENDIF
IF(INDL90TITYB /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL90TITYB,L90TITYB)
ENDIF
IF(INDLPATCH /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPATCH,LPATCH)
ENDIF
!!! NOV 2009
IF(NVERBIA > 0)THEN
print *,' CARESOLV LDEFCV2,LDEFCV2LL,LDEFCV2IND,LDEFCV2CC ',LDEFCV2,LDEFCV2LL,LDEFCV2IND,LDEFCV2CC
ENDIF
IF(LDEFCV2 .OR. LDEFCV2LL .OR. LDEFCV2IND)THEN
LDEFCV2CC=.TRUE.
ELSE
LDEFCV2CC=.FALSE.
ENDIF
IF(INDLBLUSER1 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLBLUSER1,LBLUSER1)
IF(LBLUSER1)THEN
IF(ALLOCATED(XLBLUSER1))THEN
DEALLOCATE(XLBLUSER1)
ENDIF
PRINT *,'Indiquez le nombre de isolignes labeller'
READ(5,*)NLBL1
YCAR80(1:80)=' '
! WRITE(YCAR80,*)NLBL1
! YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,NLBL1)
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
YCAR80(1:80)=' '
ALLOCATE(XLBLUSER1(NLBL1))
PRINT *,'Indiquez les ',NLBL1,' valeurs'
READ(5,*)XLBLUSER1
!WRITE(YCAR80,*)XLBLUSER1(1:NLBL1)
!YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,XLBLUSER1(1:NLBL1))
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
ENDIF
ENDIF
IF(INDLBLUSER2 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLBLUSER2,LBLUSER2)
IF(LBLUSER2)THEN
IF(ALLOCATED(XLBLUSER2))THEN
DEALLOCATE(XLBLUSER2)
ENDIF
PRINT *,'Indiquez le nombre de isolignes labeller'
READ(5,*)NLBL2
!YCAR80(1:80)=' '
! WRITE(YCAR80,*)NLBL2
! YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,NLBL2)
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
YCAR80(1:80)=' '
ALLOCATE(XLBLUSER2(NLBL2))
PRINT *,'Indiquez les ',NLBL2,' valeurs'
READ(5,*)XLBLUSER2
! WRITE(YCAR80,*)XLBLUSER2(1:NLBL2)
! YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,XLBLUSER2(1:NLBL2))
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
ENDIF
ENDIF
IF(INDLBLUSER3 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLBLUSER3,LBLUSER3)
IF(LBLUSER3)THEN
IF(ALLOCATED(XLBLUSER3))THEN
DEALLOCATE(XLBLUSER3)
ENDIF
PRINT *,'Indiquez le nombre de isolignes labeller'
READ(5,*)NLBL3
! YCAR80(1:80)=' '
! WRITE(YCAR80,*)NLBL3
! YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,NLBL3)
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
YCAR80(1:80)=' '
ALLOCATE(XLBLUSER3(NLBL3))
PRINT *,'Indiquez les ',NLBL3,' valeurs'
READ(5,*)XLBLUSER3
!WRITE(YCAR80,*)XLBLUSER3(1:NLBL3)
!YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,XLBLUSER3(1:NLBL3))
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
ENDIF
ENDIF
IF(INDLBLUSER4 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLBLUSER4,LBLUSER4)
IF(LBLUSER4)THEN
IF(ALLOCATED(XLBLUSER4))THEN
DEALLOCATE(XLBLUSER4)
ENDIF
PRINT *,'Indiquez le nombre de isolignes labeller'
READ(5,*)NLBL4
YCAR80(1:80)=' '
!WRITE(YCAR80,*)NLBL4
!YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,NLBL4)
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
YCAR80(1:80)=' '
ALLOCATE(XLBLUSER4(NLBL4))
PRINT *,'Indiquez les ',NLBL4,' valeurs'
READ(5,*)XLBLUSER4
!WRITE(YCAR80,*)XLBLUSER4(1:NLBL4)
!YCAR80=ADJUSTL(ADJUSTR(YCAR80))
!WRITE(NDIR,*)YCAR80
CALL WRITEDIR(NDIR,XLBLUSER4(1:NLBL4))
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
ENDIF
ENDIF
IF(INDLINDSP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINDSP,LINDSP)
ENDIF
IF(INDLINDAX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINDAX,LINDAX)
ENDIF
IF(INDLCHREEL /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCHREEL,LCHREEL)
ENDIF
IF(INDLOGNEP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLOGNEP,LOGNEP)
ENDIF
IF(INDLCOLISONE /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLISONE,LCOLISONE)
ENDIF
IF(INDLCOLRSONE /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLRSONE,LCOLRSONE)
ENDIF
IF(INDLCOLRS1ONE /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLRS1ONE,LCOLRS1ONE)
ENDIF
IF(INDLCOLINE /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLINE,LCOLINE)
ENDIF
IF(INDL24H /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL24H,L24H)
ENDIF
IF(INDLCONT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCONT,LCONT)
ENDIF
IF(INDL2CONT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL2CONT,L2CONT)
ENDIF
IF(INDLRELIEF /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLRELIEF,LRELIEF)
ENDIF
IF(INDLCONV2XY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCONV2XY,LCONV2XY)
ENDIF
IF(INDLCONVG2MASS /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCONVG2MASS,LCONVG2MASS)
ENDIF
IF(INDLCOLZERO /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLZERO,LCOLZERO)
ENDIF
IF(INDL3D /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL3D,L3D)
ENDIF
IF(INDLMARKER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMARKER,LMARKER)
ENDIF
IF(INDLSPOT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLSPOT,LSPOT)
ENDIF
IF(INDLHEURX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHEURX,LHEURX)
ENDIF
IF(INDLMYHEURX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMYHEURX,LMYHEURX)
ENDIF
IF(INDLNOUVRS /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLNOUVRS,LNOUVRS)
ENDIF
IF(INDLHACH1 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHACH1,LHACH1)
ENDIF
IF(INDLHACH2 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHACH2,LHACH2)
ENDIF
IF(INDLHACH3 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHACH3,LHACH3)
ENDIF
IF(INDLHACH4 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHACH4,LHACH4)
ENDIF
IF(INDLHACHSEL /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLHACHSEL,LHACHSEL)
ENDIF
IF(INDLGREY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLGREY,LGREY)
ENDIF
IF(INDLPRDAT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPRDAT,LPRDAT)
ENDIF
IF(INDLPRINT /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPRINT,LPRINT)
ENDIF
IF(INDLPRINTXY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPRINTXY,LPRINTXY)
ENDIF
IF(INDLPOINTG /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLPOINTG,LPOINTG)
ENDIF
IF(INDLXYO /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXYO,LXYO)
ENDIF
IF(INDL2DBX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL2DBX,L2DBX)
ENDIF
IF(INDL2DBY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDL2DBY,L2DBY)
ENDIF
IF(INDLCOLUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLUSER,LCOLUSER)
ENDIF
IF(INDLTIMEUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTIMEUSER,LTIMEUSER)
ENDIF
IF(INDLCOLUSERUV /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLUSERUV,LCOLUSERUV)
ENDIF
IF(INDLVECTMNMX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVECTMNMX,LVECTMNMX)
ENDIF
IF(INDLISOWHI /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLISOWHI,LISOWHI)
ENDIF
IF(INDLISOWHI2 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLISOWHI2,LISOWHI2)
ENDIF
IF(INDLISOWHI3 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLISOWHI3,LISOWHI3)
ENDIF
IF(INDLCOLBR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLBR,LCOLBR)
ENDIF
IF(INDLINVWB /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINVWB,LINVWB)
ENDIF
IF(INDLINVPTIR /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLINVPTIR,LINVPTIR)
ENDIF
IF(INDLDOMAIN /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLDOMAIN,LDOMAIN)
ENDIF
IF(INDLGEOG /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLGEOG,LGEOG)
ENDIF
IF(INDLBLFT1SUP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLBLFT1SUP,LBLFT1SUP)
ENDIF
IF(INDLXYZ00 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLXYZ00,LXYZ00)
ENDIF
IF(INDLFT1LUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFT1LUSER,LFT1LUSER)
ENDIF
! Si LMASK3D_XY=T ou LMASK3D_XZ=T ou LMASK3D_YZ=T -> LMASK3D=T
IF(INDLMASK3D_XY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMASK3D_XY,LMASK3D_XY)
! IF(LMASK3D_XY)THEN
! LMASK3D=.TRUE.
! ENDIF
ENDIF
IF(INDLMASK3D_XZ /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMASK3D_XZ,LMASK3D_XZ)
! IF(LMASK3D_XZ)THEN
! LMASK3D=.TRUE.
! ENDIF
ENDIF
IF(INDLMASK3D_YZ /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMASK3D_YZ,LMASK3D_YZ)
! IF(LMASK3D_YZ)THEN
! LMASK3D=.TRUE.
! ENDIF
ENDIF
!IF(INDLMASK3D /= 0 .OR. LMASK3D)THEN
IF(INDLMASK3D /= 0 )THEN
! IF(.NOT.LMASK3D)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMASK3D,LMASK3D)
IF(LMASK3D)THEN
LMASK3D_XY=.TRUE.
LMASK3D_XZ=.TRUE.
LMASK3D_YZ=.TRUE.
ENDIF
ENDIF
IF(LMASK3D .OR. LMASK3D_XY .OR. LMASK3D_XZ .OR. LMASK3D_YZ)THEN
IF(XXL == 0. .AND. XXH == 0. .AND. XYL == 0. .AND. XYH == 0. &
.AND. XZL == 0. .AND. XZH == 0.)THEN
print *,' Definissez une fenetre (en metres) dans XXL= XXH= XYL= XYH= XZL= XZH='
print *,' Et rentrez a nouveau votre directive '
IF(LMASK3D)THEN
LMASK3D=.FALSE.
LMASK3D_XY=.FALSE.
LMASK3D_XZ=.FALSE.
LMASK3D_YZ=.FALSE.
ENDIF
! Septembre 2000
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
RETURN
ELSE
CALL TRAMASK3D
IF(LPBREAD)THEN
LPBREAD=.FALSE.
ENDIF
! IF(.NOT.LMASK3D_XY .AND. .NOT.LMASK3D_XZ .AND. .NOT.LMASK3D_YZ)THEN
IF(LMASK3D)THEN
LMASK3D=.FALSE.
print *,' LMASK3D remis a .FALSE. Pour une nouvelle visualisation du masque'
print *,' Rentrez a nouveau la directive LMASK3D=T . '
LMASK3D_XY=.FALSE.
LMASK3D_XZ=.FALSE.
LMASK3D_YZ=.FALSE.
ELSE IF(LMASK3D_XY)THEN
LMASK3D_XY=.FALSE.
print *,' LMASK3D_XY remis a .FALSE. '
! LMASK3D=.FALSE.
ELSE IF(LMASK3D_XZ)THEN
LMASK3D_XZ=.FALSE.
print *,' LMASK3D_XZ remis a .FALSE. '
! LMASK3D=.FALSE.
ELSE IF(LMASK3D_YZ)THEN
LMASK3D_YZ=.FALSE.
! LMASK3D=.FALSE.
print *,' LMASK3D_YZ remis a .FALSE. '
ENDIF
! ENDIF
ENDIF
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
!
IF(INDLTRAJ_GROUP /= 0 )THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTRAJ_GROUP,LTRAJ_GROUP)
ENDIF
!
IF(INDLFLUX3D /= 0 )THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFLUX3D,LFLUX3D)
ENDIF
IF (LFLUX3D) THEN
IF(XXPART(1) == -999.)THEN
print *,' Definissez d abord les positions initiales de vos particules'
print *,' par des tableaux XXPART= ....,9999. '
print *,' XYPART= ....,9999. '
print *,' et XZPART= ....,9999. '
print *,' Et rentrez a nouveau votre directive '
! Septembre 2000
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
RETURN
ELSE
CALL TRAFLUX3D
IF(LPBREAD)THEN
LPBREAD=.FALSE.
ENDIF
IF(LFLUX3D)THEN
LFLUX3D=.FALSE.
print *,' LFLUX3D remis a .FALSE. Pour une nouvelle visualisation '
print *,' de lignes de flux'
print *,' Rentrez a nouveau la directive LFLUX3D=T . '
ENDIF
ENDIF
ENDIF
!
IF(INDLTRAJ3D /= 0 )THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTRAJ3D,LTRAJ3D)
ENDIF
IF(LTRAJ3D) THEN
IF(XXPART(1) == -999.)THEN
print *,' Definissez d abord les positions initiales de vos particules'
print *,' par des tableaux XXPART= ....,9999. '
print *,' XYPART= ....,9999. '
print *,' et XZPART= ....,9999. '
print *,' Et rentrez a nouveau votre directive '
! Septembre 2000
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
RETURN
ELSE
CALL TRATRAJ3D
IF(LPBREAD)THEN
LPBREAD=.FALSE.
ENDIF
IF(LTRAJ3D)THEN
LTRAJ3D=.FALSE.
print *,' LTRAJ3D remis a .FALSE. Pour une nouvelle visualisation '
print *,' de particules'
print *,' Rentrez a nouveau la directive LTRAJ3D=T . '
ENDIF
ENDIF
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
IF(INDLFT3C /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFT3C,LFT3C)
ENDIF
IF(INDLFT4C /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFT4C,LFT4C)
ENDIF
IF(INDLFTCLIP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFTCLIP,LFTCLIP)
ENDIF
IF(INDLFT1STYLUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFT1STYLUSER,LFT1STYLUSER)
ENDIF
IF(INDLFTSTYLUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFTSTYLUSER,LFTSTYLUSER)
ENDIF
IF(INDLCOLAREASEL /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLAREASEL,LCOLAREASEL)
ENDIF
IF(INDLCOLINESEL /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLCOLINESEL,LCOLINESEL)
ENDIF
IF(INDLTABCOLDEF /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTABCOLDEF,LTABCOLDEF)
ENDIF
IF(INDLTABCOLDEF2 /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLTABCOLDEF2,LTABCOLDEF2)
ENDIF
IF(INDLMNMXUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMNMXUSER,LMNMXUSER)
ENDIF
IF(INDLMNMXLOC /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLMNMXLOC,LMNMXLOC)
ENDIF
IF(INDLULMVTMOLD /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLULMVTMOLD,LULMVTMOLD)
ENDIF
IF(INDLVPTUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVPTUSER,LVPTUSER)
ENDIF
IF(INDLVPTVUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVPTVUSER,LVPTVUSER)
ENDIF
IF(INDLVPTPVUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVPTPVUSER,LVPTPVUSER)
ENDIF
IF(INDLVPTXYUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLVPTXYUSER,LVPTXYUSER)
ENDIF
IF(INDLFACTIMP /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFACTIMP,LFACTIMP)
ENDIF
IF(INDLFACTAXEX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFACTAXEX,LFACTAXEX)
ENDIF
IF(INDLFACTAXEY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFACTAXEY,LFACTAXEY)
ENDIF
IF(INDLAXEXUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLAXEXUSER,LAXEXUSER)
ENDIF
IF(INDLAXEYUSER /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLAXEYUSER,LAXEYUSER)
ENDIF
IF(INDLFMTAXEX /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFMTAXEX,LFMTAXEX)
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDLFMTRTRAJ /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFMTRTRAJ,LFMTRTRAJ)
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDLFMTAXEY /= 0)THEN
CALL RESOLVL(YCARIN(1:LEN_TRIM(YCARIN)),INDLFMTAXEY,LFMTAXEY)
ENDIF
IF(INDNIFDC /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIFDC,NIFDC)
IF(NIFDC /= 999999999)THEN
PRINT *,' NIFDC FOURNI ',NIFDC
ENDIF
ENDIF
IF(INDNDOMAINL /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNDOMAINL,NDOMAINL)
IF(NDOMAINL /= 999999999)THEN
PRINT *,' NDOMAINL FOURNI ',NDOMAINL
ENDIF
ENDIF
IF(INDNDOMAINR /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNDOMAINR,NDOMAINR)
IF(NDOMAINR /= 999999999)THEN
PRINT *,' NDOMAINR FOURNI ',NDOMAINR
ENDIF
ENDIF
IF(INDNDOMAINB /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNDOMAINB,NDOMAINB)
IF(NDOMAINB /= 999999999)THEN
PRINT *,' NDOMAINB FOURNI ',NDOMAINB
ENDIF
ENDIF
IF(INDNDOMAINT /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNDOMAINT,NDOMAINT)
IF(NDOMAINT /= 999999999)THEN
PRINT *,' NDOMAINT FOURNI ',NDOMAINT
ENDIF
ENDIF
IF(INDNIGRNC /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIGRNC,NIGRNC)
IF(NIGRNC /= 999999999)THEN
PRINT *,' NIGRNC FOURNI ',NIGRNC
ENDIF
ENDIF
IF(INDNPROFILE /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPROFILE,NPROFILE)
IF(NPROFILE /= 999999999)THEN
PRINT *,' PROFILE FOURNI ',NPROFILE
ENDIF
ENDIF
IF(INDNIRS /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNIRS,NIRS)
IF(NIRS /= 999999999)THEN
PRINT *,' NIRS FOURNI ',NIRS
XIRS=-999.
ENDIF
ENDIF
IF(INDNJRS /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNJRS,NJRS)
IF(NJRS /= 999999999)THEN
PRINT *,' NJRS FOURNI ',NJRS
XJRS=-999.
ENDIF
ENDIF
IF(INDNCOLUV1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLUV1,NCOLUV1)
PRINT *,' NCOLUV1 FOURNI ',NCOLUV1
ENDIF
IF(INDNCOLUV2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLUV2,NCOLUV2)
PRINT *,' NCOLUV2 FOURNI ',NCOLUV2
ENDIF
IF(INDNCOLUV3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLUV3,NCOLUV3)
PRINT *,' NCOLUV3 FOURNI ',NCOLUV3
ENDIF
IF(INDNCOLUV4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLUV4,NCOLUV4)
PRINT *,' NCOLUV4 FOURNI ',NCOLUV4
ENDIF
IF(INDNCOLUV5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLUV5,NCOLUV5)
PRINT *,' NCOLUV5 FOURNI ',NCOLUV5
ENDIF
IF(INDNCOLISONE1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLISONE1,NCOLISONE1)
PRINT *,' NCOLISONE1 FOURNI ',NCOLISONE1
ENDIF
IF(INDNCOLISONE2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLISONE2,NCOLISONE2)
PRINT *,' NCOLISONE2 FOURNI ',NCOLISONE2
ENDIF
IF(INDNCOLISONE3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLISONE3,NCOLISONE3)
PRINT *,' NCOLISONE3 FOURNI ',NCOLISONE3
ENDIF
IF(INDNCOLISONE4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLISONE4,NCOLISONE4)
PRINT *,' NCOLISONE4 FOURNI ',NCOLISONE4
ENDIF
IF(INDNCOLISONE5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLISONE5,NCOLISONE5)
PRINT *,' NCOLISONE5 FOURNI ',NCOLISONE5
ENDIF
IF(INDNCOLRS1ONE1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRS1ONE1,NCOLRS1ONE1)
PRINT *,' NCOLRS1ONE1 FOURNI ',NCOLRS1ONE1
ENDIF
IF(INDNCOLRS1ONE2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRS1ONE2,NCOLRS1ONE2)
PRINT *,' NCOLRS1ONE2 FOURNI ',NCOLRS1ONE2
ENDIF
IF(INDNCOLRS1ONE3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRS1ONE3,NCOLRS1ONE3)
PRINT *,' NCOLRS1ONE3 FOURNI ',NCOLRS1ONE3
ENDIF
IF(INDNCOLRS1ONE4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRS1ONE4,NCOLRS1ONE4)
PRINT *,' NCOLRS1ONE4 FOURNI ',NCOLRS1ONE4
ENDIF
IF(INDNCOLRS1ONE5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRS1ONE5,NCOLRS1ONE5)
PRINT *,' NCOLRS1ONE5 FOURNI ',NCOLRS1ONE5
ENDIF
IF(INDNCOLRSONE /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLRSONE,NCOLRSONE)
PRINT *,' NCOLRSONE FOURNI ',NCOLRSONE
ENDIF
IF(INDNCOLZERO /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNCOLZERO,NCOLZERO)
PRINT *,' NCOLZERO FOURNI ',NCOLZERO
ENDIF
IF(INDNVERBIA /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNVERBIA,NVERBIA)
PRINT *,' NVERBIA FOURNI ',NVERBIA
ENDIF
!
IF(INDNFT1STY1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY1,NFT1STY1)
PRINT *,' NFT1STY1 FOURNI ',NFT1STY1
ENDIF
IF(INDNFT1STY2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY2,NFT1STY2)
PRINT *,' NFT1STY2 FOURNI ',NFT1STY2
ENDIF
IF(INDNFT1STY3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY3,NFT1STY3)
PRINT *,' NFT1STY3 FOURNI ',NFT1STY3
ENDIF
IF(INDNFT1STY4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY4,NFT1STY4)
PRINT *,' NFT1STY4 FOURNI ',NFT1STY4
ENDIF
IF(INDNFT1STY5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY5,NFT1STY5)
PRINT *,' NFT1STY5 FOURNI ',NFT1STY5
ENDIF
IF(INDNFT1STY6 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY6,NFT1STY6)
PRINT *,' NFT1STY6 FOURNI ',NFT1STY6
ENDIF
IF(INDNFT1STY7 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY7,NFT1STY7)
PRINT *,' NFT1STY7 FOURNI ',NFT1STY7
ENDIF
IF(INDNFT1STY8 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY8,NFT1STY8)
PRINT *,' NFT1STY8 FOURNI ',NFT1STY8
ENDIF
IF(INDNFT1STY9 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY9,NFT1STY9)
PRINT *,' NFT1STY9 FOURNI ',NFT1STY9
ENDIF
IF(INDNFT1STY10 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY10,NFT1STY10)
PRINT *,' NFT1STY10 FOURNI ',NFT1STY10
ENDIF
IF(INDNFT1STY11 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY11,NFT1STY11)
PRINT *,' NFT1STY11 FOURNI ',NFT1STY11
ENDIF
IF(INDNFT1STY12 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY12,NFT1STY12)
PRINT *,' NFT1STY12 FOURNI ',NFT1STY12
ENDIF
IF(INDNFT1STY13 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY13,NFT1STY13)
PRINT *,' NFT1STY13 FOURNI ',NFT1STY13
ENDIF
IF(INDNFT1STY14 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY14,NFT1STY14)
PRINT *,' NFT1STY14 FOURNI ',NFT1STY14
ENDIF
IF(INDNFT1STY15 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1STY15,NFT1STY15)
PRINT *,' NFT1STY15 FOURNI ',NFT1STY15
ENDIF
!
IF(INDNFT1COL1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL1,NFT1COL1)
PRINT *,' NFT1COL1 FOURNI ',NFT1COL1
ENDIF
IF(INDNFT1COL2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL2,NFT1COL2)
PRINT *,' NFT1COL2 FOURNI ',NFT1COL2
ENDIF
IF(INDNFT1COL3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL3,NFT1COL3)
PRINT *,' NFT1COL3 FOURNI ',NFT1COL3
ENDIF
IF(INDNFT1COL4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL4,NFT1COL4)
PRINT *,' NFT1COL4 FOURNI ',NFT1COL4
ENDIF
IF(INDNFT1COL5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL5,NFT1COL5)
PRINT *,' NFT1COL5 FOURNI ',NFT1COL5
ENDIF
IF(INDNFT1COL6 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL6,NFT1COL6)
PRINT *,' NFT1COL6 FOURNI ',NFT1COL6
ENDIF
IF(INDNFT1COL7 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL7,NFT1COL7)
PRINT *,' NFT1COL7 FOURNI ',NFT1COL7
ENDIF
IF(INDNFT1COL8 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL8,NFT1COL8)
PRINT *,' NFT1COL8 FOURNI ',NFT1COL8
ENDIF
IF(INDNFT1COL9 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL9,NFT1COL9)
PRINT *,' NFT1COL9 FOURNI ',NFT1COL9
ENDIF
IF(INDNFT1COL10 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL10,NFT1COL10)
PRINT *,' NFT1COL10 FOURNI ',NFT1COL10
ENDIF
IF(INDNFT1COL11 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL11,NFT1COL11)
PRINT *,' NFT1COL11 FOURNI ',NFT1COL11
ENDIF
IF(INDNFT1COL12 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL12,NFT1COL12)
PRINT *,' NFT1COL12 FOURNI ',NFT1COL12
ENDIF
IF(INDNFT1COL13 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL13,NFT1COL13)
PRINT *,' NFT1COL13 FOURNI ',NFT1COL13
ENDIF
IF(INDNFT1COL14 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL14,NFT1COL14)
PRINT *,' NFT1COL14 FOURNI ',NFT1COL14
ENDIF
IF(INDNFT1COL15 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNFT1COL15,NFT1COL15)
PRINT *,' NFT1COL15 FOURNI ',NFT1COL15
ENDIF
!
IF(INDNPHCOL1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL1,NPHCOL1)
PRINT *,' NPHCOL1 FOURNI ',NPHCOL1
ENDIF
IF(INDNPHCOL2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL2,NPHCOL2)
PRINT *,' NPHCOL2 FOURNI ',NPHCOL2
ENDIF
IF(INDNPHCOL3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL3,NPHCOL3)
PRINT *,' NPHCOL3 FOURNI ',NPHCOL3
ENDIF
IF(INDNPHCOL4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL4,NPHCOL4)
PRINT *,' NPHCOL4 FOURNI ',NPHCOL4
ENDIF
IF(INDNPHCOL5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL5,NPHCOL5)
PRINT *,' NPHCOL5 FOURNI ',NPHCOL5
ENDIF
IF(INDNPHCOL6 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL6,NPHCOL6)
PRINT *,' NPHCOL6 FOURNI ',NPHCOL6
ENDIF
IF(INDNPHCOL7 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL7,NPHCOL7)
PRINT *,' NPHCOL7 FOURNI ',NPHCOL7
ENDIF
IF(INDNPHCOL8 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHCOL8,NPHCOL8)
PRINT *,' NPHCOL8 FOURNI ',NPHCOL8
ENDIF
!
IF(INDNPHSTY1 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY1,NPHSTY1)
PRINT *,' NPHSTY1 FOURNI ',NPHSTY1
ENDIF
IF(INDNPHSTY2 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY2,NPHSTY2)
PRINT *,' NPHSTY2 FOURNI ',NPHSTY2
ENDIF
IF(INDNPHSTY3 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY3,NPHSTY3)
PRINT *,' NPHSTY3 FOURNI ',NPHSTY3
ENDIF
IF(INDNPHSTY4 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY4,NPHSTY4)
PRINT *,' NPHSTY4 FOURNI ',NPHSTY4
ENDIF
IF(INDNPHSTY5 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY5,NPHSTY5)
PRINT *,' NPHSTY5 FOURNI ',NPHSTY5
ENDIF
IF(INDNPHSTY6 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY6,NPHSTY6)
PRINT *,' NPHSTY6 FOURNI ',NPHSTY6
ENDIF
IF(INDNPHSTY7 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY7,NPHSTY7)
PRINT *,' NPHSTY7 FOURNI ',NPHSTY7
ENDIF
IF(INDNPHSTY8 /= 0)THEN
CALL RESOLVI(YCARIN(1:LEN_TRIM(YCARIN)),INDNPHSTY8,NPHSTY8)
PRINT *,' NPHSTY8 FOURNI ',NPHSTY8
ENDIF
!
!
IF(INDVISU /=0 .AND. INDNOVISU == 0)THEN
CALL GQOPS(ISTA)
IF(ISTA == 0)THEN
CALL OPNGKS
ENDIF
CALL GOPWK(2,0,8)
CALL GACWK(2)
CALL TABCOL_FORDIACHRO
ENDIF
IF(INDNOVISU/=0)THEN
CALL GDAWK(2)
CALL GCLWK(2)
ENDIF
IF(INDXSIZEL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSIZEL,XSIZEL)
print *,' VALEUR XSIZEL FOURNIE : ',XSIZEL
ENDIF
IF(INDXSZTITXL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITXL,XSZTITXL)
print *,' VALEUR XSZTITXL FOURNIE : ',XSZTITXL
ENDIF
IF(INDXSZTITXM /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITXM,XSZTITXM)
print *,' VALEUR XSZTITXM FOURNIE : ',XSZTITXM
ENDIF
IF(INDXSZTITXR /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITXR,XSZTITXR)
print *,' VALEUR XSZTITXR FOURNIE : ',XSZTITXR
ENDIF
IF(INDXSZTITT1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITT1,XSZTITT1)
print *,' VALEUR XSZTITT1 FOURNIE : ',XSZTITT1
ENDIF
IF(INDXSZTITT2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITT2,XSZTITT2)
print *,' VALEUR XSZTITT2 FOURNIE : ',XSZTITT2
ENDIF
IF(INDXSZTITT3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITT3,XSZTITT3)
print *,' VALEUR XSZTITT3 FOURNIE : ',XSZTITT3
ENDIF
IF(INDXSZTITYT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITYT,XSZTITYT)
print *,' VALEUR XSZTITYT FOURNIE : ',XSZTITYT
ENDIF
IF(INDXSZTITYM /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITYM,XSZTITYM)
print *,' VALEUR XSZTITYM FOURNIE : ',XSZTITYM
ENDIF
IF(INDXSZTITYB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITYB,XSZTITYB)
print *,' VALEUR XSZTITYB FOURNIE : ',XSZTITYB
ENDIF
IF(INDXPOSTITYT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITYT,XPOSTITYT)
print *,' VALEUR XPOSTITYT FOURNIE : ',XPOSTITYT
ENDIF
IF(INDXPOSTITYM /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITYM,XPOSTITYM)
print *,' VALEUR XPOSTITYM FOURNIE : ',XPOSTITYM
ENDIF
IF(INDXPOSTITYB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITYB,XPOSTITYB)
print *,' VALEUR XPOSTITYB FOURNIE : ',XPOSTITYB
ENDIF
IF(INDXPOSTITT1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITT1,XPOSTITT1)
print *,' VALEUR XPOSTITT1 FOURNIE : ',XPOSTITT1
ENDIF
IF(INDXPOSTITT2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITT2,XPOSTITT2)
print *,' VALEUR XPOSTITT2 FOURNIE : ',XPOSTITT2
ENDIF
IF(INDXPOSTITT3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITT3,XPOSTITT3)
print *,' VALEUR XPOSTITT3 FOURNIE : ',XPOSTITT3
ENDIF
IF(INDXYPOSTITT1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITT1,XYPOSTITT1)
print *,' VALEUR XYPOSTITT1 FOURNIE : ',XYPOSTITT1
ENDIF
IF(INDXYPOSTITT2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITT2,XYPOSTITT2)
print *,' VALEUR XYPOSTITT2 FOURNIE : ',XYPOSTITT2
ENDIF
IF(INDXYPOSTITT3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITT3,XYPOSTITT3)
print *,' VALEUR XYPOSTITT3 FOURNIE : ',XYPOSTITT3
ENDIF
IF(INDXSZTITB1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITB1,XSZTITB1)
print *,' VALEUR XSZTITB1 FOURNIE : ',XSZTITB1
ENDIF
IF(INDXSZTITB2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITB2,XSZTITB2)
print *,' VALEUR XSZTITB2 FOURNIE : ',XSZTITB2
ENDIF
IF(INDXSZTITB3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITB3,XSZTITB3)
print *,' VALEUR XSZTITB3 FOURNIE : ',XSZTITB3
ENDIF
IF(INDXPOSTITB1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITB1,XPOSTITB1)
print *,' VALEUR XPOSTITB1 FOURNIE : ',XPOSTITB1
ENDIF
IF(INDXPOSTITB2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITB2,XPOSTITB2)
print *,' VALEUR XPOSTITB2 FOURNIE : ',XPOSTITB2
ENDIF
IF(INDXPOSTITB3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITB3,XPOSTITB3)
print *,' VALEUR XPOSTITB3 FOURNIE : ',XPOSTITB3
ENDIF
IF(INDXYPOSTITYT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITYT,XYPOSTITYT)
print *,' VALEUR XYPOSTITYT FOURNIE : ',XYPOSTITYT
ENDIF
IF(INDXYPOSTITYM /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITYM,XYPOSTITYM)
print *,' VALEUR XYPOSTITYM FOURNIE : ',XYPOSTITYM
ENDIF
IF(INDXYPOSTITYB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITYB,XYPOSTITYB)
print *,' VALEUR XYPOSTITYB FOURNIE : ',XYPOSTITYB
ENDIF
IF(INDXYPOSTITB1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITB1,XYPOSTITB1)
print *,' VALEUR XYPOSTITB1 FOURNIE : ',XYPOSTITB1
ENDIF
IF(INDXYPOSTITB2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITB2,XYPOSTITB2)
print *,' VALEUR XYPOSTITB2 FOURNIE : ',XYPOSTITB2
ENDIF
IF(INDXYPOSTITB3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITB3,XYPOSTITB3)
print *,' VALEUR XYPOSTITB3 FOURNIE : ',XYPOSTITB3
ENDIF
IF(INDXSZTITVAR1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR1,XSZTITVAR1)
print *,' VALEUR XSZTITVAR1 FOURNIE : ',XSZTITVAR1
ENDIF
IF(INDXSZTITVAR2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR2,XSZTITVAR2)
print *,' VALEUR XSZTITVAR2 FOURNIE : ',XSZTITVAR2
ENDIF
IF(INDXSZTITVAR3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR3,XSZTITVAR3)
print *,' VALEUR XSZTITVAR3 FOURNIE : ',XSZTITVAR3
ENDIF
IF(INDXSZTITVAR4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR4,XSZTITVAR4)
print *,' VALEUR XSZTITVAR4 FOURNIE : ',XSZTITVAR4
ENDIF
IF(INDXSZTITVAR5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR5,XSZTITVAR5)
print *,' VALEUR XSZTITVAR5 FOURNIE : ',XSZTITVAR5
ENDIF
IF(INDXSZTITVAR6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR6,XSZTITVAR6)
print *,' VALEUR XSZTITVAR6 FOURNIE : ',XSZTITVAR6
ENDIF
IF(INDXSZTITVAR7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR7,XSZTITVAR7)
print *,' VALEUR XSZTITVAR7 FOURNIE : ',XSZTITVAR7
ENDIF
IF(INDXSZTITVAR8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZTITVAR8,XSZTITVAR8)
print *,' VALEUR XSZTITVAR8 FOURNIE : ',XSZTITVAR8
ENDIF
IF(INDXPOSTITVAR1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR1,XPOSTITVAR1)
print *,' VALEUR XPOSTITVAR1 FOURNIE : ',XPOSTITVAR1
ENDIF
IF(INDXPOSTITVAR2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR2,XPOSTITVAR2)
print *,' VALEUR XPOSTITVAR2 FOURNIE : ',XPOSTITVAR2
ENDIF
IF(INDXPOSTITVAR3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR3,XPOSTITVAR3)
print *,' VALEUR XPOSTITVAR3 FOURNIE : ',XPOSTITVAR3
ENDIF
IF(INDXYPOSTITVAR1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR1,XYPOSTITVAR1)
print *,' VALEUR XYPOSTITVAR1 FOURNIE : ',XYPOSTITVAR1
ENDIF
IF(INDXYPOSTITVAR2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR2,XYPOSTITVAR2)
print *,' VALEUR XYPOSTITVAR2 FOURNIE : ',XYPOSTITVAR2
ENDIF
IF(INDXYPOSTITVAR3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR3,XYPOSTITVAR3)
print *,' VALEUR XYPOSTITVAR3 FOURNIE : ',XYPOSTITVAR3
ENDIF
IF(INDXPOSTITVAR4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR4,XPOSTITVAR4)
print *,' VALEUR XPOSTITVAR4 FOURNIE : ',XPOSTITVAR4
ENDIF
IF(INDXPOSTITVAR5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR5,XPOSTITVAR5)
print *,' VALEUR XPOSTITVAR5 FOURNIE : ',XPOSTITVAR5
ENDIF
IF(INDXPOSTITVAR6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR6,XPOSTITVAR6)
print *,' VALEUR XPOSTITVAR6 FOURNIE : ',XPOSTITVAR6
ENDIF
IF(INDXYPOSTITVAR4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR4,XYPOSTITVAR4)
print *,' VALEUR XYPOSTITVAR4 FOURNIE : ',XYPOSTITVAR4
ENDIF
IF(INDXYPOSTITVAR5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR5,XYPOSTITVAR5)
print *,' VALEUR XYPOSTITVAR5 FOURNIE : ',XYPOSTITVAR5
ENDIF
IF(INDXYPOSTITVAR6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR6,XYPOSTITVAR6)
print *,' VALEUR XYPOSTITVAR6 FOURNIE : ',XYPOSTITVAR6
ENDIF
IF(INDXPOSTITVAR7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR7,XPOSTITVAR7)
print *,' VALEUR XPOSTITVAR7 FOURNIE : ',XPOSTITVAR7
ENDIF
IF(INDXPOSTITVAR8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSTITVAR8,XPOSTITVAR8)
print *,' VALEUR XPOSTITVAR8 FOURNIE : ',XPOSTITVAR8
ENDIF
IF(INDXYPOSTITVAR7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR7,XYPOSTITVAR7)
print *,' VALEUR XYPOSTITVAR7 FOURNIE : ',XYPOSTITVAR7
ENDIF
IF(INDXYPOSTITVAR8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPOSTITVAR8,XYPOSTITVAR8)
print *,' VALEUR XYPOSTITVAR8 FOURNIE : ',XYPOSTITVAR8
ENDIF
!*JD* Mars 2009
IF(INDXPOSXVARNPV1TOP /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSXVARNPV1TOP,XPOSXVARNPV1TOP)
print *,' VALEUR XPOSXVARNPV1TOP FOURNIE : ',XPOSXVARNPV1TOP
ENDIF
IF(INDXPOSYVARNPV1TOP /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSYVARNPV1TOP,XPOSYVARNPV1TOP)
print *,' VALEUR XPOSYVARNPV1TOP FOURNIE : ',XPOSYVARNPV1TOP
ENDIF
IF(INDXPOSXVARNPV5BOT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSXVARNPV5BOT,XPOSXVARNPV5BOT)
print *,' VALEUR XPOSXVARNPV5BOT FOURNIE : ',XPOSXVARNPV5BOT
ENDIF
IF(INDXPOSYVARNPV5BOT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSYVARNPV5BOT,XPOSYVARNPV5BOT)
print *,' VALEUR XPOSYVARNPV5BOT FOURNIE : ',XPOSYVARNPV5BOT
ENDIF
IF(INDXSZVARNPVTOP /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZVARNPVTOP,XSZVARNPVTOP)
print *,' VALEUR XSZVARNPVTOP FOURNIE : ',XSZVARNPVTOP
ENDIF
IF(INDXSZVARNPVBOT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZVARNPVBOT,XSZVARNPVBOT)
print *,' VALEUR XSZVARNPVBOT FOURNIE : ',XSZVARNPVBOT
ENDIF
IF(INDXAMX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXAMX,XAMX)
print *,' VALEUR XAMX FOURNIE : ',XAMX
ENDIF
IF(INDXLWTRACECV /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWTRACECV,XLWTRACECV)
print *,' VALEUR XLWTRACECV FOURNIE : ',XLWTRACECV
ENDIF
IF(INDXLWDOMAIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWDOMAIN,XLWDOMAIN)
print *,' VALEUR XLWDOMAIN FOURNIE : ',XLWDOMAIN
ENDIF
IF(INDXLWSEGM /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWSEGM,XLWSEGM)
print *,' VALEUR XLWSEGM FOURNIE : ',XLWSEGM
ENDIF
IF(INDXLWFTALL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWFTALL,XLWFTALL)
print *,' VALEUR XLWFTALL FOURNIE : ',XLWFTALL
ENDIF
IF(INDXLWV /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWV,XLWV)
print *,' VALEUR XLWV FOURNIE : ',XLWV
ENDIF
IF(INDXLW /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLW,XLW)
print *,' VALEUR XLW FOURNIE : ',XLW
ENDIF
IF(INDXLW1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLW1,XLW1)
print *,' VALEUR XLW1 FOURNIE : ',XLW1
ENDIF
IF(INDXLW2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLW2,XLW2)
print *,' VALEUR XLW2 FOURNIE : ',XLW2
ENDIF
IF(INDXLW3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLW3,XLW3)
print *,' VALEUR XLW3 FOURNIE : ',XLW3
ENDIF
IF(INDXLW4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLW4,XLW4)
print *,' VALEUR XLW4 FOURNIE : ',XLW4
ENDIF
IF(INDXLWPV1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV1,XLWPV1)
print *,' VALEUR XLWPV1 FOURNIE : ',XLWPV1
ENDIF
IF(INDXLWPV2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV2,XLWPV2)
print *,' VALEUR XLWPV2 FOURNIE : ',XLWPV2
ENDIF
IF(INDXLWPV3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV3,XLWPV3)
print *,' VALEUR XLWPV3 FOURNIE : ',XLWPV3
ENDIF
IF(INDXLWPV4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV4,XLWPV4)
print *,' VALEUR XLWPV4 FOURNIE : ',XLWPV4
ENDIF
IF(INDXLWPV5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV5,XLWPV5)
print *,' VALEUR XLWPV5 FOURNIE : ',XLWPV5
ENDIF
IF(INDXLWPV6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV6,XLWPV6)
print *,' VALEUR XLWPV6 FOURNIE : ',XLWPV6
ENDIF
IF(INDXLWPV7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV7,XLWPV7)
print *,' VALEUR XLWPV7 FOURNIE : ',XLWPV7
ENDIF
IF(INDXLWPV8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV8,XLWPV8)
print *,' VALEUR XLWPV8 FOURNIE : ',XLWPV8
ENDIF
IF(INDXLWPV9 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV9,XLWPV9)
print *,' VALEUR XLWPV9 FOURNIE : ',XLWPV9
ENDIF
IF(INDXLWPV10 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV10,XLWPV10)
print *,' VALEUR XLWPV10 FOURNIE : ',XLWPV10
ENDIF
IF(INDXLWPV11 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV11,XLWPV11)
print *,' VALEUR XLWPV11 FOURNIE : ',XLWPV11
ENDIF
IF(INDXLWPV12 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV12,XLWPV12)
print *,' VALEUR XLWPV12 FOURNIE : ',XLWPV12
ENDIF
IF(INDXLWPV13 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV13,XLWPV13)
print *,' VALEUR XLWPV13 FOURNIE : ',XLWPV13
ENDIF
IF(INDXLWPV14 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV14,XLWPV14)
print *,' VALEUR XLWPV14 FOURNIE : ',XLWPV14
ENDIF
IF(INDXLWPV15 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPV15,XLWPV15)
print *,' VALEUR XLWPV15 FOURNIE : ',XLWPV15
ENDIF
IF(INDXSTYLPV1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV1,XSTYLPV1)
print *,' VALEUR XSTYLPV1 FOURNIE : ',XSTYLPV1
ENDIF
IF(INDXSTYLPV2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV2,XSTYLPV2)
print *,' VALEUR XSTYLPV2 FOURNIE : ',XSTYLPV2
ENDIF
IF(INDXSTYLPV3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV3,XSTYLPV3)
print *,' VALEUR XSTYLPV3 FOURNIE : ',XSTYLPV3
ENDIF
IF(INDXSTYLPV4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV4,XSTYLPV4)
print *,' VALEUR XSTYLPV4 FOURNIE : ',XSTYLPV4
ENDIF
IF(INDXSTYLPV5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV5,XSTYLPV5)
print *,' VALEUR XSTYLPV5 FOURNIE : ',XSTYLPV5
ENDIF
IF(INDXSTYLPV6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV6,XSTYLPV6)
print *,' VALEUR XSTYLPV6 FOURNIE : ',XSTYLPV6
ENDIF
IF(INDXSTYLPV7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV7,XSTYLPV7)
print *,' VALEUR XSTYLPV7 FOURNIE : ',XSTYLPV7
ENDIF
IF(INDXSTYLPV8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV8,XSTYLPV8)
print *,' VALEUR XSTYLPV8 FOURNIE : ',XSTYLPV8
ENDIF
IF(INDXSTYLPV9 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV9,XSTYLPV9)
print *,' VALEUR XSTYLPV9 FOURNIE : ',XSTYLPV9
ENDIF
IF(INDXSTYLPV11 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV11,XSTYLPV11)
print *,' VALEUR XSTYLPV11 FOURNIE : ',XSTYLPV11
ENDIF
IF(INDXSTYLPV12 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV12,XSTYLPV12)
print *,' VALEUR XSTYLPV12 FOURNIE : ',XSTYLPV12
ENDIF
IF(INDXSTYLPV13 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV13,XSTYLPV13)
print *,' VALEUR XSTYLPV13 FOURNIE : ',XSTYLPV13
ENDIF
IF(INDXSTYLPV14 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV14,XSTYLPV14)
print *,' VALEUR XSTYLPV14 FOURNIE : ',XSTYLPV14
ENDIF
IF(INDXSTYLPV15 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXSTYLPV15,XSTYLPV15)
print *,' VALEUR XSTYLPV15 FOURNIE : ',XSTYLPV15
ENDIF
IF(INDXXL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXXL,XXL)
print *,' VALEUR XXL FOURNIE : ',XXL
ENDIF
IF(INDXXH /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXXH,XXH)
print *,' VALEUR XXH FOURNIE : ',XXH
ENDIF
IF(INDXYL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYL,XYL)
print *,' VALEUR XYL FOURNIE : ',XYL
ENDIF
IF(INDXYH /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXYH,XYH)
print *,' VALEUR XYH FOURNIE : ',XYH
ENDIF
IF(INDXZL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXZL,XZL)
print *,' VALEUR XZL FOURNIE : ',XZL
ENDIF
IF(INDXZH /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXZH,XZH)
print *,' VALEUR XZH FOURNIE : ',XZH
ENDIF
IF(INDXLWVDEF /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWVDEF,XLWVDEF)
print *,' VALEUR XLWVDEF FOURNIE : ',XLWVDEF
ENDIF
IF(INDXLWDEF /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWDEF,XLWDEF)
print *,' VALEUR XLWDEF FOURNIE : ',XLWDEF
ENDIF
IF(INDXLWCONT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWCONT,XLWCONT)
print *,' VALEUR XLWCONT FOURNIE : ',XLWCONT
ENDIF
IF(INDXLWPH1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH1,XLWPH1)
print *,' VALEUR XLWPH1 FOURNIE : ',XLWPH1
ENDIF
IF(INDXLWPH2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH2,XLWPH2)
print *,' VALEUR XLWPH2 FOURNIE : ',XLWPH2
ENDIF
IF(INDXLWPH3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH3,XLWPH3)
print *,' VALEUR XLWPH3 FOURNIE : ',XLWPH3
ENDIF
IF(INDXLWPH4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH4,XLWPH4)
print *,' VALEUR XLWPH4 FOURNIE : ',XLWPH4
ENDIF
IF(INDXLWPH5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH5,XLWPH5)
print *,' VALEUR XLWPH5 FOURNIE : ',XLWPH5
ENDIF
IF(INDXLWPH6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH6,XLWPH6)
print *,' VALEUR XLWPH6 FOURNIE : ',XLWPH6
ENDIF
IF(INDXLWPH7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH7,XLWPH7)
print *,' VALEUR XLWPH7 FOURNIE : ',XLWPH7
ENDIF
IF(INDXLWPH8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWPH8,XLWPH8)
print *,' VALEUR XLWPH8 FOURNIE : ',XLWPH8
ENDIF
IF(INDXVHC /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVHC,XVHC)
print *,' VALEUR XVHC FOURNIE : ',XVHC
ENDIF
IF(INDXVHCPH /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVHCPH,XVHCPH)
print *,' VALEUR XVHCPH FOURNIE : ',XVHCPH
ENDIF
IF(INDXVLC /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVLC,XVLC)
print *,' VALEUR XVLC FOURNIE : ',XVLC
ENDIF
IF(INDXVRL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVRL,XVRL)
print *,' VALEUR XVRL FOURNIE : ',XVRL
ENDIF
IF(INDXVRLPH /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVRLPH,XVRLPH)
print *,' VALEUR XVRLPH FOURNIE : ',XVRLPH
ENDIF
IF(INDXIRS /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXIRS,XIRS)
print *,' VALEUR XIRS FOURNIE : ',XIRS
GXI=.TRUE.
ENDIF
IF(INDXJRS /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXJRS,XJRS)
print *,' VALEUR XJRS FOURNIE : ',XJRS
GXJ=.TRUE.
ENDIF
!
IF(INDXFT1LW1 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW1,XFT1LW1)
PRINT *,' XFT1LW1 FOURNI ',XFT1LW1
ENDIF
IF(INDXFT1LW2 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW2,XFT1LW2)
PRINT *,' XFT1LW2 FOURNI ',XFT1LW2
ENDIF
IF(INDXFT1LW3 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW3,XFT1LW3)
PRINT *,' XFT1LW3 FOURNI ',XFT1LW3
ENDIF
IF(INDXFT1LW4 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW4,XFT1LW4)
PRINT *,' XFT1LW4 FOURNI ',XFT1LW4
ENDIF
IF(INDXFT1LW5 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW5,XFT1LW5)
PRINT *,' XFT1LW5 FOURNI ',XFT1LW5
ENDIF
IF(INDXFT1LW6 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW6,XFT1LW6)
PRINT *,' XFT1LW6 FOURNI ',XFT1LW6
ENDIF
IF(INDXFT1LW7 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW7,XFT1LW7)
PRINT *,' XFT1LW7 FOURNI ',XFT1LW7
ENDIF
IF(INDXFT1LW8 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW8,XFT1LW8)
PRINT *,' XFT1LW8 FOURNI ',XFT1LW8
ENDIF
IF(INDXFT1LW9 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW9,XFT1LW9)
PRINT *,' XFT1LW9 FOURNI ',XFT1LW9
ENDIF
IF(INDXFT1LW10 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW10,XFT1LW10)
PRINT *,' XFT1LW10 FOURNI ',XFT1LW10
ENDIF
IF(INDXFT1LW11 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW11,XFT1LW11)
PRINT *,' XFT1LW11 FOURNI ',XFT1LW11
ENDIF
IF(INDXFT1LW12 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW12,XFT1LW12)
PRINT *,' XFT1LW12 FOURNI ',XFT1LW12
ENDIF
IF(INDXFT1LW13 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW13,XFT1LW13)
PRINT *,' XFT1LW13 FOURNI ',XFT1LW13
ENDIF
IF(INDXFT1LW14 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW14,XFT1LW14)
PRINT *,' XFT1LW14 FOURNI ',XFT1LW14
ENDIF
IF(INDXFT1LW15 /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1LW15,XFT1LW15)
PRINT *,' XFT1LW15 FOURNI ',XFT1LW15
ENDIF
!
IF(GXI .AND. GXJ)THEN
CALL SM_XYHAT_S(XLATORI,XLONORI,XIRS,XJRS,ZX,ZY)
! Modif 19/4/99 !!!!!!!!!!!!
XIRSCC=ZX
XJRSCC=ZY
! DO J=2,SIZE(XXHAT)
! IF(ZX >= XXX(j-1,1) .AND. ZX <XXX(J,1))EXIT
! ENDDO
! JJ=J
! IF(ABS(ZX-XXX(JJ-1,1)) <= ABS(ZX-XXX(JJ,1)))THEN
! NIRS=JJ-1
! ELSE
! NIRS=JJ
! ENDIF
! DO J=2,SIZE(XYHAT)
! IF(ZY >= XXY(J-1,1) .AND. ZY <XXY(J,1))EXIT
! ENDDO
! JJ=J
! IF(ABS(ZY-XXY(JJ-1,1)) <= ABS(ZY-XXY(JJ,1)))THEN
! NJRS=JJ-1
! ELSE
! NJRS=JJ
! ENDIF
print *,' Conversion lat,long:',XIRS,',',XJRS,' origine du profil en coordonnees conformes :'
print *,' CCX=',XIRSCC,' CCY=',XJRSCC
! print *,' Conversion lat,long:',XIRS,',',XJRS,' origine du profil en points de grille : '
! print *,' NIRS=',NIRS,' NJRS=',NJRS,' (valeurs anterieures ecrasees)'
! Modif 19/4/99 !!!!!!!!!!!!
GXI=.FALSE.; GXJ=.FALSE.
ENDIF
IF(INDXPVMIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMIN,XPVMINTRUE)
print *,' VALEUR XPVMIN FOURNIE : ',XPVMINTRUE
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMIN,XPVMINTRUE,1)
ENDIF
IF(INDXPVMAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMAX,XPVMAXTRUE)
print *,' VALEUR XPVMAX FOURNIE : ',XPVMAXTRUE
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMAX,XPVMAXTRUE,2)
ENDIF
IF(INDXPVMINT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMINT,XPVMINT)
print *,' VALEUR XPVMINT FOURNIE : ',XPVMINT
ENDIF
IF(INDXPVMAXT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVMAXT,XPVMAXT)
print *,' VALEUR XPVMAXT FOURNIE : ',XPVMAXT
ENDIF
IF(INDXFT_ADTIM1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM1,XFT_ADTIM1)
print *,' VALEUR XFT_ADTIM1 FOURNIE : ',XFT_ADTIM1
ENDIF
IF(INDXFT_ADTIM2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM2,XFT_ADTIM2)
print *,' VALEUR XFT_ADTIM2 FOURNIE : ',XFT_ADTIM2
ENDIF
IF(INDXFT_ADTIM3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM3,XFT_ADTIM3)
print *,' VALEUR XFT_ADTIM3 FOURNIE : ',XFT_ADTIM3
ENDIF
IF(INDXFT_ADTIM4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM4,XFT_ADTIM4)
print *,' VALEUR XFT_ADTIM4 FOURNIE : ',XFT_ADTIM4
ENDIF
IF(INDXFT_ADTIM5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM5,XFT_ADTIM5)
print *,' VALEUR XFT_ADTIM5 FOURNIE : ',XFT_ADTIM5
ENDIF
IF(INDXFT_ADTIM6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM6,XFT_ADTIM6)
print *,' VALEUR XFT_ADTIM6 FOURNIE : ',XFT_ADTIM6
ENDIF
IF(INDXFT_ADTIM7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM7,XFT_ADTIM7)
print *,' VALEUR XFT_ADTIM7 FOURNIE : ',XFT_ADTIM7
ENDIF
IF(INDXFT_ADTIM8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT_ADTIM8,XFT_ADTIM8)
print *,' VALEUR XFT_ADTIM8 FOURNIE : ',XFT_ADTIM8
ENDIF
IF(INDXFT1_ADTIM1 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM1,XFT1_ADTIM1)
print *,' VALEUR XFT1_ADTIM1 FOURNIE : ',XFT1_ADTIM1
ENDIF
IF(INDXFT1_ADTIM2 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM2,XFT1_ADTIM2)
print *,' VALEUR XFT1_ADTIM2 FOURNIE : ',XFT1_ADTIM2
ENDIF
IF(INDXFT1_ADTIM3 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM3,XFT1_ADTIM3)
print *,' VALEUR XFT1_ADTIM3 FOURNIE : ',XFT1_ADTIM3
ENDIF
IF(INDXFT1_ADTIM4 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM4,XFT1_ADTIM4)
print *,' VALEUR XFT1_ADTIM4 FOURNIE : ',XFT1_ADTIM4
ENDIF
IF(INDXFT1_ADTIM5 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM5,XFT1_ADTIM5)
print *,' VALEUR XFT1_ADTIM5 FOURNIE : ',XFT1_ADTIM5
ENDIF
IF(INDXFT1_ADTIM6 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM6,XFT1_ADTIM6)
print *,' VALEUR XFT1_ADTIM6 FOURNIE : ',XFT1_ADTIM6
ENDIF
IF(INDXFT1_ADTIM7 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM7,XFT1_ADTIM7)
print *,' VALEUR XFT1_ADTIM7 FOURNIE : ',XFT1_ADTIM7
ENDIF
IF(INDXFT1_ADTIM8 /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1_ADTIM8,XFT1_ADTIM8)
print *,' VALEUR XFT1_ADTIM8 FOURNIE : ',XFT1_ADTIM8
ENDIF
IF(INDXFTMIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFTMIN,XFTMIN)
print *,' VALEUR XFTMIN FOURNIE : ',XFTMIN
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXFTMIN,XFTMIN,1)
ENDIF
IF(INDXFTMAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFTMAX,XFTMAX)
print *,' VALEUR XFTMAX FOURNIE : ',XFTMAX
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXFTMAX,XFTMAX,2)
ENDIF
IF(INDXFT1MIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MIN,XFT1MIN)
print *,' VALEUR XFT1MIN FOURNIE : ',XFT1MIN
ENDIF
IF(INDXFT1MAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MAX,XFT1MAX)
print *,' VALEUR XFT1MAX FOURNIE : ',XFT1MAX
ENDIF
IF(INDXFT1MIN_ /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MIN_,XFTMIN)
print *,' VALEUR XFT1MIN FOURNIE : ',XFTMIN
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MIN_,XFTMIN,5)
ENDIF
IF(INDXFT1MAX_ /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MAX_,XFTMAX)
print *,' VALEUR XFT1MAX FOURNIE : ',XFTMAX
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXFT1MAX_,XFTMAX,6)
ENDIF
IF(INDXPVKTMIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVKTMIN,XPVKTMIN)
print *,' VALEUR XPVKTMIN FOURNIE : ',XPVKTMIN
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVKTMIN,XPVKTMIN,3)
ENDIF
IF(INDXPVKTMAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVKTMAX,XPVKTMAX)
print *,' VALEUR XPVKTMAX FOURNIE : ',XPVKTMAX
CALL LOADMNMX_FT_PVKT(YCARIN(1:LEN_TRIM(YCARIN)),INDXPVKTMAX,XPVKTMAX,4)
ENDIF
IF(INDXVARMIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVARMIN,XVARMIN)
print *,' VALEUR XVARMIN FOURNIE : ',XVARMIN
ENDIF
IF(INDXVARMAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVARMAX,XVARMAX)
print *,' VALEUR XVARMAX FOURNIE : ',XVARMAX
ENDIF
IF(INDXZTMIN /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXZTMIN,XZTMIN)
print *,' VALEUR XZTMIN FOURNIE : ',XZTMIN
ENDIF
IF(INDXZTMAX /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXZTMAX,XZTMAX)
print *,' VALEUR XZTMAX FOURNIE : ',XZTMAX
ENDIF
IF(INDXVPTL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTL,XVPTL)
print *,' VALEUR XVPTL FOURNIE : ',XVPTL
ENDIF
IF(INDXVPTR /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTR,XVPTR)
print *,' VALEUR XVPTR FOURNIE : ',XVPTR
ENDIF
IF(INDXVPTB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTB,XVPTB)
print *,' VALEUR XVPTB FOURNIE : ',XVPTB
ENDIF
IF(INDXVPTT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTT,XVPTT)
print *,' VALEUR XVPTT FOURNIE : ',XVPTT
ENDIF
IF(INDXVPTVL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTVL,XVPTVL)
print *,' VALEUR XVPTVL FOURNIE : ',XVPTVL
ENDIF
IF(INDXVPTVR /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTVR,XVPTVR)
print *,' VALEUR XVPTVR FOURNIE : ',XVPTVR
ENDIF
IF(INDXVPTVB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTVB,XVPTVB)
print *,' VALEUR XVPTVB FOURNIE : ',XVPTVB
ENDIF
IF(INDXVPTVT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTVT,XVPTVT)
print *,' VALEUR XVPTVT FOURNIE : ',XVPTVT
ENDIF
!!!!!!!!!!!!!!!!!
IF(INDXVPTFT1L /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTFT1L,XVPTFT1L)
print *,' VALEUR XVPTFT1L FOURNIE : ',XVPTFT1L
ENDIF
IF(INDXVPTFT1R /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTFT1R,XVPTFT1R)
print *,' VALEUR XVPTFT1R FOURNIE : ',XVPTFT1R
ENDIF
IF(INDXVPTFT1B /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTFT1B,XVPTFT1B)
print *,' VALEUR XVPTFT1B FOURNIE : ',XVPTFT1B
ENDIF
IF(INDXVPTFT1T /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTFT1T,XVPTFT1T)
print *,' VALEUR XVPTFT1T FOURNIE : ',XVPTFT1T
ENDIF
!!!!!!!!!!!!!!!!!
IF(INDXVPTPVL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTPVL,XVPTPVL)
print *,' VALEUR XVPTPVL FOURNIE : ',XVPTPVL
ENDIF
IF(INDXVPTPVR /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTPVR,XVPTPVR)
print *,' VALEUR XVPTPVR FOURNIE : ',XVPTPVR
ENDIF
IF(INDXVPTPVB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTPVB,XVPTPVB)
print *,' VALEUR XVPTPVB FOURNIE : ',XVPTPVB
ENDIF
IF(INDXVPTPVT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTPVT,XVPTPVT)
print *,' VALEUR XVPTPVT FOURNIE : ',XVPTPVT
ENDIF
IF(INDXVPTXYL /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTXYL,XVPTXYL)
print *,' VALEUR XVPTXYL FOURNIE : ',XVPTXYL
ENDIF
IF(INDXVPTXYR /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTXYR,XVPTXYR)
print *,' VALEUR XVPTXYR FOURNIE : ',XVPTXYR
ENDIF
IF(INDXVPTXYB /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTXYB,XVPTXYB)
print *,' VALEUR XVPTXYB FOURNIE : ',XVPTXYB
ENDIF
IF(INDXVPTXYT /=0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDXVPTXYT,XVPTXYT)
print *,' VALEUR XVPTXYT FOURNIE : ',XVPTXYT
ENDIF
IF(INDXISOLEV/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOLEV,XISOLEV)
ENDIF
IF(INDXPARCOLUV/=0)THEN
XPARCOLUV(:)=9999.
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPARCOLUV,XPARCOLUV)
DO J=SIZE(XPARCOLUV,1),1,-1
IF(XPARCOLUV(J) /= 9999.)then
NBPARCOLUV=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXISOLEV_ /= 0)THEN
ZISOLEV(:)=9999.
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOLEV_,ZISOLEV)
DO J=SIZE(ZISOLEV,1),1,-1
IF(ZISOLEV(J) /= 9999.)then
JM=J
EXIT
ENDIF
ENDDO
CALL LOADXISOLEVP(YCARIN(1:LEN_TRIM(YCARIN)),INDXISOLEV_,ZISOLEV(1:JM+1))
ENDIF
IF(INDXPORTRAD1/=0)THEN
NPORTRAD1=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPORTRAD1,XPORTRAD1)
DO J=SIZE(XPORTRAD1,1),1,-1
IF(XPORTRAD1(J) /= 9999.)then
NPORTRAD1=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXPORTRAD2/=0)THEN
NPORTRAD2=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPORTRAD2,XPORTRAD2)
DO J=SIZE(XPORTRAD2,1),1,-1
IF(XPORTRAD2(J) /= 9999.)then
NPORTRAD2=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXPORTRAD3/=0)THEN
NPORTRAD3=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPORTRAD3,XPORTRAD3)
DO J=SIZE(XPORTRAD3,1),1,-1
IF(XPORTRAD3(J) /= 9999.)then
NPORTRAD3=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXPORTRAD4/=0)THEN
NPORTRAD4=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPORTRAD4,XPORTRAD4)
DO J=SIZE(XPORTRAD4,1),1,-1
IF(XPORTRAD4(J) /= 9999.)then
NPORTRAD4=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLWRAD1/=0)THEN
NLWRAD1=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWRAD1,XLWRAD1)
DO J=SIZE(XLWRAD1,1),1,-1
IF(XLWRAD1(J) /= 9999.)then
NLWRAD1=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLWRAD2/=0)THEN
NLWRAD2=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWRAD2,XLWRAD2)
DO J=SIZE(XLWRAD2,1),1,-1
IF(XLWRAD2(J) /= 9999.)then
NLWRAD2=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLWRAD3/=0)THEN
NLWRAD3=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWRAD3,XLWRAD3)
DO J=SIZE(XLWRAD3,1),1,-1
IF(XLWRAD3(J) /= 9999.)then
NLWRAD3=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLWRAD4/=0)THEN
NLWRAD4=0
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLWRAD4,XLWRAD4)
DO J=SIZE(XLWRAD4,1),1,-1
IF(XLWRAD4(J) /= 9999.)then
NLWRAD4=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLONCAR/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLONCAR,XLONCAR)
DO J=SIZE(XLONCAR,1),1,-1
IF(XLONCAR(J) /= 9999.)then
NLPCAR=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXLATCAR/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXLATCAR,XLATCAR)
DO J=SIZE(XLATCAR,1),1,-1
IF(XLATCAR(J) /= 9999.)then
NLPCAR=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXICAR/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXICAR,XICAR)
DO J=SIZE(XICAR,1),1,-1
IF(XICAR(J) /= 9999.)then
NIJCAR=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXJCAR/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXJCAR,XJCAR)
DO J=SIZE(XJCAR,1),1,-1
IF(XJCAR(J) /= 9999.)then
NIJCAR=J
EXIT
ENDIF
ENDDO
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
IF(INDXXPART/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXXPART,XXPART)
DO J=SIZE(XXPART,1),1,-1
IF(XXPART(J) /= 9999.)then
NPART=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXYPART/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXYPART,XYPART)
DO J=SIZE(XYPART,1),1,-1
IF(XYPART(J) /= 9999.)then
NPART=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXZPART/=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXZPART,XZPART)
DO J=SIZE(XZPART,1),1,-1
IF(XZPART(J) /= 9999.)then
NPART=J
EXIT
ENDIF
ENDDO
ENDIF
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!JD Mars2009
IF(INDCVARNPV1 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV1=' '
ELSE
print *,' AV read CVARNPV1 ',CVARNPV1
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV1(1:LEN(CVARNPV1))
! CVARNPV1=ADJUSTL(YCARIN(INDQ1+1:INDQ2-1))
ENDIF
print *,' CVARNPV1 AP ',CVARNPV1
! print *,' YCARIN(1:ILENC), ILENC,INDQ1,INDQ2 ',YCARIN(1:ILENC),ILENC,INDQ1,INDQ2
ENDIF
IF(INDCVARNPV2 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV2=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV2
ENDIF
ENDIF
IF(INDCVARNPV3 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV3=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV3
ENDIF
ENDIF
IF(INDCVARNPV4 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV4=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV4
ENDIF
ENDIF
IF(INDCVARNPV5 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV5=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV5
ENDIF
ENDIF
IF(INDCVARNPV6 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV6=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV6
ENDIF
ENDIF
IF(INDCVARNPV7 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV7=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV7
ENDIF
ENDIF
IF(INDCVARNPV8 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV8=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV8
ENDIF
ENDIF
IF(INDCVARNPV9 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV9=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV9
ENDIF
ENDIF
IF(INDCVARNPV10 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV10=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV10
ENDIF
ENDIF
IF(INDCVARNPV11 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV11=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV11
ENDIF
ENDIF
IF(INDCVARNPV12 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV12=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV12
ENDIF
ENDIF
IF(INDCVARNPV13 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV13=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV13
ENDIF
ENDIF
IF(INDCVARNPV14 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV14=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV14
ENDIF
ENDIF
IF(INDCVARNPV15 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPV15=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPV15
ENDIF
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDCVARNPH1 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH1=' '
ELSE
print *,' AV read CVARNPH1 ',CVARNPH1
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH1(1:LEN(CVARNPH1))
ENDIF
print *,' CVARNPH1 AP ',CVARNPH1
ENDIF
IF(INDCVARNPH2 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH2=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH2
ENDIF
ENDIF
IF(INDCVARNPH3 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH3=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH3
ENDIF
ENDIF
IF(INDCVARNPH4 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH4=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH4
ENDIF
ENDIF
IF(INDCVARNPH5 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH5=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH5
ENDIF
ENDIF
IF(INDCVARNPH6 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH6=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH6
ENDIF
ENDIF
IF(INDCVARNPH7 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH7=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH7
ENDIF
ENDIF
IF(INDCVARNPH8 /=0)THEN
INDQ1=INDEX(YCARIN,"'")
INDQ2=INDEX(YCARIN(INDQ1+1:ILENC),"'")
INDQ2=INDQ1+INDQ2
IF(YCARIN(INDQ1+1:INDQ2-1) == ' ')THEN
CVARNPH8=' '
ELSE
READ(YCARIN(INDQ1+1:INDQ2-1),'(A22)')CVARNPH8
ENDIF
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDCNOMCAR /=0)THEN
IND9999=INDEX(YCARIN(1:ILENC),'9999.')
INBV=0
DO J=1,ILENC
IF(YCARIN(J:J) == '=')THEN
JM=J+1
EXIT
ENDIF
ENDDO
DO J=JM,ILENC
IF(YCARIN(J:J) == ',')THEN
INBV=INBV+1
ENDIF
ENDDO
IF(IND9999 == 0)THEN
NOMCAR=INBV+1
ELSE
NOMCAR=INBV
ENDIF
CNOMCAR(:)=' '
if(nverbia > 0)then
print *,' NOMCAR CNOMCAR YCARIN(JM:ILENC) ',NOMCAR,JM,ILENC
print *,CNOMCAR
print *,YCARIN(JM:ILENC)
endif
READ(YCARIN(JM:ILENC+2),*)(CNOMCAR(J),J=1,NOMCAR)
print *,' NOMCAR CNOMCAR ',NOMCAR
print *,(CNOMCAR(J),J=1,NOMCAR)
ENDIF
IF(INDCSYMCAR /=0)THEN
if(nverbia > 0)then
print *,' *** CARESOLV ILENC YCARIN(1:ILENC) ',ILENC,YCARIN(1:ILENC)
endif
IND9999=INDEX(YCARIN(1:ILENC),'9999.')
INBV=0
DO J=1,ILENC
IF(YCARIN(J:J) == '=')THEN
JM=J+1
EXIT
ENDIF
ENDDO
DO J=JM,ILENC
IF(YCARIN(J:J) == ',')THEN
INBV=INBV+1
ENDIF
ENDDO
IF(IND9999 == 0)THEN
NSYMCAR=INBV+1
ELSE
NSYMCAR=INBV
ENDIF
CSYMCAR(:)='.'
if(nverbia > 0)then
print *,' NSYMCAR CSYMCAR YCARIN(JM:ILENC) ',NSYMCAR,JM,ILENC
print *,CSYMCAR
print *,YCARIN(JM:ILENC)
endif
! READ(YCARIN,*)(CSYMCAR(J),J=1,NSYMCAR)
READ(YCARIN(JM:ILENC+2),*)(CSYMCAR(J),J=1,NSYMCAR)
print *,' NSYMCAR CSYMCAR ',NSYMCAR
print *,(CSYMCAR(J),J=1,NSYMCAR)
ENDIF
IF(INDXPOSNOM /=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXPOSNOM,XPOSNOM)
DO J=SIZE(XPOSNOM,1),1,-1
IF(XPOSNOM(J) /= 9999.)then
NPOSNOM=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDXSZNOM /=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZNOM,XSZNOM)
DO J=SIZE(XSZNOM,1),1,-1
IF(XSZNOM(J) /= 9999.)then
NSZNOM=J
EXIT
ENDIF
ENDDO
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDNSZRTRAJ /= 0)THEN
CALL RESOLVX(YCARIN(1:LEN_TRIM(YCARIN)),INDNSZRTRAJ,NSZRTRAJ)
PRINT *,' NSZRTRAJ FOURNI ',NSZRTRAJ
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(INDXSZSYM /=0)THEN
CALL RESOLVXISOLEV(YCARIN(1:LEN_TRIM(YCARIN)),INDXSZSYM,XSZSYM)
DO J=SIZE(XSZSYM,1),1,-1
IF(XSZSYM(J) /= 9999.)then
NSZSYM=J
EXIT
ENDIF
ENDDO
ENDIF
IF(INDICOLNOM /=0)THEN
CALL RESOLVIARRAY(YCARIN(1:LEN_TRIM(YCARIN)),INDICOLNOM,ICOLNOM,NCOLNOM)
ENDIF
IF(INDICOLSYM /=0)THEN
CALL RESOLVIARRAY(YCARIN(1:LEN_TRIM(YCARIN)),INDICOLSYM,ICOLSYM,NCOLSYM)
ENDIF
IF(INDNINDCOLUV /=0)THEN
CALL RESOLVIARRAY(YCARIN(1:LEN_TRIM(YCARIN)),INDNINDCOLUV,NINDCOLUV,NBCOLUV)
ENDIF
INDIM=999
IT(1)=INDIINF; IT(2)=INDJINF; IT(3)=INDISUP; IT(4)=INDJSUP
IT(5)=INDIDEBCOU; IT(6)=INDJDEBCOU; IT(7)=INDXIDEBCOU; IT(8)=INDXJDEBCOU
IT(9)=INDNLANGLE; IT(10)=INDNLMAX; IT(11)=INDNIOFFD; IT(12)=INDNULBLL
IT(13)=INDNHI; IT(14)=INDNIMNMX; IT(15)=INDXDIAINT; IT(16)=INDLXY;
IT(17)=INDLXZ; IT(18)=INDLISO; IT(19)=INDLMINMAX; IT(20)=INDATFILE;
IT(21)=INDLCOLAREA; IT(22)=INDLCOLINE; IT(23)=INDLISOWHI; IT(24)=INDLCOLBR;
IT(25)=INDLCOLAREASEL; IT(26)=INDLCOLINESEL; IT(27)=INDLTABCOLDEF
IT(28)=INDNIFDC; IT(29)=INDNIGRNC; IT(30)=INDXHMIN; IT(31)=INDXHMAX
IT(32)=INDXISOMIN; IT(33)=INDXISOMAX; IT(34)=INDVISU; IT(35)=INDNOVISU
IT(36)=INDXSIZEL; IT(37)=INDNPROFILE; IT(38)=INDXPVMIN; IT(39)=INDXPVMAX
IT(40)=INDXISOLEV; IT(41)=INDXFTMIN; IT(42)=INDXFTMAX; IT(43)=INDXPVKTMIN
IT(44)=INDXPVKTMAX; IT(45)=INDLMNMXUSER; IT(46)=INDLCOLUSER;
IT(47)=INDNIRS; IT(48)=INDNJRS; IT(49)=INDXIRS; IT(50)=INDXJRS
IT(51)=INDXAMX; IT(52)=INDXVHC; IT(53)=INDXVRL; IT(54)=INDNDOT
IT(55)=INDNISKIP; IT(56)=INDXLATCAR; IT(57)=INDXLONCAR; IT(58)=INDLVECTMNMX
IT(59)=INDLANIMK; IT(60)=INDLANIMT; IT(61)=INDLPRINT; IT(62)=INDLPOINTG
IT(63)=INDL2DBX; IT(64)=INDL2DBY; IT(65)=INDXISOMIN_; IT(66)=INDXISOMAX_
IT(67)=INDXDIAINT_; IT(68)=INDXVARMIN; IT(69)=INDXVARMAX
IT(70)=INDXZTMIN; IT(71)=INDXZTMAX; IT(72)=INDLXYO; IT(73)=INDLPRINTXY
IT(74)=INDXFT1MIN; IT(75)=INDXFT1MAX; IT(76)=INDXFT1MIN_; IT(77)=INDXFT1MAX_
IT(78)=INDLVPTUSER; IT(79)=INDLVPTVUSER; IT(80)=INDLVPTPVUSER
IT(81)=INDXVPTL; IT(82)=INDXVPTR; IT(83)=INDXVPTB; IT(84)=INDXVPTT
IT(85)=INDXVPTVL; IT(86)=INDXVPTVR; IT(87)=INDXVPTVB; IT(88)=INDXVPTVT
IT(89)=INDXVPTPVL; IT(90)=INDXVPTPVR; IT(91)=INDXVPTPVB; IT(92)=INDXVPTPVT
IT(93)=INDXLWV; IT(94)=INDXLWVDEF; IT(95)=INDXLWDEF
IT(96)=INDXLW; IT(97)=INDXLW1; IT(98)=INDXLW2; IT(99)=INDXLW3; IT(100)=INDXLW4
IT(101)=INDLCOLZERO; IT(102)=INDNCOLZERO; IT(103)=INDLHACH1; IT(104)=INDLHACH2
IT(105)=INDLHACH3; IT(106)=INDLHACH4; IT(107)=INDLHACHSEL
IT(108)=INDLABEL1; IT(109)=INDLBLUSER1; IT(110)=INDLBLUSER2
IT(111)=INDLBLUSER3; IT(112)=INDLBLUSER4; IT(113)=INDLXABSC; IT(114)=INDLXMINTOP
IT(115)=INDLINDSP; IT(116)=INDLOGNEP; IT(117)=INDLTABCOLDEF2
IT(118)=INDLCONT; IT(119)=INDLRELIEF; IT(120)=INDLCONV2XY
IT(121)=INDXPVMINT; IT(122)=INDXPVMAXT
IT(123)=INDXVPTXYL; IT(124)=INDXVPTXYR; IT(125)=INDXVPTXYB; IT(126)=INDXVPTXYT
IT(127)=INDLVPTXYUSER; IT(128)=INDNVERBIA; IT(129)=INDLINVWB
IT(130)=INDLISOWHI2; IT(131)=INDLISOWHI3; IT(132)=INDXISOLEV_
IT(133)=INDXSPVAL; IT(134)=INDLGEOG
IT(135)=INDNFT1ITVXMJ;IT(136)=INDNFT1ITVXMN;IT(137)=INDNFT1ITVYMJ
IT(138)=INDNFT1ITVYMN
IT(139)=INDNFTITVXMJ;IT(140)=INDNFTITVXMN;IT(141)=INDNFTITVYMJ
IT(142)=INDNFTITVYMN
IT(143)=INDNCHITVXMJ;IT(144)=INDNCHITVXMN;IT(145)=INDNCHITVYMJ
IT(146)=INDNCHITVYMN
IT(147)=INDNCHPCITVXMJ;IT(148)=INDNCHPCITVXMN;IT(149)=INDNCHPCITVYMJ
IT(150)=INDNCHPCITVYMN; IT(151)=INDLFT1STYLUSER
IT(152)=INDNCVITVXMJ;IT(153)=INDNCVITVXMN;IT(154)=INDNCVITVYMJ;IT(155)=INDNCVITVYMN
IT(156)=INDNPVITVXMJ;IT(157)=INDNPVITVXMN;IT(158)=INDNPVITVYMJ;IT(159)=INDNPVITVYMN
IT(160)=INDNXYITVXMJ;IT(161)=INDNXYITVXMN;IT(162)=INDNXYITVYMJ;IT(163)=INDNXYITVYMN
IT(164)=INDNMASKITVXMJ;IT(165)=INDNMASKITVXMN;IT(166)=INDNMASKITVYMJ;IT(167)=INDNMASKITVYMN
IT(168)=INDLFTSTYLUSER;IT(169)=INDXSZTITXL;IT(170)=INDXSZTITXM;IT(171)=INDXSZTITXR
IT(172)=INDLDEFCV2;IT(173)=INDLDEFCV2LL;IT(174)=INDLDEFCV2IND
IT(175)=INDXIDEBCV;IT(176)=INDXJDEBCV;IT(177)=INDXIFINCV;IT(178)=INDXJFINCV
IT(179)=INDXIDEBCVLL;IT(180)=INDXJDEBCVLL;IT(181)=INDXIFINCVLL;IT(182)=INDXJFINCVLL
IT(183)=INDNIDEBCV;IT(184)=INDNJDEBCV;IT(185)=INDNIFINCV;IT(186)=INDNJFINCV
IT(187)=INDLSYMB;IT(188)=INDLSYMBTEXTG;IT(189)=INDLTEXTG;IT(190)=INDLSTI
IT(191)=INDLTRACECV;IT(192)=INDLTEXTIT; IT(193)=INDLMNMXLOC; IT(194)=INDLULMVTMOLD
IT(195)=INDLTITFTUSER; IT(196)=INDXANGULVT
IT(197)=INDLMASK3D; IT(198)=INDXXL; IT(199)=INDXXH; IT(200)=INDXYL
IT(201)=INDXYH; IT(202)=INDXZL; IT(203)=INDXZH; IT(204)=INDXLWCONT
IT(205)=INDLMARKER; IT(206)=INDXVLC; IT(207)=INDCNOMCAR; IT(208)=INDCSYMCAR
IT(209)=INDXPOSNOM; IT(210)=INDXSZNOM; IT(211)=INDXSZSYM; IT(212)=INDICOLNOM
IT(213)=INDICOLSYM; IT(214)=INDXSZTITT1; IT(215)=INDXSZTITT2;IT(216)=INDXSZTITT3
IT(217)=INDLINDAX; IT(218)=INDXSZTITB1; IT(219)=INDXSZTITB2; IT(220)=INDXSZTITB3
IT(221)=INDXPOSTITT1; IT(222)=INDXPOSTITT2;IT(223)=INDXPOSTITT3
IT(224)=INDXYPOSTITT1; IT(225)=INDXYPOSTITT2;IT(226)=INDXYPOSTITT3
IT(227)=INDXPOSTITB1; IT(228)=INDXPOSTITB2;IT(229)=INDXPOSTITB3
IT(230)=INDXYPOSTITB1; IT(231)=INDXYPOSTITB2;IT(232)=INDXYPOSTITB3
IT(233)=INDXSZTITVAR1; IT(234)=INDXSZTITVAR2; IT(235)=INDXSZTITVAR3
IT(236)=INDXSZTITVAR4; IT(237)=INDXSZTITVAR5; IT(238)=INDXSZTITVAR6
IT(239)=INDXSZTITVAR7; IT(240)=INDXSZTITVAR8
IT(241)=INDXPOSTITVAR1; IT(242)=INDXPOSTITVAR2; IT(243)=INDXPOSTITVAR3
IT(244)=INDXPOSTITVAR4; IT(245)=INDXPOSTITVAR5; IT(246)=INDXPOSTITVAR6
IT(247)=INDXPOSTITVAR7; IT(248)=INDXPOSTITVAR8
IT(249)=INDXYPOSTITVAR1; IT(250)=INDXYPOSTITVAR2; IT(251)=INDXYPOSTITVAR3
IT(252)=INDXYPOSTITVAR4; IT(253)=INDXYPOSTITVAR5; IT(254)=INDXYPOSTITVAR6
IT(255)=INDXYPOSTITVAR7; IT(256)=INDXYPOSTITVAR8; IT(257)=INDXLWPV1
IT(258)=INDXLWPV2; IT(259)=INDXLWPV3; IT(260)=INDXLWPV4; IT(261)=INDXLWPV5
IT(262)=INDXLWPV6; IT(263)=INDXLWPV7; IT(264)=INDXLWPV8; IT(265)=INDXSTYLPV1
IT(266)=INDXSTYLPV2; IT(267)=INDXSTYLPV3;IT(268)=INDXSTYLPV4;IT(269)=INDXSTYLPV5
IT(270)=INDXSTYLPV6; IT(271)=INDXSTYLPV7;IT(272)=INDXSTYLPV8
IT(273)=INDLFACTIMP; IT(274)=INDNSD; IT(275)=INDXLWTRACECV
IT(276)=INDLFMTAXEX; IT(277)=INDLFMTAXEY; IT(278)=INDLMASK3D_XY
IT(279)=INDLMASK3D_XZ; IT(280)=INDLMASK3D_YZ; IT(281)=INDLXYZ00
IT(282)=INDLINTERPTOP; IT(283)=INDLCOLISONE; IT(284)=INDLCOLRSONE
IT(285)=INDLCOLRS1ONE; IT(286)=INDNCOLRSONE; IT(287)=INDNCOLISONE1
IT(288)=INDNCOLISONE2; IT(289)=INDNCOLISONE3; IT(290)=INDNCOLISONE4
IT(291)=INDNCOLISONE5
IT(292)=INDNCOLRS1ONE2; IT(293)=INDNCOLRS1ONE3; IT(294)=INDNCOLRS1ONE4
IT(295)=INDNCOLRS1ONE5; IT(296)=INDNCOLRS1ONE1; IT(297)=INDLCHREEL
IT(298)=INDLCOLUSERUV; IT(299)=INDNINDCOLUV; IT(300)=INDXPARCOLUV
IT(301)=INDNISKIPVX; IT(302)=INDNISKIPVY; IT(303)=INDLINVPTIR
IT(304)=INDLDOMAIN; IT(305)=INDNDOMAINL; IT(306)=INDNDOMAINR
IT(307)=INDNDOMAINB; IT(308)=INDNDOMAINT; IT(309)=INDXLWDOMAIN
IT(310)=INDLHEURX; IT(311)=INDXVRLPH; IT(312)=INDXVHCPH;IT(313)=INDLTIMEUSER
IT(314)=INDXTIMEMIN; IT(315)=INDXTIMEMAX; IT(316)=INDXSPVALT;IT(317)=INDLSPVALT
IT(318)=INDXLWFTALL; IT(319)=INDLSEGM; IT(320)=INDNCOLSEGM
IT(321)=INDXLWSEGM; IT(322)=INDL2CONT; IT(323)=INDNCOLUV1;IT(324)=INDNCOLUV2
IT(325)=INDNCOLUV3; IT(326)=INDNCOLUV4; IT(327)=INDNCOLUV5; IT(328)=INDLPRESY
IT(329)=INDXPMIN; IT(330)=INDXPMAX; IT(331)=INDXPINT; IT(332)=INDLM5S3
IT(333)=INDXICAR; IT(334)=INDXJCAR; IT(335)=INDXLWPH1; IT(336)=INDXLWPH2
IT(337)=INDXLWPH3; IT(338)=INDXLWPH4; IT(339)=INDLSPSECT; IT(340)=INDLEGVECT
IT(341)=INDNSZLBX; IT(342)=INDNSZLBY; IT(343)=INDLCVZOOM; IT(344)=INDLVST
IT(345)=INDLDILW ; IT(346)=INDLVSUPSCA; IT(347)=INDXLWPH5; IT(348)=INDXLWPH6
IT(349)=INDXLWPH7; IT(350)=INDXLWPH8
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
IT(351)=INDXXPART
IT(352)=INDXYPART
IT(353)=INDXZPART
IT(354)=INDLTRAJ3D
IT(355)=INDLTRAJ_GROUP
IT(356)=INDLFLUX3D
!!!!!!!!!!!!JOEL!!!!!!!!!!
!!!!!!!!!!!!JOEL!!!!!!!!!!
IT(357)=INDLFACTAXEX; IT(358)=INDLFACTAXEY; IT(359)=INDLAXEXUSER
IT(360)=INDLAXEYUSER; IT(361)=INDXFACTAXEX; IT(362)=INDXFACTAXEY
IT(363)=INDXAXEXUSERD; IT(364)=INDXAXEYUSERD; IT(365)=INDXAXEXUSERF
IT(366)=INDXAXEYUSERF; IT(367)=INDLPRDAT; IT(368)=INDLXYWINCUR
IT(369)=INDLSTREAM; IT(370)=INDLNOLABELX; IT(371)=INDLNOLABELY
IT(372)=INDLINTERPOLSTR; IT(373)=INDNZSTR; IT(374)=INDNARSTR
IT(375)=INDXSSP; IT(376)=INDXLWSTR; IT(377)=INDXARLSTR
IT(378)=INDLMYHEURX ; IT(379)=INDLNOUVRS;IT(380)=INDNHEURXLBL
IT(381)=INDNHEURXGRAD; IT(382)=INDL3D !; IT(383)=INDLCONVG2MASS
IT(383)=INDXFT_ADTIM1;IT(384)=INDXFT_ADTIM2;IT(385)=INDXFT_ADTIM3
IT(386)=INDXFT_ADTIM4;IT(387)=INDXFT_ADTIM5;IT(388)=INDXFT_ADTIM6
IT(389)=INDXFT_ADTIM7;IT(390)=INDXFT_ADTIM8
IT(391)=INDXFT1_ADTIM1;IT(392)=INDXFT1_ADTIM2;IT(393)=INDXFT1_ADTIM3
IT(394)=INDXFT1_ADTIM4;IT(395)=INDXFT1_ADTIM5;IT(396)=INDXFT1_ADTIM6
IT(397)=INDXFT1_ADTIM7;IT(398)=INDXFT1_ADTIM8; IT(399)=INDLRADAR
IT(400)=INDXLATRAD1;IT(401)=INDXLATRAD2;IT(402)=INDXLATRAD3;IT(403)=INDXLATRAD4
IT(404)=INDXLONRAD1;IT(405)=INDXLONRAD2;IT(406)=INDXLONRAD3;IT(407)=INDXLONRAD4
IT(408)=INDXPORTRAD1;IT(409)=INDXPORTRAD2;IT(410)=INDXPORTRAD3
IT(411)=INDXPORTRAD4
IT(412)=INDXLWRAD1;IT(413)=INDXLWRAD2;IT(414)=INDXLWRAD3;IT(415)=INDXLWRAD4
IT(416)=INDCSYMRAD1;IT(417)=INDCSYMRAD2;IT(418)=INDCSYMRAD3;IT(419)=INDCSYMRAD4
IT(420)=INDLRADIST; IT(421)=INDLRADRAY
IT(422)=INDLRADAR
IT(423)=INDXLATRAD1;IT(424)=INDXLATRAD2;IT(425)=INDXLATRAD3;IT(426)=INDXLATRAD4
IT(427)=INDXLONRAD1;IT(428)=INDXLONRAD2;IT(429)=INDXLONRAD3;IT(430)=INDXLONRAD4
IT(431)=INDXPORTRAD1;IT(432)=INDXPORTRAD2;IT(433)=INDXPORTRAD3
IT(434)=INDXPORTRAD4
IT(435)=INDXLWRAD1;IT(436)=INDXLWRAD2;IT(437)=INDXLWRAD3;IT(438)=INDXLWRAD4
IT(439)=INDXVPTFT1L;IT(440)=INDXVPTFT1R;IT(441)=INDXVPTFT1B;IT(442)=INDXVPTFT1T
IT(443)=INDLRADIST; IT(444)=INDLRADRAY
IT(445)=INDXISOREF; IT(446)=INDXISOREF_ ; IT(447)=INDLSPOT
IT(448)=INDLFT3C; IT(449)=INDLFT4C; IT(450)=INDLFTCLIP
IT(451)=INDLFTBAUTO; IT(452)=INDLFT1BAUTO
IT(453)=INDLGREY; IT(454)=INDLFT1LUSER; IT(455)=INDNFT1STY1
IT(456)=INDNFT1STY2; IT(457)=INDNFT1STY3; IT(458)=INDNFT1STY4
IT(459)=INDNFT1STY5; IT(460)=INDNFT1STY6; IT(461)=INDNFT1STY7
IT(462)=INDNFT1STY8; IT(463)=INDNFT1STY9; IT(464)=INDNFT1STY10
IT(465)=INDNFT1STY11; IT(466)=INDNFT1STY12; IT(467)=INDNFT1STY13
IT(468)=INDNFT1STY14; IT(469)=INDNFT1STY15; IT(470)=INDNFT1COL1
IT(471)=INDNFT1COL2; IT(472)=INDNFT1COL3; IT(473)=INDNFT1COL4
IT(474)=INDNFT1COL5; IT(475)=INDNFT1COL6; IT(476)=INDNFT1COL7
IT(477)=INDNFT1COL8; IT(478)=INDNFT1COL9; IT(479)=INDNFT1COL10
IT(480)=INDNFT1COL11; IT(481)=INDNFT1COL12; IT(482)=INDNFT1COL13
IT(483)=INDNFT1COL14; IT(484)=INDNFT1COL15
IT(485)=INDXFT1LW1; IT(486)=INDXFT1LW2; IT(487)=INDXFT1LW3
IT(488)=INDXFT1LW4; IT(489)=INDXFT1LW5; IT(490)=INDXFT1LW6
IT(491)=INDXFT1LW7; IT(492)=INDXFT1LW8; IT(493)=INDXFT1LW9
IT(494)=INDXFT1LW10; IT(495)=INDXFT1LW11; IT(496)=INDXFT1LW12
IT(497)=INDXFT1LW13; IT(498)=INDXFT1LW14; IT(499)=INDXFT1LW15
IT(500)=INDCFT1TIT1; IT(501)=INDCFT1TIT2; IT(502)=INDCFT1TIT3
IT(503)=INDCFT1TIT4; IT(504)=INDCFT1TIT5; IT(505)=INDCFT1TIT6
IT(506)=INDCFT1TIT7; IT(507)=INDCFT1TIT8; IT(508)=INDCFT1TIT9
IT(509)=INDCFT1TIT10; IT(510)=INDCFT1TIT11; IT(511)=INDCFT1TIT12
IT(512)=INDCFT1TIT13; IT(513)=INDCFT1TIT14; IT(514)=INDCFT1TIT15
IT(515)=INDLVPTFT1USER; IT(516)=INDXLWPV9; IT(517)=INDXLWPV10;
IT(518)=INDXLWPV11; IT(519)=INDXLWPV12; IT(520)=INDXLWPV13; IT(521)=INDXLWPV14
IT(522)=INDXLWPV15
IT(523)=INDXSTYLPV9; IT(524)=INDXSTYLPV10;IT(525)=INDXSTYLPV11
IT(526)=INDXSTYLPV12; IT(527)=INDXSTYLPV13;IT(528)=INDXSTYLPV14
IT(529)=INDXSTYLPV15; IT(530)=INDLVARNPVUSER
IT(531)=INDCVARNPV1; IT(532)=INDCVARNPV2; IT(533)=INDCVARNPV3
IT(534)=INDCVARNPV4; IT(535)=INDCVARNPV5; IT(536)=INDCVARNPV6
IT(537)=INDCVARNPV7; IT(538)=INDCVARNPV8; IT(539)=INDCVARNPV9
IT(540)=INDCVARNPV10; IT(541)=INDCVARNPV11; IT(542)=INDCVARNPV12
IT(543)=INDCVARNPV13; IT(544)=INDCVARNPV14; IT(545)=INDCVARNPV15
IT(546)=INDXPOSXVARNPV1TOP; IT(547)=INDXPOSYVARNPV1TOP
IT(548)=INDXPOSXVARNPV5BOT; IT(549)=INDXPOSYVARNPV5BOT
IT(550)=INDXSZVARNPVTOP; IT(551)=INDXSZVARNPVTOP
IT(552)=INDXSZVARNPVBOT; IT(553)=INDXSZVARNPVBOT; IT(554)=INDLINZEROPV
IT(555)=INDNSTYLINZEROPV; IT(556)=INDLBLFT1SUP
IT(557)=INDLXYSTYLTOP; IT(558)=INDLXYNVARTOP
IT(559)=INDNPHCOL1; IT(560)=INDNPHCOL2; IT(561)=INDNPHCOL3;IT(562)=INDNPHCOL4
IT(563)=INDNPHCOL1; IT(564)=INDNPHCOL2; IT(565)=INDNPHCOL3;IT(566)=INDNPHCOL4
IT(567)=INDNPHSTY1; IT(568)=INDNPHSTY2; IT(569)=INDNPHSTY3;IT(570)=INDNPHSTY4
IT(571)=INDNPHSTY1; IT(572)=INDNPHSTY2; IT(573)=INDNPHSTY3;IT(574)=INDNPHSTY4
IT(575)=INDLPHCOLUSER; IT(576)=INDLPHSTYUSER; IT(577)=INDL24H
IT(578)=INDLNOLBLBAR
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! 19/12/2008 : modification pour controler la taille et le format des labels !!
!! pour les retrotrajectoires !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IT(579)=INDNSZRTRAJ; IT(580)=INDLFMTRTRAJ ; IT(581)=INDLCONVG2MASS
IT(582)=INDL90TITYT;IT(583)=INDL90TITYM;IT(584)=INDL90TITYB
!!!!!!!!!!!!JOEL!!!!!!!!!!
IT(585)=INDXSZTITYT; IT(586)=INDXSZTITYM;IT(587)=INDXSZTITYB
IT(588)=INDLVARNPHUSER
IT(589)=INDCVARNPH1; IT(590)=INDCVARNPH2; IT(591)=INDCVARNPH3
IT(592)=INDCVARNPH4; IT(593)=INDCVARNPH5; IT(594)=INDCVARNPH6
IT(594)=INDCVARNPH7; IT(596)=INDCVARNPH8;
IT(597)=INDXPOSTITYT; IT(598)=INDXPOSTITYM;IT(599)=INDXPOSTITYB
IT(600)=INDXYPOSTITYT; IT(601)=INDXYPOSTITYM;IT(602)=INDXYPOSTITYB
IT(603)=INDLPATCH
DO J=1,SIZE(IT)
IF(IT(J) /=0 )THEN
INDIM=MIN(INDIM,IT(J))
ENDIF
ENDDO
if(nverbia >0)then
print *,'*** CARESOLV INDIM ',INDIM
endif
IF (LPATCH) THEN
INDP = 0
ELSE
INDP = INDEX(YCARIN,'_P_')
ENDIF
INDT = INDEX(YCARIN,'_T_')
INDK = INDEX(YCARIN,'_K_')
INDZ = INDEX(YCARIN,'_Z_')
INDCV = INDEX(YCARIN,'_CV_')
INDPV = INDEX(YCARIN,'_PV_')
INDPVT = INDEX(YCARIN,'_PVT_')
INDPXT = INDEX(YCARIN,'_PXT_')
INDPYT = INDEX(YCARIN,'_PYT_')
INDPVKT = INDEX(YCARIN,'_PVKT_')
INDPH = INDEX(YCARIN,'_PH_')
INDON = INDEX(YCARIN,'_ON_')
INDFI = INDEX(YCARIN,'_FILE')
INDN = INDEX(YCARIN,'_N_')
INDFT = INDEX(YCARIN,'_FT_')
INDFT1 = INDEX(YCARIN,'_FT1_')
INDMASK = INDEX(YCARIN,'_MASK_')
INDMASKCUM = INDEX(YCARIN,'_MASKCUM_')
INDMASKSUM = INDEX(YCARIN,'_MASKSUM_')
INDMINUS= INDEX(YCARIN,'_MINUS_')
INDPLUS= INDEX(YCARIN,'_PLUS_')
INDTK = INDEX(YCARIN,'_TK_')
INDEV = INDEX(YCARIN,'_EV_')
INDPR = INDEX(YCARIN,'_PR_')
INDRS = INDEX(YCARIN,'_RS_')
INDRS1 = INDEX(YCARIN,'_RS1_')
INDPVKT1 = INDEX(YCARIN,'_PVKT1_')
INDZTPVKT1 = INDEX(YCARIN,'_ZTPVKT1_')
INDZT = INDEX(YCARIN,'_ZT_')
INDXT = INDEX(YCARIN,'_XT_')
INDYT = INDEX(YCARIN,'_YT_')
INDXY = INDEX(YCARIN,'_XY_')
INDXYZ = INDEX(YCARIN,'_XYZ_')
INDUMVMPV = INDEX(YCARIN,'_UMVM_')
IF(INDUMVMPV == 0)THEN
INDUMVMPV = INDEX(YCARIN,'_UTVT_')
ENDIF
INDLSPLO = INDEX(YCARIN,'_LSPLO_')
INDSPO = INDEX(YCARIN,'_SPO_')
INDOSPLO = INDEX(YCARIN,'_OSPLO_')
INDPHALO = INDEX(YCARIN,'_PHALO_')
INDPHAO = INDEX(YCARIN,'_PHAO_')
INDMSKTOP = INDEX(YCARIN,'_MSKTOP_')
INDSV3 = INDEX(YCARIN,'_SV3_')
!
INDTOT = INDP+INDT+INDK+INDZ+INDCV+INDPV+INDPVT+INDPH+INDON+INDFI+INDN+ &
INDFT+INDFT1+INDPVKT+INDMASK+INDMASKCUM+INDMASKSUM+INDMINUS+ &
INDTK+INDPR+INDRS+INDPVKT1+INDZTPVKT1+INDZT+INDXT+INDYT+INDXY+ &
INDRS1+INDPLUS+INDEV+INDPXT+INDPYT+INDLSPLO+INDSPO+INDOSPLO+ &
INDPHALO+INDPHAO+INDXYZ+INDMSKTOP+INDSV3+INDUMVMPV
!
if(nverbia >0)then
print *,'*** CARESOLV INDTOT ',INDTOT
endif
INBMIN=0
IIMIN(:,1)=0
IF(INDTOT == 0)THEN
YCARIN=ADJUSTL(YCARIN)
IF (INDIM /= 1)THEN
! Oct 99
NPARG=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),'(')
NPARD=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),')')
IF(NPARG /= 0 .AND. NPARD /= 0)THEN
! Juillet 2001
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(1)=2
ELSE
NMULTDIV(1)=1
ENDIF
IF(INDEXPR /= 0.)THEN
CMULTDIV(1)=YCARIN(NPARG+1:NPARG+7)
YCARIN(NPARG:NPARD)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ELSE
! Juillet 2001
IETOILE=INDEX(YCARIN(NPARG:NPARD),'*')
ILOG =INDEX(YCARIN(NPARG:NPARD),'LOG')
CFACT(1)=YCARIN(1:NPARD)
CFACT(1)=ADJUSTL(CFACT(1))
IF(ILOG /=0) THEN
NOPE(1)=3
YCARIN(NPARG:NPARD)=' '
ELSE IF(IETOILE /= 0)THEN
READ(YCARIN(IETOILE+NPARG:NPARD-1),*)XCONSTANTE(1)
print *,' **Caresolv IETOILE+1+NPARG ',IETOILE+1+NPARG
NOPE(1)=2
YCARIN(NPARG:NPARD)=' '
ELSE
READ(YCARIN(NPARG+1:NPARD-1),*)XCONSTANTE(1)
NOPE(1)=1
YCARIN(NPARG:NPARD)=' '
ENDIF
! Juillet 2001
IF(NPARD < LEN_TRIM(YCARIN))THEN
ILEN=LEN_TRIM(YCARIN)
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(1)=2
ELSE
NMULTDIV(1)=1
ENDIF
IF(INDEXPR /= 0.)THEN
CMULTDIV(1)=YCARIN(NPARD+2:NPARD+8)
YCARIN(NPARG:NPARD+10)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ENDIF
ELSE
! Juillet 2001
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
! Juillet 2001
ENDIF
ENDIF
! Juillet 2001
ELSE
! Oct 99
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
! Oct 99
ENDIF
! Oct 99
CGROUP=ADJUSTL(CGROUP)
IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZS')THEN
CGROUP(1:LEN_TRIM(CGROUP))=' '
CGROUP='ZSBIS'
ENDIF
IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZSMT')THEN
CGROUP(1:LEN_TRIM(CGROUP))=' '
CGROUP='ZSMTBIS'
ENDIF
CGROUPS(1)(1:LEN(CGROUPS(1))) = ' '
CGROUPS(1)=ADJUSTL(CGROUP)
ENDIF
IF(INDIM == 1 .OR. CGROUP(1:LEN_TRIM(CGROUP)) == ' ')THEN
! Septembre 2000
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
RETURN
ENDIF
NSUPERDIA=1
LPROCDIALL(NSUPERDIA)=.TRUE.
LTIMEDIALL(NSUPERDIA,:)=.TRUE.
LNDIALL(NSUPERDIA)=.TRUE.
LVLKDIALL(NSUPERDIA,:)=.TRUE.
YCARIN=CGROUP(1:LEN_TRIM(CGROUP))//'_P_PROCALL_T_TIMEALL_N_NALL_K_LVLKALL'
! print *,' CARESOLV HGRP ',CGROUP
CALL CARMEMORY(YCARIN,1)
CALL CARMEMORY(YCARIN,3)
ELSE
IF(INDON /= 0)THEN
IF(INDPLUS == 0 .AND. INDMINUS == 0)THEN
CALL RESOLVON(YCARIN,INDON)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDON
ELSE
IF(INDPLUS == 0 .AND. INDMINUS /= 0)THEN
IF(INDMINUS < INDON)THEN
LMINUS=.TRUE.
CALL RESOLVON(YCARIN,INDMINUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDMINUS
ELSE
CALL RESOLVON(YCARIN,INDON)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDON
ENDIF
ELSE IF(INDPLUS /= 0 .AND. INDMINUS == 0)THEN
IF(INDPLUS < INDON)THEN
LPLUS=.TRUE.
CALL RESOLVON(YCARIN,INDPLUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDPLUS
ELSE
CALL RESOLVON(YCARIN,INDON)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDON
ENDIF
ELSE
IF(INDON < INDMINUS .AND. INDON < INDPLUS)THEN
CALL RESOLVON(YCARIN,INDON)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDON
ELSE IF(INDMINUS < INDON .AND. INDMINUS < INDPLUS)THEN
LMINUS=.TRUE.
CALL RESOLVON(YCARIN,INDMINUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDMINUS
ELSE IF(INDPLUS < INDON .AND. INDPLUS < INDMINUS)THEN
LPLUS=.TRUE.
CALL RESOLVON(YCARIN,INDPLUS)
ENDIF
ENDIF
ENDIF
ELSE IF(INDMINUS /= 0)THEN
IF(INDPLUS /= 0)THEN
IF(INDMINUS < INDPLUS)THEN
LMINUS=.TRUE.
CALL RESOLVON(YCARIN,INDMINUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDMINUS
ELSE
LPLUS=.TRUE.
CALL RESOLVON(YCARIN,INDPLUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDPLUS
ENDIF
ELSE
LMINUS=.TRUE.
CALL RESOLVON(YCARIN,INDMINUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDMINUS
ENDIF
ELSE IF(INDPLUS /= 0)THEN
IF(INDMINUS /= 0)THEN
IF(INDPLUS < INDMINUS)THEN
LPLUS=.TRUE.
CALL RESOLVON(YCARIN,INDPLUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDPLUS
ELSE
LMINUS=.TRUE.
CALL RESOLVON(YCARIN,INDMINUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDMINUS
ENDIF
ELSE
LPLUS=.TRUE.
CALL RESOLVON(YCARIN,INDPLUS)
INBMIN=INBMIN+1
IIMIN(INBMIN,1)=INDPLUS
ENDIF
ELSE
! print *,' INDMINUS,PLUS,LMINUS,LPLUS ',INDMINUS,INDPLUS,LMINUS,LPLUS,NSUPERDIA
NSUPERDIA=NSUPERDIA+1
CARSUP(NSUPERDIA)(1:ILENC)=YCARIN(1:ILENC)
END IF
IF(ALLOCATED(LXYZT))THEN
DEALLOCATE(LXYZT)
ENDIF
ALLOCATE(LXYZT(NSUPERDIA))
LXYZT(:)=.FALSE.
IF(ALLOCATED(LUMVMPVT))THEN
DEALLOCATE(LUMVMPVT)
ENDIF
ALLOCATE(LUMVMPVT(NSUPERDIA))
LUMVMPVT(:)=.FALSE.
DO J=1,NSUPERDIA
IF(J > 1 .AND. NSUPERDIA > 1)THEN
IIMIN(:,J)=0
INBMIN=0
ENDIF
INDMIN=1.E9
YCARIN=ADJUSTL(CARSUP(J)(1:LEN_TRIM(CARSUP(J))))
IF(INDEX(YCARIN,'_FILE') /=0 .AND. NSUPERDIA >1)THEN
if(nverbia >0)then
print *,' CARESOLV AV EXTRACT YCARIN ',YCARIN
endif
CALL EXTRACT_AND_OPEN_FILES(YCARIN(1:LEN_TRIM(YCARIN)),YCAROUT)
ENDIF
NFILESCUR(J)=NUMFILECUR
IF (LPATCH) THEN
INDP = 0
ELSE
INDP = INDEX(YCARIN,'_P_')
ENDIF
INDT = INDEX(YCARIN,'_T_')
INDK = INDEX(YCARIN,'_K_')
INDZ = INDEX(YCARIN,'_Z_')
INDCV = INDEX(YCARIN,'_CV_')
INDPV = INDEX(YCARIN,'_PV_')
INDPVT = INDEX(YCARIN,'_PVT_')
INDPXT = INDEX(YCARIN,'_PXT_')
INDPYT = INDEX(YCARIN,'_PYT_')
INDPVKT = INDEX(YCARIN,'_PVKT_')
INDPH = INDEX(YCARIN,'_PH_')
INDFI = INDEX(YCARIN,'_FILE')
INDN = INDEX(YCARIN,'_N_')
INDFT = INDEX(YCARIN,'_FT_')
INDFT1 = INDEX(YCARIN,'_FT1_')
INDMASK = INDEX(YCARIN,'_MASK_')
INDMASKCUM = INDEX(YCARIN,'_MASKCUM_')
INDMASKSUM = INDEX(YCARIN,'_MASKSUM_')
INDTK = INDEX(YCARIN,'_TK_')
INDEV = INDEX(YCARIN,'_EV_')
INDPR = INDEX(YCARIN,'_PR_')
INDRS = INDEX(YCARIN,'_RS_')
INDRS1 = INDEX(YCARIN,'_RS1_')
INDPVKT1 = INDEX(YCARIN,'_PVKT1_')
INDZTPVKT1 = INDEX(YCARIN,'_ZTPVKT1_')
INDZT = INDEX(YCARIN,'_ZT_')
INDXT = INDEX(YCARIN,'_XT_')
INDYT = INDEX(YCARIN,'_YT_')
INDXY = INDEX(YCARIN,'_XY_')
INDXYZ = INDEX(YCARIN,'_XYZ_')
INDUMVMPV = INDEX(YCARIN,'_UMVM_')
IF(INDUMVMPV == 0)THEN
INDUMVMPV = INDEX(YCARIN,'_UTVT_')
ENDIF
INDLSPLO = INDEX(YCARIN,'_LSPLO_')
INDSPO = INDEX(YCARIN,'_SPO_')
INDOSPLO = INDEX(YCARIN,'_OSPLO_')
INDPHALO = INDEX(YCARIN,'_PHALO_')
INDPHAO = INDEX(YCARIN,'_PHAO_')
INDMSKTOP = INDEX(YCARIN,'_MSKTOP_')
INDSV3 = INDEX(YCARIN,'_SV3_')
! print *,'YCARIN'
! PRINT *,' INDP ',INDP
! print *,YCARIN
IF(INDCV /= 0)THEN
LCV = .TRUE.; LCH = .FALSE.
! CALL RESOLVCV
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDCV
NHISTORY(J)=NHISTORY(J)+1
END IF
IF(INDPV /= 0)THEN
LPV = .TRUE.; LCH = .FALSE.
! CALL RESOLVPV
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPV
END IF
IF(INDPVT /= 0)THEN
LPVT = .TRUE.; LCH = .FALSE.
! CALL RESOLVPVT
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPVT
END IF
IF(INDPXT /= 0)THEN
LPXT = .TRUE.; LCH = .FALSE.
! CALL RESOLVPXT
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPXT
END IF
IF(INDPYT /= 0)THEN
LPYT = .TRUE.; LCH = .FALSE.
! CALL RESOLVPYT
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPYT
END IF
IF(INDPH /= 0)THEN
LPH = .TRUE.; LCH = .FALSE.
! CALL RESOLVPH
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPH
END IF
IF(INDP /= 0)THEN
CALL RESOLVP(YCARIN(1:LEN_TRIM(YCARIN)),INDP,J)
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDP
ELSE
LPROCDIALL(J)=.TRUE.
END IF
IF(INDT /= 0)THEN
! print *, ' AV RESOLV T'
CALL RESOLVT(YCARIN(1:LEN_TRIM(YCARIN)),INDT,J)
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDT
! print *, ' AP RESOLVT '
ELSE
LTIMEDIALL(J,:)=.TRUE.
END IF
IF(INDK /= 0)THEN
CALL RESOLVK(YCARIN(1:LEN_TRIM(YCARIN)),INDK,J)
LCH=.TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDK
NHISTORY(J)=NHISTORY(J)+2
ELSE
IF(INDZ == 0 .AND. INDPR == 0 .AND. INDTK == 0 .AND. INDEV == 0 .AND. &
INDSV3 == 0)THEN
LVLKDIALL(J,:)=.TRUE.
! Ne surtout pas mettre LCH=.TRUE. ici; sinon pb avec LCV
ELSE
LVLKDIALL(J,:)=.FALSE.
ENDIF
END IF
IF(INDZ /= 0)THEN
CALL RESOLVZ(YCARIN(1:LEN_TRIM(YCARIN)),INDZ,J)
! LCH remis a .TRUE. volontairement pour resoudre _PXT_ et _PYT_ traites parfois
! avec les coupes verticales (cas d'1 PH enregistre comme tel) et parfois
! avec les coupes horizontales ( PH extrait d'une matrice 2D ou 3D)
! Idem pour les autres coupes horizontales
LCH=.TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDZ
NHISTORY(J)=NHISTORY(J)+2
END IF
IF(INDTK /= 0)THEN
! Artifice pour faire comme _Z_
INDTK=INDTK+1
CALL RESOLVZ(YCARIN(1:LEN_TRIM(YCARIN)),INDTK,J)
LCH=.TRUE.
INDTK=INDTK-1
LTK=.TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDTK
NHISTORY(J)=NHISTORY(J)+2
END IF
IF(INDEV /= 0)THEN
! Artifice pour faire comme _Z_
INDEV=INDEV+1
CALL RESOLVZ(YCARIN(1:LEN_TRIM(YCARIN)),INDEV,J)
LCH=.TRUE.
INDEV=INDEV-1
LEV=.TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDEV
NHISTORY(J)=NHISTORY(J)+2
END IF
IF(INDPR /= 0)THEN
! Artifice pour faire comme _Z_
INDPR=INDPR+1
CALL RESOLVZ(YCARIN(1:LEN_TRIM(YCARIN)),INDPR,J)
LCH=.TRUE.
INDPR=INDPR-1
LPR=.TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPR
NHISTORY(J)=NHISTORY(J)+2
END IF
IF(INDSV3 /= 0)THEN
! Artifice pour faire comme _Z_
INDSV3=INDSV3+2
CALL RESOLVZ(YCARIN(1:LEN_TRIM(YCARIN)),INDSV3,J)
LSV3=.TRUE.; LCH=.TRUE.
INDSV3=INDSV3-2
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDSV3
END IF
! print *,' ** caresolv AP INDZ... LVLKDIAll ',LVLKDIALL(J,1)
IF(INDRS /= 0)THEN
LRS=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDRS
IF(XIRS /= -999.)THEN
ELSE
IF(NIRS <= 0 .OR. NIRS > NIMAX+2*JPHEXT .OR. NJRS <= 0 .OR. &
NJRS >NJMAX+2*JPHEXT)THEN
print *,' INDICES HORIZONTAUX (NIRS,NJRS) DU PROFIL VERTICAL INCORRECTS',&
NIRS,NJRS
print *,' ENTREZ LEURS VALEURS AVANT DE DEMANDER 1 RS '
LPBREAD=.TRUE.
ENDIF
ENDIF
END IF
IF(INDRS1 /= 0)THEN
LRS1=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDRS1
IF(XIRS /= -999.)THEN
ELSE
IF(NIRS <= 0 .OR. NIRS > NIMAX+2*JPHEXT .OR. NJRS <= 0 .OR. &
NJRS >NJMAX+2*JPHEXT)THEN
print *,' INDICES HORIZONTAUX (NIRS,NJRS) DU PROFIL VERTICAL INCORRECTS',&
NIRS,NJRS
print *,' ENTREZ LEURS VALEURS AVANT DE DEMANDER 1 RS '
ENDIF
ENDIF
END IF
IF(INDFI /= 0)THEN
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDFI
END IF
IF(INDMASK /= 0)THEN
LCN=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDMASK
ENDIF
IF(INDMASKCUM /= 0)THEN
LCNCUM=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDMASKCUM
ENDIF
IF(INDMASKSUM /= 0)THEN
LCNSUM=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDMASKSUM
ENDIF
IF(INDN /= 0)THEN
CALL RESOLVN(YCARIN(1:LEN_TRIM(YCARIN)),INDN,J)
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDN
ELSE
LNDIALL(J)=.TRUE.
END IF
IF(INDFT /=0 )THEN
! IF(INDFT /=0 .AND. J==1)THEN
LFT=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDFT
ENDIF
IF(INDFT1 /=0 )THEN
! IF(INDFT1 /=0 .AND. J==1)THEN
LFT1=.TRUE.; LCH=.FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDFT1
ENDIF
IF(INDPVKT1 /= 0)THEN
LPVKT1 = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPVKT1
END IF
IF(INDPVKT /= 0)THEN
LPVKT = .TRUE.; LCH = .FALSE.
! CALL RESOLVPVT
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPVKT
END IF
IF(INDZTPVKT1 /= 0)THEN
LZTPVKT1 = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDZTPVKT1
END IF
IF(INDZT /= 0)THEN
LZT = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDZT
END IF
IF(INDMSKTOP /= 0)THEN
LMSKTOP = .TRUE.; LCH = .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDMSKTOP
END IF
IF(INDXYZ /= 0)THEN
LXYZT(J) = .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDXYZ
END IF
IF(INDUMVMPV /= 0)THEN
LUMVMPVT(J) = .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDUMVMPV
END IF
IF(INDXT /= 0)THEN
LXT = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDXT
END IF
IF(INDYT /= 0)THEN
LYT = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDYT
END IF
IF(INDXY /= 0)THEN
LXYDIA = .TRUE.; LCH = .FALSE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDXY
END IF
IF(INDLSPLO /= 0)THEN
LSPLO= .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDLSPLO
END IF
IF(INDSPO /= 0)THEN
LSPO= .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDSPO
END IF
IF(INDOSPLO /= 0)THEN
LOSPLO= .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDOSPLO
END IF
IF(INDPHALO /= 0)THEN
LPHALO= .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPHALO
END IF
IF(INDPHAO /= 0)THEN
LPHAO= .TRUE.
INBMIN=INBMIN+1
IIMIN(INBMIN,J)=INDPHAO
END IF
! IF(J <= 1)THEN
IF(INBMIN == 0)THEN
! Oct 99
NPARG=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),'(')
NPARD=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),')')
IF(NPARG /= 0 .AND. NPARD /= 0)THEN
! Juillet 2001
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(J)=2
ELSE
NMULTDIV(J)=1
ENDIF
IF(INDEXPR /= 0.)THEN
!!!!!!!!!!!!Nov 2001
CMULTDIV(J)=YCARIN(NPARG+1:NPARG+7)
YCARIN(NPARG:NPARD)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ELSE
! Juillet 2001
CFACT(J)=YCARIN(1:NPARD)
CFACT(J)=ADJUSTL(CFACT(J))
IETOILE=INDEX(YCARIN(NPARG:NPARD),'*')
ILOG =INDEX(YCARIN(NPARG:NPARD),'LOG')
IF(ILOG /=0) THEN
NOPE(J)=3
YCARIN(NPARG:NPARD)=' '
ELSE IF(IETOILE /= 0)THEN
READ(YCARIN(IETOILE+NPARG:NPARD-1),*)XCONSTANTE(J)
! print *,' **Caresolv IETOILE+1+NPARG ',IETOILE+1+NPARG
NOPE(J)=2
YCARIN(NPARG:NPARD)=' '
ELSE
READ(YCARIN(NPARG+1:NPARD-1),*)XCONSTANTE(J)
NOPE(J)=1
YCARIN(NPARG:NPARD)=' '
ENDIF
! Juillet 2001
IF(NPARD < LEN_TRIM(YCARIN))THEN
ILEN=LEN_TRIM(YCARIN)
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(J)=2
ELSE
NMULTDIV(J)=1
ENDIF
IF(INDEXPR /= 0.)THEN
CMULTDIV(J)=YCARIN(NPARD+2:NPARD+8)
YCARIN(NPARG:NPARD+10)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ENDIF
ELSE
! Juillet 2001
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ENDIF
! Juillet 2001
ENDIF
ENDIF
! Juillet 2001
! Oct 99
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
! CGROUP=ADJUSTL(YCARIN)
CGROUP=ADJUSTL(CGROUP)
IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZS')THEN
CGROUP(1:LEN_TRIM(CGROUP))=' '
CGROUP='ZSBIS'
ENDIF
CGROUPS(J)(1:LEN(CGROUPS(J))) = ' '
CGROUPS(J)=ADJUSTL(CGROUP)
ELSE
DO JJ=1,INBMIN
INDMIN=MIN(IIMIN(JJ,J),INDMIN)
ENDDO
IF(INDMIN >1)THEN
! Oct 99
NPARG=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),'(')
NPARD=INDEX(YCARIN(1:LEN_TRIM(YCARIN)),')')
IF(NPARG /= 0 .AND. NPARD /= 0)THEN
! Juillet 2001
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARG:NPARD),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(J)=2
ELSE
NMULTDIV(J)=1
ENDIF
IF(INDEXPR /= 0.)THEN
!!!!!!!Nov 2001
CMULTDIV(J)=YCARIN(NPARG+1:NPARG+7)
YCARIN(NPARG:NPARD)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ELSE
! Juillet 2001
CFACT(J)=YCARIN(1:NPARD)
CFACT(J)=ADJUSTL(CFACT(J))
IETOILE=INDEX(YCARIN(NPARG:NPARD),'*')
ILOG =INDEX(YCARIN(NPARG:NPARD),'LOG')
IF(ILOG /=0) THEN
NOPE(J)=3
YCARIN(NPARG:NPARD)=' '
ELSE IF(IETOILE /= 0)THEN
READ(YCARIN(IETOILE+NPARG:NPARD-1),*)XCONSTANTE(J)
! print *,' **Caresolv IETOILE+1+NPARG ',IETOILE+1+NPARG
NOPE(J)=2
YCARIN(NPARG:NPARD)=' '
ELSE
READ(YCARIN(NPARG+1:NPARD-1),*)XCONSTANTE(J)
NOPE(J)=1
YCARIN(NPARG:NPARD)=' '
ENDIF
! Juillet 2001
IF(NPARD < LEN_TRIM(YCARIN))THEN
ILEN=LEN_TRIM(YCARIN)
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'*EXPR')
IF(INDEXPR == 0.)THEN
INDEXPR=INDEX(YCARIN(NPARD+1:ILEN),'/EXPR')
IF(INDEXPR /= 0.)NMULTDIV(J)=2
ELSE
NMULTDIV(J)=1
ENDIF
IF(INDEXPR /= 0.)THEN
CMULTDIV(J)=YCARIN(NPARD+2:NPARD+8)
YCARIN(NPARG:NPARD+10)=' '
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ENDIF
ELSE
! Juillet 2001
CGROUP = YCARIN(1:LEN_TRIM(YCARIN))
ENDIF
! Juillet 2001
ENDIF
ENDIF
! Juillet 2001
CGROUP=ADJUSTL(YCARIN(1:INDMIN-1))
! print *,' CARESOLV HGRP ',CGROUP
CGROUP=ADJUSTL(CGROUP)
IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZS')THEN
CGROUP(1:LEN_TRIM(CGROUP))=' '
CGROUP='ZSBIS'
ENDIF
CGROUPS(J)(1:LEN(CGROUPS(J))) = ' '
CGROUPS(J)=ADJUSTL(CGROUP)
ENDIF
ENDIF
! END IF
ENDDO
CALL CARMEMORY(YCARIN,3)
END IF
!
!-----------------------------------------------------------------------------
!
!* 2. EXITS
! -----
!
IF(NVERBIA >0)THEN
PRINT *,' ** sortie CARESOLV'
print *,' LPRESY,XHMIN,XHMAX ',LPRESY,XHMIN,XHMAX
PRINT *,' LPR,LTK,LEV,LSV3 ',LPR,LTK,LEV,LSV3
PRINT *,' NSUPERDIA,NSUPER ',NSUPERDIA,NSUPER
print *,' CVARNPV1 FIN caresolv ',CVARNPV1
ENDIF
! Septembre 2000
#ifdef RHODES
CALL FLUSH(NDIR,ISTAF)
#else
CALL FLUSH(NDIR)
#endif
RETURN
END SUBROUTINE CARESOLV
LIBTOOLS/tools/diachro/src/DIAPRO/carint.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_CARINT
! ##################
!
INTERFACE
!
SUBROUTINE CARINT(HCAR,KOUT)
CHARACTER(LEN=*) :: HCAR
INTEGER :: KOUT
END SUBROUTINE CARINT
!
END INTERFACE
!
END MODULE MODI_CARINT
! ######spl
SUBROUTINE CARINT(HCAR,KOUT)
! ############################
!
!!**** *CARINT* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 24/11/95
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_RESOLVCAR
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
CHARACTER(LEN=*) :: HCAR
INTEGER :: KOUT
!
!* 0.1 Local variables
! ---------------
!
CHARACTER(LEN=LEN(HCAR)) :: YCAR
!------------------------------------------------------------------------------
!
YCAR=HCAR
READ(YCAR,*)KOUT
!* 2. EXITS
! -----
!
RETURN
END SUBROUTINE CARINT
LIBTOOLS/tools/diachro/src/DIAPRO/carmemory.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_CARMEMORY
! #####################
!
INTERFACE
!
SUBROUTINE CARMEMORY(HCARIN,KOP)
CHARACTER(LEN=*),INTENT(INOUT) :: HCARIN
!CHARACTER(LEN=2400),INTENT(INOUT) :: HCARIN
INTEGER :: KOP
END SUBROUTINE CARMEMORY
!
END INTERFACE
!
END MODULE MODI_CARMEMORY
! ######spl
SUBROUTINE CARMEMORY(HCARIN,KOP)
! ################################
!
!!**** *CARMEMORY* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 24/11/95
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_RESOLVCAR
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
!
!CHARACTER(LEN=2400),INTENT(INOUT) :: HCARIN
CHARACTER(LEN=*),INTENT(INOUT) :: HCARIN
INTEGER :: KOP
!
!* 0.1 Local variables
! ---------------
!
CHARACTER(LEN=2400),SAVE :: YCAR
INTEGER,SAVE :: ILENC, ILENGP1
!------------------------------------------------------------------------------
!
IF(KOP == 1)THEN
!fuji HCARIN=ADJUSTL(HCARIN) !introduit des caracteres genre {W?
HCARIN=TRIM(HCARIN)
YCAR(1:LEN(YCAR))=' '
YCAR=ADJUSTL(HCARIN)
ILENC = LEN(YCAR)
if (nverbia > 0)then
!print *, ' *** CARMEMORY 1 ILENC YCAR ',ILENC,YCAR(1:80)
print *, ' *** CARMEMORY 1 ILENC YCAR ',ILENC,YCAR(1:LEN_TRIM(YCAR))
endif
ELSE IF(KOP == 2)THEN
HCARIN(1:LEN(HCARIN))=' '
HCARIN=ADJUSTL(YCAR(ILENGP1+1:LEN_TRIM(YCAR)))
HCARIN=ADJUSTL(HCARIN)
ELSE IF(KOP == 3)THEN
CGROUPS(1)=ADJUSTL(CGROUPS(1))
ILENGP1=LEN_TRIM(CGROUPS(1))
ENDIF
!* 2. EXITS
! -----
!
RETURN
END SUBROUTINE CARMEMORY
LIBTOOLS/tools/diachro/src/DIAPRO/closf.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_CLOSF
! ##################
!
INTERFACE
!
SUBROUTINE CLOSF(KLOOPT,KTIMEND,KSEGD,KSEGM,K)
INTEGER,INTENT(IN) :: KLOOPT,KTIMEND,KSEGD,KSEGM,K
END SUBROUTINE CLOSF
!
END INTERFACE
!
END MODULE MODI_CLOSF
! ######spl
SUBROUTINE CLOSF(KLOOPT,KTIMEND,KSEGD,KSEGM,K)
! ##############################################
!
!!**** *CLOSF* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!! Module
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 24/11/95
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_RESOLVCAR
USE MODD_MEMCV
USE MODD_NMGRID
USE MODD_COORD
USE MODD_DEFCV
USE MODD_CONF
USE MODD_CTL_AXES_AND_STYL
USE MODN_NCAR
USE MODN_PARA
USE MODD_ALLOC_FORDIACHRO
USE MODD_TIME
USE MODD_TIME1
USE MODD_GRID1
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODE_GRIDPROJ
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
INTEGER,INTENT(IN) :: KLOOPT,KTIMEND,KSEGD,KSEGM,K
!
!* 0.1 Local variables
! ---------------
!
INTEGER :: JJ, IER, INB, IWK, I, IA, ID, J
INTEGER :: IP, IN, IT, IZ, IPV=0
INTEGER :: KLEN, JI, JIM, ICOLI
INTEGER :: INUM, IRESP, ISEGM, ICOLSEGM
INTEGER :: II, IJ
INTEGER,SAVE :: INBTRACECV=0, INBTOT, ICO
LOGICAL,SAVE :: GGEOG, GVPTUSER
REAL :: ZVPTL, ZVPTR, ZVPTB, ZVPTT
REAL :: ZZZXD, ZZZXF, ZZZYD, ZZZYF
REAL :: ZVL, ZVR, ZVB, ZVT, ZWL, ZWR, ZWB, ZWT
REAL :: PHA, ZAX, ZAY, ZAU, ZAV
REAL :: ZWIDTH, ZLAT, ZLON
REAL,DIMENSION(100) :: ZX, ZY
CHARACTER(LEN=25) :: CAR1, CAR2, CAR
CHARACTER(LEN=80) :: YTEM
!
!------------------------------------------------------------------------------
!IF(LANIMT)THEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! CALL GFLAS2
! IF(KLOOPT == KTIMEND)THEN
! DO JJ=KSEGD,KSEGM
! CALL GFLAS3(JJ)
! ENDDO
! CALL GCLWK(9)
! CALL NGPICT(1,1)
! !!!!!!!!!!!!
! CALL GQACWK(1,IER,INB,IWK)
! IF(INB > 1)CALL NGPICT(2,3)
! ENDIF
!ELSE IF(LPXT .OR. LPYT)THEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(LPXT .OR. LPYT)THEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ELSE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF(LANIMK)THEN !!LANIMK
CALL GFLAS2
IF(NBLVLKDIA(K,1) == 0)THEN
! Alt Niv. PR ou TK ...
IF(.NOT.LZINCRDIA(K))THEN
! Pas incremental
IF(XLOOPZ == XLVLZDIA(NBLVLZDIA(K),K))THEN
DO JJ=KSEGD,KSEGM
CALL GFLAS3(JJ)
ENDDO
CALL GCLWK(9)
CALL NGPICT(1,1)
!!!!!!!!!!!!
CALL GQACWK(1,IER,INB,IWK)
IF(INB > 1)CALL NGPICT(2,3)
ENDIF
ELSE
! Incremental
IF(XLOOPZ == XLVLZDIA(2,K))THEN
DO JJ=KSEGD,KSEGM
CALL GFLAS3(JJ)
ENDDO
CALL GCLWK(9)
CALL NGPICT(1,1)
!!!!!!!!!!!!
CALL GQACWK(1,IER,INB,IWK)
IF(INB > 1)CALL NGPICT(2,3)
ENDIF
ENDIF
ELSE
! Niveaux K
IF(NLOOPK == NBLVLKDIA(K,1))THEN
DO JJ=KSEGD,KSEGM
CALL GFLAS3(JJ)
ENDDO
CALL GCLWK(9)
CALL NGPICT(1,1)
!!!!!!!!!!!!
CALL GQACWK(1,IER,INB,IWK)
IF(INB > 1)CALL NGPICT(2,3)
ENDIF
ENDIF
ELSE !!LANIMK
IF(K == NSUPERDIA)THEN !+++++++++++++++++++++++++++++++++
! Trace du domaine fils eventuellement
IF(LDOMAIN .AND. (LCH .OR. LCHXY ) .AND. .NOT.LCV)THEN
ZZZXD=XXX(NDOMAINL,NMGRID)
ZZZXF=XXX(NDOMAINR,NMGRID)
ZZZYD=XXY(NDOMAINB,NMGRID)
ZZZYF=XXY(NDOMAINT,NMGRID)
CALL GSLWSC(XLWDOMAIN)
CALL FRSTPT(ZZZXD,ZZZYD)
CALL VECTOR(ZZZXF,ZZZYD)
CALL VECTOR(ZZZXF,ZZZYF)
CALL VECTOR(ZZZXD,ZZZYF)
CALL VECTOR(ZZZXD,ZZZYD)
ENDIF
! Trace de segments eventuellement
IF(LSEGM .AND. (LCH .OR. LCHXY) .AND. .NOT.LCV)THEN
CALL GQPLCI(IER,ICOLI)
DO J=1,NCOLSEGM
!IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE .AND. NCOLSEGMS(J) > 1)THEN
IF(NCOLSEGMS(J) > 1)THEN
CALL TABCOL_FORDIACHRO
print *,' appel a TABCOL_FORDIACHRO pour le trace de polylines couleur'
EXIT
ENDIF
ENDDO
CALL GSLWSC(XLWSEGM)
ISEGM=0
DO J=1,SIZE(NSEGMS,1)
! Conversion en coordonnees conformes
ZLAT=XSEGMS(J,1)
ZLON=XSEGMS(J,2)
IF (NSEGMS(J)==1) THEN ! XSEGMS
IF (XCONFSEGMS(J,1)==0. .AND. XCONFSEGMS(J,2)==0.) &
CALL SM_XYHAT_S(XLATORI,XLONORI, &
ZLAT,ZLON, &
XCONFSEGMS(J,1),XCONFSEGMS(J,2))
ELSE IF (NSEGMS(J)==-1) THEN ! ISEGMS
NSEGMS(J)=1
II=MAX(MIN(INT(ZLAT),NIMAX+2*JPHEXT-1),1)
IJ=MAX(MIN(INT(ZLON),NJMAX+2*JPHEXT-1),1)
XCONFSEGMS(J,1)=XXX(II,NMGRID) + &
(ZLAT-FLOAT(II))*(XXX(II+1,NMGRID) - XXX(II,NMGRID) )
XCONFSEGMS(J,2)=XXY(IJ,NMGRID) + &
(ZLON-FLOAT(IJ))*(XXY(IJ+1,NMGRID) - XXY(IJ,NMGRID) )
END IF
IF(J == 1 .AND. NSEGMS(J) == 1)THEN
! IF((J == 1 .AND. NSEGMS(J) == 1) .OR. &
! (J >1 .AND. NSEGMS(J) == 1 .AND. &
! NSEGMS(J-1) == 0))THEN
! IF(J > 1)CALL SFLUSH
ISEGM=ISEGM+1
ICOLSEGM=NCOLSEGMS(ISEGM)
IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
print *,' Avec LCOLAREA=T ou LCOLINE=T , attention a la superposition des couleurs'
print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
!print *,' valeur trouvee: ',NCOLSEGMS(ISEGM),'FORCEE a 1 '
!ICOLSEGM=1
ENDIF
CALL GSPLCI(ICOLSEGM)
CALL GSTXCI(ICOLSEGM)
CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
! ELSE IF(J > 1 .AND. NSEGMS(J) == 1 .AND. &
ELSE IF(J > 1 .AND. NSEGMS(J) == 1 )THEN
IF(NSEGMS(J-1)== 1)THEN
CALL VECTOR(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
ELSE
CALL SFLUSH
ISEGM=ISEGM+1
ICOLSEGM=NCOLSEGMS(ISEGM)
IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
print *,' Avec LCOLAREA=T ou LCOLINE=T , attention a la superposition des couleurs'
print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
!print *,' valeur trouvee: ',NCOLSEGMS(ISEGM),'FORCEE a 1 '
!ICOLSEGM=1
ENDIF
CALL GSPLCI(ICOLSEGM)
CALL GSTXCI(ICOLSEGM)
CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
ENDIF
ENDIF
ENDDO
CALL SFLUSH
CALL GSPLCI(ICOLI)
CALL GSTXCI(1)
ENDIF
! Trace de la CV dans CH suivante(s) eventuellement
IF(LTRACECV .AND. (LCH .OR. LCHXY) .AND. .NOT.LCV)THEN
CALL GQLWSC(IER,ZWIDTH)
CALL GSLWSC(XLWTRACECV)
CALL GSMKSC(2.)
ICOLSEGM=1
CALL GSPLCI(ICOLSEGM)
CALL GSTXCI(ICOLSEGM)
DO J=1,SIZE(NSEGMS,1)-1
IF(NSEGMS(J) == 2 .AND. NSEGMS(J+1) ==2)THEN
print *,'closf J=',J
CALL GSMK(4)
CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
CALL GSMK(5)
CALL GPM(1,XCONFSEGMS(J+1,1),XCONFSEGMS(J+1,2))
CALL CURVED(XCONFSEGMS(J:J+1,1),XCONFSEGMS(J:J+1,2),2)
ENDIF
ENDDO
CALL SFLUSH
CALL GSLWSC(ZWIDTH)
CALL GSTXCI(1)
ENDIF
! Fermeture du dessin ds les cas =/= PH UMVM
IF(LCH .AND. LCV .AND. (LUMVM .OR. LUTVT))THEN
IF(nverbia > 0)then
print *,' ***closf NLMAX ',NLMAX
print *,' XTEMCVU ',XTEMCVU
print *,' XTEMCVV ',XTEMCVV
endif
ELSE
IF(LANIMT)THEN
CALL GFLAS2
IF(KLOOPT == KTIMEND)THEN
DO JJ=KSEGD,KSEGM
CALL GFLAS3(JJ)
ENDDO
CALL GCLWK(9)
CALL NGPICT(1,1)
!!!!!!!!!!!!
CALL GQACWK(1,IER,INB,IWK)
IF(INB > 1)CALL NGPICT(2,3)
ENDIF
ELSE
CALL NGPICT(1,1)
CALL GQACWK(1,IER,INB,IWK)
IF(INB > 1)CALL NGPICT(2,3)
if(nverbia == -10)then
print *,' CCCCCLOSF FRAME'
endif
ENDIF
ENDIF
! Fermeture du dessin ds les cas =/= PH UV
IF(LTRACECV .AND. LCV .AND..NOT.L1DT)THEN !.............................
INBTRACECV=INBTRACECV+1
IF(LPV)THEN
IPV=IPV+1
ZX(IPV)=XDSX(NPROFILE,NMGRID)
ZY(IPV)=XDSY(NPROFILE,NMGRID)
ENDIF
IF(NVERBIA == 10)THEN
print *,' closf INBTRACECV ',INBTRACECV
ENDIF
IF(INBTRACECV == 1)THEN !0000000000000000000000000000000
IP=NBPROCDIA(NLOOPSUPER)
IN=NBNDIA(NLOOPSUPER)
IF(.NOT.LTINCRDIA(NLOOPSUPER,1))THEN
IT=NBTIMEDIA(NLOOPSUPER,1)
ELSE
IT=(NTIMEDIA(2,NLOOPSUPER,1)-NTIMEDIA(1,NLOOPSUPER,1))&
/NTIMEDIA(3,NLOOPSUPER,1)+1
ENDIF
! IF(LVLKDIALL(NLOOPSUPER,1))THEN
! NBLVLKDIA(NLOOPSUPER,1)=0
! print *,' **closf LTRACECV=T LCV=T LCH=T NBLVLKDIA(NLOOPSUPER,1) remis a 0 pour eliminer LVLKDIALL=T'
! ENDIF
IF(.NOT.LCH)THEN
! print *,' **closf LCH CDIRCUR ',LCH,CDIRCUR(1:LEN_TRIM(CDIRCUR))
IZ=1
ELSE
IF(NBLVLKDIA(NLOOPSUPER,1) /= 0)THEN
IZ=NBLVLKDIA(NLOOPSUPER,1)
ELSE
IF(.NOT.LZINCRDIA(NLOOPSUPER))THEN
IZ=NBLVLZDIA(NLOOPSUPER)
ELSE
IZ=(XLVLZDIA(2,NLOOPSUPER)-XLVLZDIA(1,NLOOPSUPER))&
/XLVLZDIA(3,NLOOPSUPER)+1
ENDIF
ENDIF
ENDIF
INBTOT=IP*IN*IT*IZ
IF(NVERBIA == 10)THEN
print *,' closf INBTOT,IP,IN,IT,IZ ',INBTOT,IP,IN,IT,IZ
ENDIF
ENDIF !0000000000000000000000000000000
IF(INBTRACECV == INBTOT)THEN
IF(LVPTUSER)THEN
GVPTUSER=.TRUE.
ZVPTL=XVPTL; ZVPTR=XVPTR; ZVPTB=XVPTB; ZVPTT=XVPTT
ELSE
GVPTUSER=.FALSE.
LVPTUSER=.TRUE.
ZVPTL=XVPTL; ZVPTR=XVPTR; ZVPTB=XVPTB; ZVPTT=XVPTT
XVPTL=.10; XVPTR=.90; XVPTB=.10; XVPTT=.90
ENDIF
IF(LCARTESIAN)THEN
CALL DEFENETRE
ELSE
IF(LGEOG)THEN
GGEOG=.TRUE.
ELSE
GGEOG=.FALSE.
ENDIF
! LGEOG=.TRUE.
! XVPTL=.12; XVPTR=.88; XVPTB=.12; XVPTT=.88
CALL BCGRD_FORDIACHRO(1)
CALL BCGRD_FORDIACHRO(2)
ENDIF
CALL GSLWSC(XLWTRACECV)
CALL GSMKSC(2.)
DO I =1,NTRACECV
CALL GSMK(4)
CALL GPM(1,XTRACECV(1,I),XYTRACECV(1,I))
CALL GSMK(5)
CALL GPM(1,XTRACECV(2,I),XYTRACECV(2,I))
! CALL FRSTPT(XTRACECV(1,I),XYTRACECV(1,I))
! CALL VECTOR(XTRACECV(2,I),XYTRACECV(2,I))
CALL CURVED(XTRACECV(1:2,I),XYTRACECV(1:2,I),2)
IF(IPV /= 0)THEN
DO IA=1,IPV
CALL GSMKSC(1.)
CALL GSMK(5)
CALL GPM(1,ZX(IA),ZY(IA))
ENDDO
IPV=0
ENDIF
ENDDO
! Janv 2001
CALL GSMKSC(1.)
! Janv 2001
CAR(1:LEN(CAR))=' '
CAR1(1:LEN(CAR1))=' '
CAR2(1:LEN(CAR2))=' '
IF(LDEFCV2CC)THEN
IF(LDEFCV2LL)THEN
WRITE(CAR,'(''Latitude,Longitude :'')')
WRITE(CAR1,'(''('',F6.2,'','',F6.2,'')'')')XIDEBCVLL,XJDEBCVLL
WRITE(CAR2,'(''('',F6.2,'','',F6.2,'')'')')XIFINCVLL,XJFINCVLL
ELSE IF(LDEFCV2IND)THEN
WRITE(CAR,'(''Indices de grille I,J : '')')
WRITE(CAR1,'(''('',I4,'','',I4,'')'')')NIDEBCV,NJDEBCV
WRITE(CAR2,'(''('',I4,'','',I4,'')'')')NIFINCV,NJFINCV
ELSE IF(LDEFCV2)THEN
WRITE(CAR,'(''Coordonnees conformes : '')')
WRITE(CAR1,'(''('',F10.2,'','',F10.2,'')'')')XTRACECV(1,1),XYTRACECV(1,1)
WRITE(CAR2,'(''('',F10.2,'','',F10.2,'')'')')XTRACECV(2,1),XYTRACECV(2,1)
ENDIF
ELSE
IF(XIDEBCOU == -999.)THEN
WRITE(CAR,'(''Indices de grille I,J : '')')
WRITE(CAR1,'(''('',I4,'','',I4,'')'')')NIDEBCOU,NJDEBCOU
WRITE(CAR2,'(''(NLMAX='',I4,'',ANG='',I3,'')'')')NLMAX,NLANGLE
ELSE
WRITE(CAR,'(''Coordonnees conformes : '')')
WRITE(CAR1,'(''('',F10.2,'','',F10.2,'')'')')XIDEBCOU,NJDEBCOU
WRITE(CAR2,'(''(NLMAX='',I4,'',ANG='',I3,'')'')')NLMAX,NLANGLE
ENDIF
ENDIF
CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
XCURVPTL=ZVL;XCURVPTR=ZVR;XCURVPTB=ZVB;XCURVPTT=ZVT
!
! Traitement des PH UMVM ou UTVT . Condition
! LTRACECV=T _CV__K_ (ou Z etc...) UMVM ou UTVT
IF(LCH .AND. LCV .AND. (LUMVM .OR. LUTVT))THEN
CALL ECHELLEPH(KLEN,PHA)
CALL GQLWSC(IER,ZWIDTH)
IF(XLWV > 0.)THEN
CALL GSLWSC(XLWV)
ENDIF
JIM=0
IF(LCOLINE)THEN
print *,' PH couleur fleches ? 1=noir 2=rouge 3=vert 4=bleu ... '
read(5,*,ERR=10)ICO
CALL GSPLCI(ICO)
GO TO 20
10 CONTINUE
BACKSPACE 5
print *,' Mai 2000 PH vecteurs vent horizontal. Si LCOLINE=T, possibilite '
print *,' de mettre les fleches en couleur en fournissant un indice apres la requete '
print *,' En cas d''absence, elles restent en noir '
20 CONTINUE
ENDIF
DO JI=1,SIZE(XTEMCVU,1),NISKIP
JIM=JIM+1
ZAX=XDSX(JI,1)
ZAY=XDSY(JI,1)
ZAU=XTEMCVU(JI,1)
ZAV=XTEMCVV(JI,1)
CALL FLECHE(ZAX,ZAY,ZAU,ZAV,KLEN,PHA)
ENDDO
CALL SFLUSH
CALL GSLWSC(ZWIDTH)
CALL GSPLCI(1)
CALL GSTXCI(1)
if(nverbia > 0)then
print *,' ***closf JIM ',JIM,' NISKIP,SIZE(XTEMCVU,1) ',NISKIP,SIZE(XTEMCVU,1)
endif
IF(LPRINT)THEN
CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
IF(IRESP /= 0)THEN
CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
ENDIF
WRITE(INUM,'(''CLOSF '',''G:'',A16,4X,'' NBVAL:'',I5,'' NLMAX:'',I5,'' NISKIP:'',I5)')CGROUP,JIM,NLMAX,NISKIP
WRITE(INUM,'(A70)')CDIRCUR
IF(LDEFCV2CC)THEN
IF(LDEFCV2)THEN
WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'')')&
&XIDEBCV,XJDEBCV,XIFINCV,XJFINCV
ELSE IF(LDEFCV2LL)THEN
WRITE(INUM,'(''ll(deb)-(fin)=('',F8.4,'','',F8.4,'')-('',F8.4,'','',F8.4,'')'')')&
&XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL
ELSE IF(LDEFCV2IND)THEN
WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'')')&
&NIDEBCV,NJDEBCV,NIFINCV,NJFINCV
ENDIF
ELSE
IF(XIDEBCOU /= -999.)THEN
WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4)')&
&XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE
ELSE
WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4)')&
&NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE
ENDIF
ENDIF
! JUin 2001 Ecriture des dates (Demande G.Jaubert ) si LPRDAT=T
IF(LPRDAT)THEN
IF(.NOT.ALLOCATED(XPRDAT))THEN
print *,'**CLOSF XPRDAT NON ALLOUE.Dates non ecrites ds FICVAL .Prevenir J.Duron'
ELSE
WRITE(INUM,'(1X,75(1H*))')
WRITE(INUM,'(1X,'' Dates courante * modele * experience * segment'')')
WRITE(INUM,'(1X,'' J An M J Sec. * An M J Sec. * An M J Sec. * An M J Sec.'')')
WRITE(INUM,'(1X,75(1H*))')
DO J=1,SIZE(XPRDAT,2)
WRITE(INUM,'(1X,I3,1X,3(I4,I3,I3,I6,'' *''),I4,I3,I3,I6)')J,INT(XPRDAT(:,J))
ENDDO
ENDIF
ENDIF
! JUin 2001 Ecriture des dates
WRITE(INUM,'(1X,78(1H*))')
WRITE(INUM,'(15X,''U'',17X,''V'',17X,''X'',17X,''Y'')')
! WRITE(INUM,'(16X,''X'',19X,''Y'')')
WRITE(INUM,'(1X,78(1H*))')
JIM=0
DO JI=1,SIZE(XTEMCVU,1),NISKIP
JIM=JIM+1
ZAX=XDSX(JI,1)
ZAY=XDSY(JI,1)
ZAU=XTEMCVU(JI,1)
ZAV=XTEMCVV(JI,1)
WRITE(INUM,'(I5,4(2X,E15.8))')JIM,ZAU,ZAV,ZAX,ZAY
ENDDO
WRITE(INUM,'(1X,78(1H*))')
ENDIF
DEALLOCATE(XTEMCVU,XTEMCVV)
ENDIF
CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
CALL GSLWSC(2.)
IF(LDATFILE)CALL DATFILE_FORDIACHRO
YTEM(1:LEN(YTEM))=' '
CALL GSLWSC(2.)
CALL GSTXFP(-13,0)
CALL RESOLV_TIT('CTITT1',YTEM)
IF(YTEM /= ' ')THEN
CALL PLCHHQ(.001,.98,YTEM(1:LEN_TRIM(YTEM)),.012,0.,-1.)
ELSE
CALL PLCHHQ(.001,.98,CDIRCUR(1:LEN_TRIM(CDIRCUR)),.012,0.,-1.)
ENDIF
CALL GSTXFP(-13,2)
CALL GSLWSC(2.)
YTEM(1:LEN(YTEM))=' '
CALL RESOLV_TIT('CTITT2',YTEM)
IF(YTEM /= ' ')THEN
CALL PLCHHQ(.001,.95,YTEM(1:LEN_TRIM(YTEM)),.009,0.,-1.)
ENDIF
YTEM(1:LEN(YTEM))=' '
CALL RESOLV_TIT('CTITT3',YTEM)
IF(YTEM /= ' ')THEN
CALL PLCHHQ(.001,.93,YTEM(1:LEN_TRIM(YTEM)),.009,0.,-1.)
ENDIF
YTEM(1:LEN(YTEM))=' '
CALL RESOLV_TIT('CTITB1',YTEM)
IF(YTEM /= ' ')THEN
CALL PLCHHQ(.001,.001,YTEM(1:LEN_TRIM(YTEM)),.009,0.,-1.)
ENDIF
CALL PLCHHQ(.001,.04,CAR(1:LEN_TRIM(CAR)),.012,0.,-1.)
CALL GSMK(4)
CALL GPM(1,.35,.04)
CALL PLCHHQ(.401,.04,CAR1(1:LEN_TRIM(CAR)),.012,0.,-1.)
CALL GSMK(5)
CALL GPM(1,.70,.04)
IF(LDEFCV2CC)THEN
CALL PLCHHQ(.751,.04,CAR2(1:LEN_TRIM(CAR)),.012,0.,-1.)
ELSE
CALL PLCHHQ(.721,.04,CAR2(1:LEN_TRIM(CAR)),.012,0.,-1.)
ENDIF
CALL FRAME
CALL GSLWSC(1.)
INBTRACECV=0
NTRACECV=0
IF(GVPTUSER)THEN
LVPTUSER=.TRUE.
XVPTL=ZVPTL; XVPTR=ZVPTR; XVPTB=ZVPTB; XVPTT=ZVPTT
ELSE
LVPTUSER=.FALSE.
XVPTL=ZVPTL; XVPTR=ZVPTR; XVPTB=ZVPTB; XVPTT=ZVPTT
ENDIF
IF(LCARTESIAN)THEN
ELSE
IF(GGEOG)THEN
LGEOG=.TRUE.
ELSE
LGEOG=.FALSE.
ENDIF
ENDIF
! IF(LCARTESIAN)THEN
! CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
! ENDIF
ENDIF !000000000000000000000000000000000000000
ELSE !..........................................
INBTRACECV=0
NTRACECV=0
ENDIF !..........................................
ENDIF !++++++++++++++++++++++++++++++++++++++++++
ENDIF !!LANIMK
ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
RETURN
END SUBROUTINE CLOSF
LIBTOOLS/tools/diachro/src/DIAPRO/color_fordiachro.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE COLOR_FORDIACHRO(KN,KTYPE)
! ###############################
!
!!**** *COLOR_FORDIACHRO* - Definition d'une table de couleurs en RGB
!!
!! PURPOSE
!! -------
!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!!
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 16/01/95
!! Updated PM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_RESOLVCAR
IMPLICIT NONE
!
!* 0.1 dummy arguments
!
INTEGER :: KN
INTEGER :: KTYPE ! (1=color; 2=grey)
!
!* 0.2 local variables
!
REAL :: ZHUE, ZHUES, ZL, ZLS
REAL :: ZRED, ZGREEN, ZBLUE
INTEGER :: J, JJ
INTEGER :: ICNT, ISTA, IER, INB, IWK
INTEGER :: INBB
!
!-------------------------------------------------------------------------------
CALL GQOPS(ISTA)
CALL GQACWK(1,IER,INB,IWK)
CALL GQOPWK(1,IER,INB,IWK)
IF(KN <= 0)RETURN
!
IF(LINVWB)THEN
CALL GSCR(IWK,0,1.,1.,1.) ! BACKGROUND COLOR (black)
CALL GSCR(IWK,1,0.,0.,0.) ! First foreground color is white
ELSE
CALL GSCR(IWK,0,0.,0.,0.) ! BACKGROUND COLOR (black)
CALL GSCR(IWK,1,1.,1.,1.) ! First foreground color is white
ENDIF
!
DO JJ=1,INB
CALL GQOPWK(JJ,IER,INBB,IWK)
IF(IWK == 9)THEN
CYCLE
ELSE
CALL GSCR(IWK,2,.75,.75,.75) ! Second foreground color is gray
ENDIF
ENDDO
!
! Choose other foreground colors spaced equally around the spectrum
ICNT=0
ZHUES=360./KN
ZLS=100./KN
DO J=1,KN
ZHUE=J*ZHUES
ZL=J*ZLS
IF(KTYPE==1) THEN
!full colors
CALL HLSRGB(ZHUE,50.,100.,ZRED,ZGREEN,ZBLUE)
! CALL HLSRGB(ZHUE,55.,95.,ZRED,ZGREEN,ZBLUE)
! CALL HLSRGB(ZHUE,60.,75.,ZRED,ZGREEN,ZBLUE)
IF(ZHUE.LE.36.)THEN
DO JJ=1,INB
CALL GQOPWK(JJ,IER,INBB,IWK)
IF(IWK == 9)THEN
CYCLE
ELSE
CALL GSCR(IWK,KN+3-J,ZRED,ZGREEN,ZBLUE)
ENDIF
ENDDO
ICNT=ICNT+1
ELSE
DO JJ=1,INB
CALL GQOPWK(JJ,IER,INBB,IWK)
IF(IWK == 9)THEN
CYCLE
ELSE
CALL GSCR(IWK,J-ICNT+2,ZRED,ZGREEN,ZBLUE)
ENDIF
ENDDO
END IF
ELSE IF(KTYPE==2) THEN
!greys (S=0.)
CALL HLSRGB(ZHUE,ZL,0.,ZRED,ZGREEN,ZBLUE)
DO JJ=1,INB
CALL GQOPWK(JJ,IER,INBB,IWK)
IF(IWK == 9)THEN
CYCLE
ELSE
CALL GSCR(IWK,J-ICNT+2,ZRED,ZGREEN,ZBLUE)
ENDIF
ENDDO
END IF
ENDDO
!
RETURN
END SUBROUTINE COLOR_FORDIACHRO
LIBTOOLS/tools/diachro/src/DIAPRO/colvect.f90 0 → 100644
View file @ 6bb35ca8
! ##############################
SUBROUTINE COLVECT(KKU,PTEM2D)
! ##############################
!
!!**** *COLVECT* - Couleur fleches par un autre parametre
!! Possible uniquement pour les profils verticaux de vecteurs vent horizontal
!! generes directement ds un fichier diachronique (CART + MASK)
!!****
!!
!! PURPOSE
!! -------
!
!
!
!
!!** METHOD
!! ------
!!
!!
!!
!! EXTERNAL
!! --------
!!
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODN_PARA : Defines NAM_DOMAIN_POS namelist (former PARA common)
!! NLANGLE : Angle between X Meso-NH axis and
!! cross-section direction in degrees
!! (Integer value anticlockwise)
!!
!! REFERENCE
!! ---------
!!
!! MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
!! + Book1: Concepts and Fundamentals, to appear in 1994;
!! + Book2: Technical Reference and Flowcharts, to appear in 1994;
!! + Book3: Tutorial, November 1994.
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 23/10/2001
!! Updated
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODN_NCAR
USE MODD_PVT
USE MODD_RESOLVCAR
!
IMPLICIT NONE
!
!* 0.1 Dummy arguments and results
!
!
!
REAL, DIMENSION(:,:), INTENT(IN) :: PTEM2D !
!
INTEGER :: KKU !
!
!
!* 0.2 Local variables
!
INTEGER :: JILOOP, JJLOOP, JKLOOP
!
REAL :: ZMXPARCOL, ZMNPARCOL, ZINTPARCOL
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTING THE LONGITUDINAL AND TRANSVERSE COMPONENTS
! ----------------------------------------------------
!
!* 1.1
!
IF(ALLOCATED(NCOL2DUV))THEN
DEALLOCATE(NCOL2DUV)
ENDIF
ALLOCATE(NCOL2DUV(SIZE(PTEM2D,2),KKU))
LCOLPVT=.TRUE.
NCOL2DUV=1
IF(LCOLUSERUV)THEN !:::::::::::::::::::::::::::
DO JILOOP=1,SIZE(PTEM2D,1)
DO JJLOOP=1,SIZE(PTEM2D,2)
IF(PTEM2D(JILOOP,JJLOOP) /= XSPVAL)THEN
IF(PTEM2D(JILOOP,JJLOOP) < XPARCOLUV(1))THEN
NCOL2DUV(JJLOOP,JILOOP)=NINDCOLUV(1)
ELSE IF(PTEM2D(JILOOP,JJLOOP) >= XPARCOLUV&
(NBPARCOLUV))THEN
NCOL2DUV(JJLOOP,JILOOP)=NINDCOLUV(NBCOLUV)
ELSE
DO JKLOOP=2,NBPARCOLUV
IF(PTEM2D(JILOOP,JJLOOP) >= XPARCOLUV(&
JKLOOP-1) .AND. PTEM2D(JILOOP,JJLOOP)<&
XPARCOLUV(JKLOOP))then
NCOL2DUV(JJLOOP,JILOOP)=NINDCOLUV(&
JKLOOP)
EXIT
ENDIF
ENDDO
ENDIF
ENDIF
ENDDO
ENDDO
ELSE !:::::::::::::::::::::::::::
ZMXPARCOL=-1.e14
ZMNPARCOL=+1.e14
DO JILOOP=1,SIZE(PTEM2D,1)
DO JJLOOP=1,SIZE(PTEM2D,2)
IF(PTEM2D(JILOOP,JJLOOP) /= XSPVAL)THEN
ZMXPARCOL=MAX(PTEM2D(JILOOP,JJLOOP),ZMXPARCOL)
ZMNPARCOL=MIN(PTEM2D(JILOOP,JJLOOP),ZMNPARCOL)
ENDIF
ENDDO
ENDDO
IF(ABS(ZMXPARCOL-ZMNPARCOL) >= 20)THEN
ZMNPARCOL=ZMNPARCOL+1
ZMXPARCOl=ZMXPARCOl-1
ENDIF
ZINTPARCOL=(ZMXPARCOL-ZMNPARCOL)/5.
XPARCOLUVSTD(1)=ZMNPARCOL
DO JILOOP=2,NBPARCOLUVSTD-1
XPARCOLUVSTD(JILOOP)=XPARCOLUVSTD(JILOOP-1)+&
ZINTPARCOL
ENDDO
XPARCOLUVSTD(NBPARCOLUVSTD)=ZMXPARCOL
if(nverbia > 0)then
print *,' **OPER_UV** XPARCOLUVSTD ',XPARCOLUVSTD
endif
DO JILOOP=1,SIZE(PTEM2D,1)
DO JJLOOP=1,SIZE(PTEM2D,2)
IF(PTEM2D(JILOOP,JJLOOP) /= XSPVAL)THEN
IF(PTEM2D(JILOOP,JJLOOP) < XPARCOLUVSTD(1))THEN
NCOL2DUV(JJLOOP,JILOOP)=NCOLUVSTD(1)
ELSE IF(PTEM2D(JILOOP,JJLOOP) >= XPARCOLUVSTD&
(NBPARCOLUVSTD))THEN
NCOL2DUV(JJLOOP,JILOOP)=NCOLUVSTD(NBCOLUVSTD)
ELSE
DO JKLOOP=2,NBPARCOLUVSTD
IF(PTEM2D(JILOOP,JJLOOP) >= XPARCOLUVSTD(&
JKLOOP-1) .AND. PTEM2D(JILOOP,JJLOOP)<&
XPARCOLUVSTD(JKLOOP))then
NCOL2DUV(JJLOOP,JILOOP)=NCOLUVSTD(&
JKLOOP)
EXIT
ENDIF
ENDDO
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF !::::::::::::::::::::::::::::::::::
!
!* 1.2
!*
!*
!*
!
!
!* 1.3
!
IF(nverbia > 0)THEN
print *,' ** colvect '
endif
!
!------------------------------------------------------------------------------
!
!* 2. EXIT
! ----
!
RETURN
END SUBROUTINE COLVECT
LIBTOOLS/tools/diachro/src/DIAPRO/compcoord_fordiachro.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE COMPCOORD_FORDIACHRO(KGRID)
! ######################################
!
!!**** *COMPCOORD_FORDIACHRO* - Computes gridpoint locations,
!! meshsizes and topography
!! for all the possible grids, and true altitude where
!! required.
!!
!! PURPOSE
!! -------
! When called for the first time (KGRID=0), COMPCOORD_FORDIACHRO returns for
! the 7 possible grid locations:
! - XHAT, YHAT, ZHAT values (meters) stored in:
! XXX(:,1:7), XXY(:,1:7), XXZ(:,1:7)
! - meshsizes values (meters):
! XXDXHAT(:,1:7), XXDYHAT(:,1:7)
! - topography altitudes values (meters):
! XXZS(:,:,1:7)
!
! When called subsequently (0<KGRID<8), COMPCOORD_FORDIACHRO returns the true
! gridpoint altitude (meters) corresponding to the requested KGRID value
! in the XZZ(:,:,:) array.
!
!!** METHOD
!! ------
!! Temporary arrays are allocated to store the grid point characteristics
!! and de-allocated on exit. The 3D gridpoints locations are linearly
!! interpolated to the expected grid location from their respective
!! nominal locations. Altitudes are interpolated for the w-grid values,
!! which are obtained directly from the Gal-Chen Sommerville formula.
!! For XXX, XXY, XXZ, XXDXHAT, XXDYHAT, XXZS the last index is the grid
!! selector KGRID ranging from 1 to 7 as follows:
!! 1 -> Mass grid,
!! 2 -> U grid,
!! 3 -> V grid,
!! 4 -> W grid,
!! 5 -> Vertical vorticity grid,
!! 6 -> y-component vorticity grid,
!! 7 -> x-component vorticity grid.
!! all the 7 values are prepared one for all in this subroutine and passed
!! to the general TRACE environment to be used in the display process.
!!
!! For the XZZ array the last index is the z direction one, not the grid
!! selector one.
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_COORD : declares gridpoint coordinates (TRACE use)
!!
!! XXX,XXY,XXZ : coordinate values for all the MESO-NH grids
!! XXDXHAT,XXDYHAT,XXDZHAT: meshsize values for all the MESO-NH grids
!! XXZS : topography values for all the MESO_NH grids
!!
!! Module MODD_GRID1 : declares grid variables (Model module)
!!
!! XXHAT, XYHAT : x, y in the conformal or cartesian plane
!! XZHAT : Gal-Chen z level
!! XZS : topography zs
!! XZZ : true gridpoint z altitude
!!
!! Module MODD_DIM1 : Contains dimensions
!!
!! NIMAX,NJMAX,NKMAX : x, y, and z array dimensions
!!
!! Module MODD_PARAMETERS : Contains array border depths
!!
!! JPHEXT : Horizontal external points number
!! JPVEXT : Vertical external points number
!!
!!
!! REFERENCE
!! ---------
!!
!! MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
!! + Book1: Concepts and Fundamentals, to appear in 1994;
!! + Book2: Technical Reference and Flowcharts, to appear in 1994;
!! + Book3: Tutorial, November 1994.
!!
!! The 7 MESO-NH grid types are defined in:
!! - Asencio N. et al., 1994, "Le projet de modele non-hydrostatique
!! commun CNRM-LA, specifications techniques",
!! Note CNRM/GMME, 26, 139p, (pages 39 to 43).
!!
!! - Fischer C., 1994, "File structure and content in the Meso-NH
!! model", Meso-nh internal note, CNRM/GMME, July 5.
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 06/06/94
!! Updated PM 02/12/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_COORD
USE MODD_DIM1
USE MODD_CONF
USE MODD_GRID1
USE MODD_PARAMETERS
USE MODD_MEMCV
USE MODD_RESOLVCAR
!
USE MODI_VERT_COORD
!
IMPLICIT NONE
!
!* 0.1 Local variables declarations
!
INTEGER :: IIU, IJU, IKU
INTEGER :: IIB, IJB, IKB
INTEGER :: IIE, IJE, IKE
!
! Calcul des X, Y, Z aux points de masse
REAL,DIMENSION(:),ALLOCATABLE :: ZXMASS, ZYMASS, ZZMASS
REAL,DIMENSION(:),ALLOCATABLE :: ZXTEM, ZYTEM, ZZTEM, &
ZDXTEM, ZDYTEM, ZDZTEM
REAL,DIMENSION(:,:),ALLOCATABLE :: ZZSTEM
REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: ZSCOEF
REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: ZSZ
REAL,SAVE :: ZSH
INTEGER :: JGRIDLOOP, KGRID, &
OKZXTEM, OKZYTEM, OKZZTEM, OKZDXTEM, OKZDYTEM, OKZDZTEM, &
OKZZSTEM, OKZSCOEF, OKZXMASS, OKZYMASS, OKZZMASS, OKXXZS, OKXZZ, OKZSZ
!
!-------------------------------------------------------------------------------
!
!* 1. ARRAY DIMENSIONS SETTOING
! -------------------------
!
if(nverbia > 0)then
if (LEN(CDIRCUR) .LT. 500)THEN
print *,' **COMPCOORD KGRID DIRCUR ',KGRID,CDIRCUR(1:LEN_TRIM(CDIRCUR))
endif
endif
IIU=NIMAX+2*JPHEXT
IJU=NJMAX+2*JPHEXT
IKU=NKMAX+2*JPVEXT
IF(CSTORAGE_TYPE == 'PG' .OR. CSTORAGE_TYPE == 'SU')THEN
IKU=1
ENDIF
IIB=1+JPHEXT
IJB=1+JPHEXT
IKB=1+JPVEXT
IIE=IIU-JPHEXT
IJE=IJU-JPHEXT
IKE=IKU-JPVEXT
!
!-------------------------------------------------------------------------------
!
!* 2. CALCULATIONS PERFORMED FOR THE FIRST CALL
! ----------------------------------------
!
! Test on KGRID selects processing mode:
! . KGRID=0 --> X, Y, Z + meshsizes + topography computed for ALL the
! possible grid geometry.
! . 0<KGRID<8 --> true altitude computed for the KGRID gridpoints
IF(KGRID==0)THEN ! if "KGRID=1" selected
!
!* 2.1 Array allocation when called for the first time
!
! 1D Arrays
!
ALLOCATE(ZXTEM(1:IIU),STAT=OKZXTEM) ! RINT *,' OKZXTEM',OKZXTEM
ALLOCATE(ZYTEM(1:IJU),STAT=OKZYTEM) !PRINT *,' OKZYTEM',OKZYTEM
ALLOCATE(ZZTEM(1:IKU),STAT=OKZZTEM) !PRINT *,' OKZZTEM',OKZZTEM
ALLOCATE(ZDXTEM(1:IIU),STAT=OKZDXTEM) !PRINT *,' OKZDXTEM',OKZDXTEM
ALLOCATE(ZDYTEM(1:IJU),STAT=OKZDYTEM) !PRINT *,' OKZDYTEM',OKZDYTEM
ALLOCATE(ZDZTEM(1:IKU),STAT=OKZDZTEM) !PRINT *,' OKZDZTEM',OKZDZTEM
ALLOCATE(ZXMASS(1:IIU),STAT=OKZXMASS) !PRINT *,' OKZXMASS',OKZXMASS
ALLOCATE(ZYMASS(1:IJU),STAT=OKZYMASS) !PRINT *,' OKZYMASS',OKZYMASS
ALLOCATE(ZZMASS(1:IKU),STAT=OKZZMASS) !PRINT *,' OKZZMASS',OKZZMASS
! 2D Arrays
!
ALLOCATE(ZZSTEM(1:IIU,1:IJU),STAT=OKZZSTEM) !PRINT *,' OKZZSTEM',OKZZSTEM
!
IF(ALLOCATED(ZSCOEF))THEN
DEALLOCATE(ZSCOEF)
END IF
ALLOCATE(ZSCOEF(1:IIU,1:IJU),STAT=OKZSCOEF) !PRINT *,' OKZSCOEF',OKZSCOEF
IF(ALLOCATED(XXX))THEN
DEALLOCATE(XXX)
END IF
ALLOCATE(XXX(1:IIU,7))
IF(ALLOCATED(XXY))THEN
DEALLOCATE(XXY)
END IF
ALLOCATE(XXY(1:IJU,7))
IF(ALLOCATED(XXZ))THEN
DEALLOCATE(XXZ)
END IF
ALLOCATE(XXZ(1:IKU,7))
IF(ALLOCATED(XXDXHAT))THEN
DEALLOCATE(XXDXHAT)
END IF
ALLOCATE(XXDXHAT(1:IIU,7))
IF(ALLOCATED(XXDYHAT))THEN
DEALLOCATE(XXDYHAT)
END IF
ALLOCATE(XXDYHAT(1:IJU,7))
! 3D Arrays
!
IF(ALLOCATED(XXZS))THEN
DEALLOCATE(XXZS)
END IF
ALLOCATE(XXZS(1:IIU,1:IJU,7),STAT=OKXXZS) !PRINT *,' OKXXZS',OKXXZS
IF(ALLOCATED(ZSZ))THEN
DEALLOCATE(ZSZ)
END IF
ALLOCATE(ZSZ(1:IIU,1:IJU,IKU),STAT=OKZSZ) !PRINT *,' OKZSZ',OKZSZ
!
!* 2.2 Computes true altitudes on the W grid (KGRID=4)
!
IF(CSTORAGE_TYPE /= 'PG' .AND. CSTORAGE_TYPE /='SU')THEN
print *,' ******* COMPCOORD_FORDIACHRO ZHAT(IKE+1) ',XZHAT(IKE+1)
CALL VERT_COORD(LSLEVE,XZS,XZSMT,XLEN1,XLEN2,XZHAT,ZSZ)
ENDIF
!
!* 2.3 Interpolates XHAT, YHAT, ZHAT at mass gridpoints
!
ZXMASS(1:IIU-1)=.5*(XXHAT(2:IIU)+XXHAT(1:IIU-1))
ZXMASS(IIU)=2.*ZXMASS(IIU-1)-ZXMASS(IIU-2)
ZYMASS(1:IJU-1)=.5*(XYHAT(2:IJU)+XYHAT(1:IJU-1))
ZYMASS(IJU)=2.*ZYMASS(IJU-1)-ZYMASS(IJU-2)
IF(IKU == 1)THEN
ZZMASS(1:IKU)=XZHAT(1:IKU)
!ZZMASS(1:IKU)=.5*(XZHAT(2:IKU)+XZHAT(1:IKU-1)) !!! size(XZHAT)=1 !!!
ELSE
ZZMASS(1:IKU-1)=.5*(XZHAT(2:IKU)+XZHAT(1:IKU-1))
ZZMASS(IKU)=2.*ZZMASS(IKU-1)-ZZMASS(IKU-2)
ENDIF
!
!* 2.4 Interpolates X, Y, Z, meshsizes, and topography
!* for all the KGRID selection locations
!
DO JGRIDLOOP=1,7
SELECT CASE(JGRIDLOOP)
CASE(1)
ZXTEM(:)=ZXMASS(:)
ZYTEM(:)=ZYMASS(:)
ZZTEM(:)=ZZMASS(:)
ZZSTEM(:,:)=XZS(:,:)
CASE(2)
ZXTEM(:)=XXHAT(:)
ZYTEM(:)=ZYMASS(:)
ZZTEM(:)=ZZMASS(:)
ZZSTEM(2:IIU,:)=.5*(XZS(2:IIU,:)+XZS(1:IIU-1,:))
ZZSTEM(1,:)=XZS(1,:)
CASE(3)
ZXTEM(:)=ZXMASS(:)
ZYTEM(:)=XYHAT(:)
ZZTEM(:)=ZZMASS(:)
ZZSTEM(:,2:IJU)=.5*(XZS(:,2:IJU)+XZS(:,1:IJU-1))
ZZSTEM(:,1)=XZS(:,1)
CASE(4)
ZXTEM(:)=ZXMASS(:)
ZYTEM(:)=ZYMASS(:)
ZZTEM(:)=XZHAT(:)
ZZSTEM(:,:)=XZS(:,:)
CASE(5)
ZXTEM(:)=XXHAT(:)
ZYTEM(:)=XYHAT(:)
ZZTEM(:)=ZZMASS(:)
ZZSTEM(2:IIU,:)=.5*(XZS(2:IIU,:)+XZS(1:IIU-1,:))
ZZSTEM(1,:)=XZS(1,:)
ZZSTEM(:,2:IJU)=.5*(ZZSTEM(:,2:IJU)+ZZSTEM(:,1:IJU-1))
ZZSTEM(:,1)=ZZSTEM(:,2)
CASE(6)
ZXTEM(:)=XXHAT(:)
ZYTEM(:)=ZYMASS(:)
ZZTEM(:)=XZHAT(:)
ZZSTEM(2:IIU,:)=.5*(XZS(2:IIU,:)+XZS(1:IIU-1,:))
ZZSTEM(1,:)=XZS(1,:)
CASE(7)
ZXTEM(:)=ZXMASS(:)
ZYTEM(:)=XYHAT(:)
ZZTEM(:)=XZHAT(:)
ZZSTEM(:,2:IJU)=.5*(XZS(:,2:IJU)+XZS(:,1:IJU-1))
ZZSTEM(:,1)=XZS(:,1)
END SELECT
ZDXTEM(1:IIU-1)=ZXTEM(2:IIU)-ZXTEM(1:IIU-1)
!
! NOTICE: An extra meshlength is added to the max size of the arrays
! in order to avoid a lot of testing hereafter...
!
ZDXTEM(IIU)=ZDXTEM(IIU-1)
ZDYTEM(1:IJU-1)=ZYTEM(2:IJU)-ZYTEM(1:IJU-1)
ZDYTEM(IJU)=ZDYTEM(IJU-1)
IF(IKU /= 1)THEN
ZDZTEM(1:IKU-1)=ZZTEM(2:IKU)-ZZTEM(1:IKU-1)
ZDZTEM(IKU)=ZDZTEM(IKU-1)
ENDIF
! X, Y, Z as functions of KGRID
XXX(:,JGRIDLOOP)=ZXTEM
XXY(:,JGRIDLOOP)=ZYTEM
XXZ(:,JGRIDLOOP)=ZZTEM
! Topography as a function of KGRID
XXZS(:,:,JGRIDLOOP)=ZZSTEM
! Meshsizes as functions of KGRID
XXDXHAT(:,JGRIDLOOP)=ZDXTEM(:)
XXDYHAT(:,JGRIDLOOP)=ZDYTEM(:)
ENDDO
DEALLOCATE(ZXMASS,ZYMASS,ZZMASS)
DEALLOCATE(ZXTEM,ZYTEM,ZZTEM)
DEALLOCATE(ZDXTEM,ZDYTEM,ZDZTEM)
DEALLOCATE(ZZSTEM)
!-------------------------------------------------------------------------------
!
!* 3. CALCULATIONS PERFORMED FOR ALL SUBSEQUENT CALLS
! -----------------------------------------------
!
ELSE ! else if KGRID =/=1 selected
! True altitudes
SELECT CASE(KGRID)
CASE(1)
XZZ(:,:,1:IKU-1)=0.5*(ZSZ(:,:,1:IKU-1)+ZSZ(:,:,2:IKU))
XZZ(:,:,IKU)=2.*XZZ(:,:,IKU-1)-XZZ(:,:,IKU-2)
CASE(2)
XZZ(:,:,1:IKU-1)=0.5*(ZSZ(:,:,1:IKU-1)+ZSZ(:,:,2:IKU))
XZZ(:,:,IKU)=2.*XZZ(:,:,IKU-1)-XZZ(:,:,IKU-2)
XZZ(2:IIU,:,:)=0.5*(XZZ(2:IIU,:,:)+XZZ(1:IIU-1,:,:))
XZZ(1,:,:)=2*XZZ(2,:,:)-XZZ(3,:,:)
CASE(3)
XZZ(:,:,1:IKU-1)=0.5*(ZSZ(:,:,1:IKU-1)+ZSZ(:,:,2:IKU))
XZZ(:,:,IKU)=2.*XZZ(:,:,IKU-1)-XZZ(:,:,IKU-2)
XZZ(:,2:IJU,:)=0.5*(XZZ(:,2:IJU,:)+XZZ(:,1:IJU-1,:))
XZZ(:,1,:)=2*XZZ(:,2,:)-XZZ(:,3,:)
CASE(4)
XZZ(:,:,:)=ZSZ(:,:,:)
CASE(5)
XZZ(:,:,1:IKU-1)=0.5*(ZSZ(:,:,1:IKU-1)+ZSZ(:,:,2:IKU))
XZZ(:,:,IKU)=2.*XZZ(:,:,IKU-1)-XZZ(:,:,IKU-2)
XZZ(2:IIU,:,:)=0.5*(XZZ(2:IIU,:,:)+XZZ(1:IIU-1,:,:))
XZZ(1,:,:)=2*XZZ(2,:,:)-XZZ(3,:,:)
XZZ(:,2:IJU,:)=0.5*(XZZ(:,2:IJU,:)+XZZ(:,1:IJU-1,:))
XZZ(:,1,:)=2*XZZ(:,2,:)-XZZ(:,3,:)
CASE(6)
XZZ(2:IIU,:,:)=0.5*(ZSZ(2:IIU,:,:)+ZSZ(1:IIU-1,:,:))
XZZ(1,:,:)=2*XZZ(2,:,:)-XZZ(3,:,:)
CASE(7)
XZZ(:,2:IJU,:)=0.5*(ZSZ(:,2:IJU,:)+ZSZ(:,1:IJU-1,:))
XZZ(:,1,:)=2*XZZ(:,2,:)-XZZ(:,3,:)
END SELECT
END IF ! End KGRID selection
!
!---------------------------------------------------------------------------
!
!* 4. EXIT
! ----
!
RETURN
END SUBROUTINE COMPCOORD_FORDIACHRO
LIBTOOLS/tools/diachro/src/DIAPRO/complat.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
SUBROUTINE COMPLAT(PLAT)
! ############################
!
!!**** *COMPLAT* -
!!****
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!!
!!
!! EXTERNAL
!! --------
!! COS ! trigonometric functions
!! SIN !
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 22/02/2000
!! Updated
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_COORD
USE MODD_NMGRID
USE MODD_GRID1
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODE_GRIDPROJ
!
IMPLICIT NONE
!
!* 0.1 Dummy arguments and results
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PLAT
!
!* 0.2 Local variables
!
INTEGER :: II, IJ
INTEGER :: JILOOP, JJLOOP
!
REAL,DIMENSION(:), ALLOCATABLE,SAVE :: ZY
REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: ZLA, ZLO, ZYY, ZX
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTING THE LONGITUDINAL AND TRANSVERSE COMPONENTS
! ----------------------------------------------------
!
!* 1.1 Array sizes calculations
!
II=SIZE(PLAT,1)
IJ=SIZE(PLAT,2)
!
!* 1.2 Array allocations
!
IF (ALLOCATED(ZX))THEN
DEALLOCATE(ZX)
ENDIF
IF (ALLOCATED(ZY))THEN
DEALLOCATE(ZY)
ENDIF
IF (ALLOCATED(ZYY))THEN
DEALLOCATE(ZYY)
ENDIF
IF (ALLOCATED(ZLA))THEN
DEALLOCATE(ZLA)
ENDIF
IF (ALLOCATED(ZLO))THEN
DEALLOCATE(ZLO)
ENDIF
ALLOCATE(ZX(II,1),ZY(IJ))
ALLOCATE(ZYY(II,1),ZLA(II,1),ZLO(II,1))
!
ZX(:,1)=XXX(:,NMGRID)
ZY(:)=XXY(:,NMGRID)
DO JJLOOP=1,IJ
DO JILOOP=1,II
ZYY(JILOOP,1)=ZY(JJLOOP)
ENDDO
CALL SM_LATLON_A(XLATORI,XLONORI,ZX,ZYY,ZLA,ZLO)
PLAT(:,JJLOOP)=ZLA(:,1)
ENDDO
!------------------------------------------------------------------------------
!
!* 2. EXIT
! ----
!
RETURN
END SUBROUTINE COMPLAT
LIBTOOLS/tools/diachro/src/DIAPRO/conv2xy.f90 0 → 100644
View file @ 6bb35ca8
! ######spl
MODULE MODI_CONV2XY
! ####################
!
INTERFACE
!
SUBROUTINE CONV2XY(PXX,PYY,PX,PY,K)
REAL :: PXX,PYY,PX,PY
INTEGER,INTENT(IN) :: K
END SUBROUTINE CONV2XY
!
END INTERFACE
!
END MODULE MODI_CONV2XY
! ######spl
SUBROUTINE CONV2XY(PXX,PYY,PX,PY,K)
! ###################################
!
!!**** *CONV2XY* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! N.A.
!!
!! EXTERNAL
!! --------
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module
!!
!! Module
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! J. Duron * Laboratoire d'Aerologie *
!!
!!
!! MODIFICATIONS
!! -------------
!! Original 16/06/98
!! Updated PM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_COORD
USE MODD_DIM1
USE MODD_CONF
USE MODD_GRID1
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_RESOLVCAR
USE MODD_ALLOC_FORDIACHRO
USE MODD_FILES_DIACHRO
USE MODE_GRIDPROJ
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
!
REAL :: PXX,PYY,PX,PY
INTEGER,INTENT(IN) :: K
!
!* 0.1 Local variables
! ---------------
!
INTEGER :: J,JM,JMCUR
INTEGER :: IINF, IJINF, ISUP, IJSUP
LOGICAL :: GOK
! !------------------------------------------------------------------------------
GOK=.FALSE.
IINF=NIINF; ISUP=NISUP; IJINF=NJINF; IJSUP=NJSUP
IF(ALLOCATED(XXHAT))THEN
ELSE
IF (NBFILES == 1)THEN
ELSE
DO J=1,NBFILES
IF(NUMFILES(J)==NUMFILECUR)THEN
JMCUR=J
if(nverbia > 0)then
print *,' CONV2XY J JMCUR ',J,JMCUR
endif
EXIT
ENDIF
ENDDO
DO J=1,NBFILES
IF(NUMFILES(J)==NUMFILECUR)THEN
CYCLE
ELSE
JM=J
if(nverbia > 0 )THEN
print *,' CONV2XY JM,CFILEDIAS(JM) ',JM,CFILEDIAS(JM)
ENDIF
CALL READ_FILEHEAD(JM,CFILEDIAS(JM),CLUOUTDIAS(JM))
IF(NIMAX /= 0)THEN
GOK=.TRUE.
EXIT
ENDIF
ENDIF
ENDDO
ENDIF
ENDIF
IF(ALLOCATED(XXHAT))THEN
IF(LCONV2XY .AND. NLATLON /= 0)THEN
CALL SM_XYHAT_S(XLATORI,XLONORI,PXX,PYY, &
PX,PY)
IF(K == 11)THEN
PXX=PX
ELSE IF(K == 12)THEN
PXX=PY
ELSE IF(K == 21)THEN
PYY=PX
ELSE IF(K == 22)THEN
PYY=PY
ENDIF
ENDIF
ELSE
print *,' Absence d''entete dans les differents fichiers ouverts'
print *,' Impossibilite de convertir les coordonnees geographiques en conformes '
print *,' LCONV2XY remis a .FALSE. '
LCONV2XY=.FALSE.
ENDIF
IF(GOK)THEN
CALL READ_FILEHEAD(JMCUR,CFILEDIAS(JMCUR),CLUOUTDIAS(JMCUR))
ENDIF
NIINF=IINF; NISUP=ISUP; NJINF=IJINF; NJSUP=IJSUP
RETURN
END SUBROUTINE CONV2XY

Documentation | Mentions légales | CGU | Accessibilité : non conforme