C OPTION    SOURCE    FANDEUR   14/01/16    21:15:11     7906           

C=======================================================================
C  Si ICHOI=1
C    Affection d'une valeur a une variable de CCOPTIO (directive OPTION)
C  Si ICHOI=2
C    Renvoie la valeur d'une des variables de CCOPTIO (directive VALEUR)
C=======================================================================

      SUBROUTINE OPTION (ICHOI)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
-INC CCASSIS
-INC SMCOORD
-INC SMLREEL
-INC SMLMOTS
-INC CCFXDR
-INC CCTRACE

      SEGMENT MCOOR1
        REAL*8 XCoor1(LCoor)
      END SEGMENT


C NbOpt : Nombre d'options (mot-cles) des operateurs OPTION et VALEUR
C NbMfo : Nombre d'options mot-cle 'MODE' (vecteur MFO)
C NbMsfo :   "      "      mot-cle 'MODE' 'PLAN' (vecteur MSFO)
C NbNoha :   "      "      mot-cle 'FOUR' (vecteur NOHR)
C NbUnid :   "      "      mot-cle 'UNID' (vecteur OptUnid)
C NbMod1D :  "      "      mots-cles 'UNID' 'PLAN','AXIS' (vect. Mode1D)
C NbGra :    "      "      mot-cle 'TRAC' (vecteur MGR)
C NbIso :    "      "      mot-cle 'ISOV' (vecteur MISO)
C NbReso :   "      "      mot-cle 'RESO' (vecteur MRESOL)
C NbErre :   "      "      mot-cle 'ERRE' (vecteur ERCTRL)
C NbForm :   "      "      mot-cle 'SAUV' et 'REST' (vecteur FORMAT)
C NbAuto :   "      "      mot-cle 'NORM' (vecteur NAUTO)
      PARAMETER (NbOpt=42,NbMfo=6,NbMsfo=3,NbNoha=1,NbUnid=3,NbMod1D=12,
     $           NbGra=9,NbIso=3,NbReso=2,NbErre=4,NbForm=4,NbAuto=2,
     $           NbPoli=7,NbCosc=3,NbPotr=12)

      EXTERNAL LONG
      CHARACTER*4 MCLE(NbOpt)
      CHARACTER*4 MFO(NbMfo)
      CHARACTER*4 MSFO(NbMsfo)
      CHARACTER*4 OptUnid(NbUnid)
      CHARACTER*4 Mode1D(NbMod1D)
      CHARACTER*4 MGR(NbGra)
      CHARACTER*4 MISO(NbIso)
      CHARACTER*4 MRESOL(NbReso)
      CHARACTER*4 ERCTRL(NbErre)
      CHARACTER*4 FORMAT(NbForm)
      CHARACTER*4 NOHR(NbNoha)
      CHARACTER*4 NAUTO(NbAuto)
      CHARACTER*8 MPOLI(NbPoli)
      CHARACTER*12 ICHA
      CHARACTER*4 MCOSC(NbCosc)
      CHARACTER*12 MPOTR(NbPotr)

      CHARACTER*512 CHA
      CHARACTER*16 MODERI(5)
      LOGICAL LOG


      DATA MCLE / 'IMPR','DIME','ELEM','SORT','TRAC','DONN','ECHO',
     $            'ERRE','LECT','EPSI','IMPI','MODE','CADR','COUL',
     $            'NIVE','NGMA','SAUV','REST','ISOV','OMBR','NBP ',
     $            'VERI','ZERO','ACQU','----','PLAC','LANG','NORM',
     $            'RESO','FTRA','OEIL','ERMA','ASSI','EPTR','NAVI',
     $            'PARA','SURV','POLI','COSC','POTR','DEBU','LOCA' /
      DATA MFO / 'TRID','FOUR','AXIS','PLAN','UNID','FREQ' /
      DATA MSFO / 'DEFO','CONT','GENE' /
      DATA NOHR / 'NOHA' /
      DATA OptUnid / 'PLAN','AXIS','SPHE' /
      DATA Mode1D / 'DYDZ','DYCZ','CYDZ','CYCZ','GYDZ','GYCZ','DYGZ',
     .              'CYGZ','GYGZ','AXDZ','AXCZ','AXGZ' /
      DATA MGR / 'BENS','X   ','IBM ','GKS ','PHIG','OPEN','PS  ',
     .           'MIF ','PSC ' /
      DATA MISO / 'LIGN','SURF','SULI' /
      DATA MRESOL / 'DIRE','ITER' /
      DATA ERCTRL / 'FATA','NORM','IGNO','CONT' /
      DATA FORMAT / 'FORM','TAIL','XDR','BINA' /
      DATA NAUTO / 'AUTO','ANNU' /
      DATA MODERI /'LINEAIRE       ','QUADRATIQUE     ',
     $ 'TRUESDELL       ','JAUMANN         ','UTILISATEUR     '/
      DATA MPOLI / '8_BY_13 ','9_BY_15 ','TIMES_10','TIMES_24',
     $             'HELV_10 ','HELV_12 ','HELV_18 ' /
      DATA MCOSC / 'NOIR','BLAN','JAUN' /
      DATA MPOTR / 'COURIER_12  ','HELVETICA_12','TIMES_12    ',
     $             'COURIER_14  ','HELVETICA_14','TIMES_14    ',
     $             'COURIER_16  ','HELVETICA_16','TIMES_16    ',
     $             'COURIER_18  ','HELVETICA_18','TIMES_18    '/
     
      IF ((ICHOI.NE.1).AND.(ICHOI.NE.2)) THEN
        CALL ERREUR (5)
        RETURN
      ENDIF
      i=0
 1    CONTINUE
      CALL MESLIR(-218)
      CALL LIRMOT(MCLE,NBOPT,i,0)
      IF (i.EQ.0) RETURN

C  Branchement vers les differentes options
C ------------------------------------------
      GOTO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
     .      115,116,117,118,119,120,121,122,123,124,125,126,127,128,
     .      129,130,131,132,133,134,135,136,137,138,139,140,141,142),i
C ---------------
C  Option 'IMPR'
C ---------------
 101  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOIMP)
        RETURN
      ENDIF
      CALL MESLIR(-217)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IOIMP=IRET
        GOTO 1
      ENDIF
      CALL MESLIR(-216)
      CALL LIRCHA(CHA,1,IRetou)
      IUNIT=IOIMP
      GOTO 1211
C ---------------
C  Option 'DIME' : dimension de l'espace (IDIM)
C ---------------
 102  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IDIM)
        RETURN
      ENDIF
      CALL MESLIR(-215)
      CALL LIRENT(IRET,1,IRetou)
      IF (IRET.EQ.IDIM) GOTO 1
      IF ((IRET.NE.1).AND.(IRET.NE.2).AND.(IRET.NE.3)) CALL ERREUR(36)
      IF (IERR.NE.0) RETURN
      IF (IDIM.EQ.0) THEN
        IDIM=IRET
        IF (IDIM.EQ.1) THEN
          IFOMOD=3
          IFOUR=3
          NIFOUR=0
        ELSE IF (IDIM.EQ.3) THEN
          IFOMOD=2
          IFOUR=2
          NIFOUR=0
        ENDIF
        GOTO 1
      ENDIF
C  Passage en dimension 3
      IF (IRET.EQ.3) THEN
        IFOMOD=2
        IFOUR=2
        NIFOUR=0
C  Passage en dimension 2, on met les options de calcul a PLAN DEFO.
      ELSE IF (IRET.EQ.2) THEN
        IF (IDIM.EQ.3) THEN
          IF (IFOMOD.EQ.2) IFOMOD=-1
          IF (IFOUR.EQ.2) IFOUR=-1
        ELSE IF (IDIM.EQ.1) THEN
          IFOMOD=-1
          IFOUR=-1
          NIFOUR=0
        ENDIF
C  Passage en dimension 1, on met les options de calcul a UNIDPLANDYDZ.
      ELSE IF (IRET.EQ.1) THEN
        IF (IFOMOD.NE.3.AND.IFOMOD.NE.4.AND.IFOMOD.NE.5) THEN
          IFOMOD=3
          IFOUR=3
          NIFOUR=0
        ENDIF
      ENDIF
C  Transfert des coordonnees des points dans nouveau MCOORD
      idimp1=IDIM+1
      iretp1=IRET+1
      NBPTS=XCOOR(/1)/idimp1
      LCoor=NBPTS*iretp1
      SEGINI,MCOOR1
      INF=MIN(IDIM,IRET)
      DO IP=1,NBPTS
        IRef1=(IP-1)*iretp1
        IRef =(IP-1)*idimp1
        DO j=1,INF
          XCoor1(IRef1+j)=XCOOR(IRef+j)
        ENDDO
        XCoor1(IRef1+iretp1)=XCOOR(IRef+idimp1)
      ENDDO
      IDIM=IRET
      SEGADJ,MCOORD
      DO j=1,XCOOR(/1)
        XCOOR(j)=XCOOR1(j)
      ENDDO
      SEGSUP,MCOOR1
      GOTO 1
C ---------------
C  Option 'ELEM'
C ---------------
 103  IF (ICHOI.EQ.2) THEN
        IF (ILCOUR.EQ.0) THEN
          CALL ECRCHA('    ')
        ELSE
          CALL ECRCHA(NOMS(ILCOUR))
        ENDIF
        RETURN
      ENDIF
      CALL MESLIR(-214)
      CALL LIRMOT(NOMS,NOMBR,IRET,1)
      IF (IERR.NE.0) RETURN
      ILCOUR=IRET
C*    ICHA=NOMS(ILCOUR)
      GOTO 1
C ---------------
C  Option 'SORT'
C ---------------
 104  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOPER)
        RETURN
      ENDIF
      CALL MESLIR(-213)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IOPER=IRET
        GOTO 1
      ENDIF
      CALL MESLIR(-212)
      CALL LIRCHA(CHA,1,IRetou)
      IUNIT=IOPER
      GOTO 1211
C ---------------
C  Option 'TRAC'
C ---------------
 105  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MGR(IOGRA))
        RETURN
      ENDIF
      CALL MESLIR(-211)
      CALL LIRMOT(MGR,NbGra,ij,1)
      IF (IERR.NE.0) RETURN
      IOGRA=ij
      GOTO 1
C ---------------
C  Option 'DONN'
C ---------------
 106  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOLEC)
        RETURN
      ENDIF
      CALL MESLIR(-210)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IOLEC=IRET
        CALL GINT2
        GOTO 1
      ENDIF
      CALL MESLIR(-209)
      CALL LIRCHA(CHA,1,IRetou)
C  On impose IOLEC=3 pour eviter probleme avec lecture terminal
      IOLEC=3
      CALL GINT2
      IUNIT=IOLEC
      GOTO 1201
C ---------------
C  Option 'ECHO'
C ---------------
 107  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IECHO)
        RETURN
      ENDIF
      CALL MESLIR(-208)
      CALL LIRENT(IRET,1,IRetou)
      INTERR(1)=iret
      IF ((IRET.NE.0).AND.(IRET.NE.1).AND.(IRET.NE.2)) CALL ERREUR(36)
      IF (IERR.NE.0) RETURN
      IECHO=IRET
      GOTO 1
C ---------------
C  Option 'ERRE'
C ---------------
 108  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(ERCTRL(IERPER))
        RETURN
      ENDIF
      CALL MESLIR(-207)
      CALL LIRMOT(ERCTRL,NbErre,IRET,1)
      IF (IERR.NE.0) RETURN
      IERPER=IRET
      GOTO 1
C ---------------
C  Option 'LECT'
C ---------------
 109  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOCAR)
        RETURN
      ENDIF
      CALL MESLIR(-206)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IOCAR=IRET
        GOTO 1
      ENDIF
      CALL MESLIR(-205)
      CALL LIRCHA(CHA,1,IRetou)
      IUNIT=IOCAR
      GOTO 1201
C ---------------
C  Option 'DERI'
C ---------------
 110  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(moderi(MEPSIL))
        RETURN
      ENDIF
      CALL MESLIR(-204)
      CALL LIRMOT(MODERI,5,iret,1)
      IF (IERR.NE.0) RETURN
      MEPSIL=IRET
      GO TO 1
C ---------------
C  Option 'IMPI'
C ---------------
 111  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IIMPI)
        RETURN
      ENDIF
      CALL MESLIR(-202)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      IIMPI=IRET
      GOTO 1
C ---------------
C  Option 'MODE'
C ---------------
 112  IF (ICHOI.EQ.2) THEN
        IF (IFOMOD.EQ.-1) THEN
          ICHA(1:4)=MFO(4)
          ICHA(5:8)=MSFO(ABS(IFOUR))
          CALL ECRCHA(ICHA(1:8))
        ELSE IF (IFOMOD.EQ.3) THEN
          ICHA(1:4)=MFO(5)
          ICHA(5:8)=OptUnid(1)
          ICHA(9:12)=Mode1D(IFOUR-2)
          CALL ECRCHA(ICHA(1:12))
        ELSE IF (IFOMOD.EQ.4) THEN
          ICHA(1:4)=MFO(5)
          ICHA(5:8)=OptUnid(2)
          ICHA(9:12)=Mode1D(IFOUR-2)
          CALL ECRCHA(ICHA(1:12))
        ELSE IF (IFOMOD.EQ.5) THEN
          ICHA(1:4)=MFO(5)
          ICHA(5:8)=OptUnid(3)
          ICHA(9:12)='    '
          CALL ECRCHA(ICHA(1:8))
        ELSE IF (IFOMOD.EQ.6) THEN
          CALL ECRCHA(MFO(6))
        ELSE
          CALL ECRCHA(MFO(3-IFOMOD))
        ENDIF
        RETURN
      ENDIF
      CALL MESLIR(-201)
      CALL LIRMOT(MFO,NbMfo,IK,1)
      IF ((IERR.NE.0).OR.(IK.EQ.0)) RETURN
      IF (IK.EQ.1) THEN
        IRET=2
      ELSE IF (IK.EQ.2) THEN
        IRET=1
      ELSE IF (IK.EQ.3) THEN
        IRET=0
      ELSE IF (IK.EQ.4) THEN
        IRET=-1
      ELSE IF (IK.EQ.5) THEN
        IRET=3
      ELSE IF (IK.EQ.6) THEN
        IRET=6
      ENDIF
C  Possibilite d'imprimer une erreur si le MODE de calcul n'est pas
C  compatible avec la dimension. Debranche pour l'instant.
C**   IF ( (IDIM.EQ.2.AND.IRET.NE.-1.AND.IRET.NE.0.AND.IRET.NE.1)
C**  . .OR.(IDIM.EQ.1.AND.IRET.NE.3).OR.(IDIM.EQ.3.AND.IRET.NE.2) ) THEN
C**     MOTERR(1:4)=MFO(IK)
C**     INTERR(1)=IDIM
C**     CALL ERREUR(970)
C**     RETURN
C**   ENDIF
      IFOMOD=IRET
      if (iret.ne.6) IFOUR=IRET
      NIFOUR=0
      IF (IRET.EQ.-1) THEN
        CALL LIRMOT(MSFO,NbMsfo,IKS,0)
        IF (IKS.EQ.0) THEN
          IFOUR=-1
        ELSE IF (IKS.EQ.1) THEN
          IFOUR=-1
        ELSE IF (IKS.EQ.2) THEN
          IFOUR=-2
        ELSE IF (IKS.EQ.3) THEN
          IFOUR=-3
        ENDIF
      ELSE IF (IRET.EQ.1) THEN
        CALL LIRENT(NHH,0,ICOND)
        IF (ICOND.EQ.0) THEN
          CALL LIRMOT(NOHR,NbNoha,NHH,0)
          IF (NHH.EQ.1) THEN
            READ (NOHR(1),FMT='(A4)') NHH
          ELSE
            CALL ERREUR(287)
          ENDIF
        ENDIF
        NIFOUR=NHH
      ELSE IF (IRET.EQ.3) THEN
        CALL LIRMOT(OptUnid,NbUnid,IKS,0)
        IF (IKS.EQ.0) THEN
          IFOMOD=3
          IFOUR=3
        ELSE IF (IKS.EQ.1) THEN
          IFOMOD=3
          CALL LIRMOT(Mode1D(1),9,i,0)
          IF (i.EQ.0) i=1
          IFOUR=2+i
        ELSE IF (IKS.EQ.2) THEN
          IFOMOD=4
          CALL LIRMOT(Mode1D(10),3,i,0)
          IF (i.EQ.0) i=1
          IFOUR=11+i
        ELSE IF (IKS.EQ.3) THEN
          IFOMOD=5
          IFOUR=15
        ENDIF
      ENDIF
      GOTO 1
C ---------------
C  Option 'CADR'
C ---------------
 113  IF (ICHOI.EQ.2) THEN
        XRET=DIOCAD
        CALL ECRREE(XRET)
        RETURN
      ENDIF
      CALL MESLIR(-200)
      CALL LIRREE(XRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      DIOCAD=XRET
      GOTO 1
C ---------------
C  Option 'COUL'
C ---------------
 114  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(NCOUL(IDCOUL))
        RETURN
      ENDIF
      CALL MESLIR(-199)
      CALL LIRMOT(NCOUL(0),NBCOUL,IRET,1)
      IF (IRET.LE.0) CALL ERREUR(36)
      IF (IERR.NE.0) RETURN
      IDCOUL=IRET-1
      ICHA=NCOUL(IDCOUL)
      GOTO 1
C ---------------
C  Option 'NIVE'
C ---------------
 115  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IONIVE)
        RETURN
      ENDIF
      CALL MESLIR(-198)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      INTERR(1)=IRET
      IF ((IRET.LT.18).OR.(IRET.GT.18)) CALL ERREUR(36)
      IONIVE=IRET
      GOTO 1
C ---------------
C  Option 'NGMA'
C ---------------
 116  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(NGMAXY)
        RETURN
      ENDIF
      CALL MESLIR(-197)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      INTERR(1)=IRET
      IF (IRET.LT.0) CALL ERREUR (36)
      NGMAXY=IRET
      GOTO 1
C ---------------
C  Option 'SAUV'
C ---------------
 117  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOSAU)
        RETURN
      ENDIF
      CALL MESLIR(-196)
      IFORM=2
      IPREFI=0
      DIMATT=0.D0
      IREFOR=0
      ISAFOR=0
      IF (IPSAUV.NE.0) CALL LIBPIL(IPSAUV)
      IPSAUV=0
1171  CALL LIRMOT(FORMAT,NbForm,ICHOr,0)
      IF (ICHOr.EQ.1) THEN
        IFORM=1
        ISAFOR=1
        GOTO 1171
      ELSE IF (ICHOr.EQ.2) THEN
        CALL LIRREE(XRET,1,IRetou)
        IF (IERR.NE.0) RETURN
        DIMFIC=XRET
        GOTO 1171
      ELSE IF (ICHOr.EQ.3) THEN
        IFORM=2
        GOTO 1171
      ELSE IF (ICHOr.EQ.4) THEN
        IFORM=0
        GOTO 1171
      ENDIF
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IOSAU=IRET
        IPSAUV=0
        GOTO 1
      ENDIF
      CALL MESLIR(-195)
      CALL LIRCHA(CHA,1,IRetou)
      IF (IERR.NE.0) RETURN
      NOMFIC=CHA
      IUNIT=IOSAU
      IPSAUV=0
      IF (IFORM.EQ.1) GOTO 3201
      IF (IFORM.EQ.2) GOTO 1203
      GOTO 1202
C ---------------
C  Option 'REST'
C ---------------
 118  CONTINUE 
      IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IORES)
        RETURN
      ENDIF
      IFICLE=0
      IFORM=0 
      IREFOR=0
      CALL MESLIR(-193)
 1172 CALL LIRMOT(FORMAT,nbform,ichor,0)
      IF (IERR.NE.0) RETURN
      IF (ICHOr.EQ.1) THEN
       IREFOR=1
       IFORM=1
       GOTO 1172
      ELSE IF (ICHOr.EQ.2) THEN
        GOTO 1172
      ELSE IF (ICHOr.EQ.3) THEN
        IFORM=-2
        GOTO 1172
      ELSEIF (ICHOr.EQ.4) then
        IFORM=0
        GOTO 1172
      ENDIF
      CALL MESLIR(-194)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
        IORES=IRET
        GOTO 1
      ENDIF
      CALL LIRCHA(CHA,1,IRetou)
      IF (IERR.NE.0) RETURN
      IUNIT=IORES
      NOMRES=CHA
*  test sur le type de fichier
      CLOSE(UNIT=IUNIT)
      L=LONG(CHA)
      IFORM=1
      IREFOR=1
      IFIOLD=599
      OPEN(UNIT=IUNIT,STATUS='OLD',FILE=CHA(1:L),
     .     IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
      IF (IOS.EQ.0) THEN
        iretou=0
        iquoi=0
        CALL LFCDES(IORES,IQUOI,IRETOU,IFORM)
*       WRITE(IOIMP,*) 'apres lfcdes-1 ',iores,iquoi,iretou,iform
        IF (IOS.EQ.0.AND.(IQUOI.GT.0.AND.IQUOI.LT.10).AND.
     .      IRETOU.EQ.0) THEN
          CALL ERREUR(-342)
          GOTO 3250
        ENDIF
      ENDIF
      IFORM=0
      IREFOR=0
      CLOSE(UNIT=IUNIT)
      OPEN(UNIT=IUNIT,STATUS='OLD',FILE=CHA(1:L),
     .     IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
      IF (IOS.EQ.0) THEN
        iretou=0
        iquoi=0
        CALL LFCDES (IORES,IQUOI,IRETOU,IFORM)
*       WRITE (IOIMP,*) 'apres lfcdes-2 ',iores,iquoi,iretou,iform
        IF (IOS.EQ.0.AND.(IQUOI.GT.0.AND.IQUOI.LT.10).AND.
     .      IRETOU.EQ.0) THEN
          CALL ERREUR(-343)
          GOTO 3250
        ENDIF
      ENDIF
      IFORM=2
      IF (ixdrr.NE.0) IOS=IXDRCLOSE(ixdrr,.TRUE.)
      ios=initxdr(CHA(1:L),'r',.TRUE.)
      IF (ios.lt.0) GOTO 2000
      ixdrr=ios
      ios=IXDRSTRING(ixdrr,ICHA(1:10))
*     WRITE(IOIMP,*) ' option rest ',icha(1:10),ios
      IF (IOS.GE.0.AND.ICHA(1:10).EQ.'CASTEM XDR') THEN
*       WRITE (IOIMP,*) ' on va direct en 1 '
        IFORM=2
        iformx=IFORM
        CALL ERREUR(-344)
        GOTO 1
      ENDIF
      IFIOLD=424
      GOTO 2000
 3250 iformx=IFORM
      IF (IFORM.EQ.1) GOTO 2201
      IF (IFORM.EQ.-2) GOTO 2203
      GOTO 2202
C ---------------
C  Option 'ISOV'
C ---------------
 119  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MISO(ISOTYP+1))
        RETURN
      ENDIF
      CALL MESLIR(-192)
      CALL LIRMOT(MISO,NbIso,IRET,1)
      IF (IRET.LE.0) CALL ERREUR(36)
      IF (IERR.NE.0) RETURN
      ISOTYP=IRET-1
      ICHA=MISO(IRET)
      GOTO 1
C ---------------
C  Option 'OMBRE'
C ---------------
 120  IF (ICHOI.EQ.2) THEN
        LOG=.FALSE.
        IF (IOMBRE.EQ.1) LOG =.TRUE.
        CALL ECRLOG(LOG)
        RETURN
      ENDIF
      CALL MESLIR(-191)
      CALL LIRLOG(LOG,1,IRET)
      IF (IERR.NE.0) RETURN
      IF (LOG) THEN
        IOMBRE=1
      ELSE
        IOMBRE=0
      ENDIF
      GOTO 1
C ---------------
C  Option 'NBP '
C ---------------
 121  IF (ICHOI.EQ.2) THEN
        IRET=XCOOR(/1)/(IDIM+1)
        CALL ECRENT(IRET)
        RETURN
      ENDIF
      CALL MESLIR(-190)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      NBPTS=MAX(0,IRET)
      SEGADJ MCOORD
      GOTO 1
C ---------------
C  Option 'VERI'
C ---------------
 122  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOSPI)
        RETURN
      ENDIF
      CALL MESLIR(-189)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      IOSPI=IRET
      GOTO 1
C ---------------
C  Option 'ZERO'
C ---------------
 123  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IZROSF)
        RETURN
      ENDIF
      CALL MESLIR(-188)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
      IZROSF=MAX(1,IRET)
      GOTO 1
C ---------------
C  Option 'ACQU'
C ---------------
 124  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IOACQ)
        RETURN
      ENDIF
      CALL MESLIR(-187)
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IOACQ=IRET
        GOTO 1
      ENDIF
      CALL MESLIR(-186)
      CALL LIRCHA(CHA,1,IRetou)
      IUNIT=IOACQ
      GOTO 1201
C ---------------
C  Option '----'
C ---------------
 125  CONTINUE
      GOTO 1
C ---------------
C  Option 'PLAC'
C ---------------
 126  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IPLLB)
        RETURN
      ENDIF
      CALL MESLIR(-184)
      CALL LIRENT(IRET,1,IRetou)
      IF (IERR.NE.0) RETURN
C  Pourquoi mettre IPLLB en positif ?
C  N'etant pas sur de la valeur de IPLTOT il faut pouvoir le mettre
C  en negatif tres grand (voir T.C.)
C     IRET=MAX(1,IRET)
      IPLLB=IRET
      GOTO 1
C ---------------
C  Option 'LANG'
C ---------------
 127  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA (LANGUE)
        RETURN
      ENDIF
      CALL LIRCHA(ICHA,1,IRetou)
      IF (IERR.NE.0) RETURN
      LANGUE=ICHA
      GOTO 1
C ---------------
C  Option 'NORM'
C ---------------
 128  IF (ICHOI.EQ.2) THEN
        CALL ERREUR(758)
        RETURN
      ENDIF
C  On commence par une remise a plat : tout a 0 .
C  On devrait liberer la place occupee eventuellement par ces segments,
C  mais comme on a fait SAVSEG avant. Il faudrait aussi les enlever de
C  la liste des non-effacables, mais comment ?
      NORINC=0
      NORVAL=0
      NORIND=0
      NORVAD=0
C  Lecture des mts cles eventuels
      CALL LIRMOT(NAUTO,NbAuto,i,0)
      IF (i.EQ.2) GOTO 1
C  Normalisation automatique
      IF (i.EQ.1) THEN
        NORINC=-1
        GOTO 1
      ENDIF
      CALL LIROBJ('LISTMOTS',NORINC,1,IRetou)
      CALL LIROBJ('LISTREEL',NORVAL,1,IRetou)
      IF (IERR.NE.0) THEN
        NORINC=0
        NORVAL=0
        GOTO 1
      ENDIF
      MLREEL=NORVAL
      MLMOTS=NORINC
      SEGACT MLREEL,MLMOTS
      NRE=PROG(/1)
      NMO=MOTS(/2)
      SEGDES MLREEL,MLMOTS
      IF (NRE.NE.NMO) THEN
        CALL ERREUR(212)
        NORINC=0
        NORVAL=0
        RETURN
      ENDIF
C  Verification s'il n'y a pas de 'LX' la dedans
C  La taille de mots doit etre OK si le LISTMOTS est cree par MOTS
      SEGACT MLMOTS
      DO i=1,NMO
        IF (MOTS(i)(1:4).EQ.'LX  ') THEN
          CALL ERREUR( 759 )
          NORINC=0
          NORVAL=0
          SEGDES MLMOTS
          RETURN
        ENDIF
      ENDDO
      SEGDES MLMOTS
      CALL SAVSEG(MLREEL)
      CALL SAVSEG(MLMOTS)
      CALL LIROBJ('LISTMOTS',NORIND,0,IRetou)
      IF (IRetou.EQ.0) GOTO 1
      CALL LIROBJ('LISTREEL',NORVAD,1,IRetou)
      IF (IERR.NE.0) THEN
        NORIND=0
        NORVAD=0
      ENDIF
      MLREEL=NORVAD
      MLMOTS=NORIND
      SEGACT MLREEL,MLMOTS
      NRE=PROG(/1)
      NMO=MOTS(/2)
      SEGDES MLREEL,MLMOTS
      IF (NRE.NE.NMO) THEN
        CALL ERREUR(212)
        NORIND=0
        NORVAD=0
        RETURN
      ENDIF
      CALL SAVSEG(MLREEL)
      CALL SAVSEG(MLMOTS)
      GOTO 1
C ---------------
C  Option 'RESO'
C ---------------
 129  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MRESOL(NUCROU+1))
        RETURN
      ENDIF
      CALL MESLIR(-187)
      CALL LIRMOT(MRESOL,NbReso,IRetou,1)
      IF (IERR.NE.0) RETURN
       NUCROU=IRetou-1
      GOTO 1
C ---------------
C  Option 'FTRA'
C ---------------
 130  IF (iogra.ge.7.and.iogra.le.9) THEN
        ZINIPS=.TRUE.
        CALL MESLIR(-209)
        CALL LIRCHA(CHA,1,IRetou)
        IF (IOGRA.EQ.8) THEN
          IUPS=97
        ELSE
          IUPS=24
        ENDIF
        IUNIT=IUPS
        GOTO 1211
      ELSE
        CALL ERREUR(26)
        RETURN
      ENDIF
      GOTO 1
C ---------------
C  Option 'OEIL'
C ---------------
 131  IF (ICHOI.EQ.2) THEN
        IF (IOEIL.NE.0) CALL ECROBJ('POINT',IOEIL)
        RETURN
      ENDIF
      CALL LIROBJ('POINT',IOEIL,1,IRetou)
      GOTO 1
C ---------------
C  Option 'ERMA'
C ---------------
 132  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IERMAX)
      ENDIF
      GOTO 1
C ---------------
C  Option 'ASSI'
C ---------------
 133  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(NBESC)
        RETURN
      ENDIF
      IF (NBESC.NE.0) CALL ERREUR(892)
      IF (IERR.NE.0) RETURN
      CALL LIRENT(IRET,0,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LT.0) CALL ERREUR(36)
        IF (IRET.GT.512) CALL ERREUR(36)
        CALL INIASS(IRET)
        NBESC=IRET
      ENDIF
      GOTO 1
C ---------------
C  Option 'EPTR'
C ---------------
 134  IF (ICHOI.EQ.2) THEN
        CALL ECRENT(IEPTR)
        RETURN
      ENDIF
      CALL MESLIR(-340)
      CALL LIRENT(IRET,1,IRetou)
      IF (IRetou.NE.0) THEN
        IF (IRET.LT.0) CALL ERREUR(36)
        IEPTR=IRET
      ENDIF
      GOTO 1
C ---------------
C  Option 'NAVI'
C ---------------
 135  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(NNAVI(ILNAVI))
        RETURN
      ENDIF
      CALL MESLIR(-341)
      CALL LIRMOT(NNAVI,LNNAVI,IRET,1)
      IF (IERR.NE.0) RETURN
      IF (IRET.LE.0) CALL ERREUR(36)
      ILNAVI=IRET
      ICHA=NNAVI(ILNAVI)
      GOTO 1
C
C  option PARA
C
  136 IF( ICHOI.EQ.2) THEN
        if(lupara.eq.1) then
          call ecrlog(.TRUE.)
        else 
          call ecrlog (.FALSE.)
        endif
        RETURN
      ELSE
        CALL LIRlog(log,1,iretou)
        IF (Ierr.NE.0) return
        LUPARA=0
        if(log) lupara=1
      ENDIF
      GO TO 1 
  137 CONTINUE
      CALL LIRENT(msur,1,iretou)
      if(ierr.ne.0) return
      CALL OOOSUR(MSUR)
      GO TO 1
C ---------------
C  Option 'POLI'
C ---------------
 138  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MPOLI(IOPOLI))
        RETURN
      ENDIF
      CALL MESLIR(-211)
      CALL LIRMOT(MPOLI,NbPoli,ij,1)
      IF (IERR.NE.0) RETURN
      IOPOLI=ij
      GOTO 1
C ---------------
C  Option 'COSC'
C ---------------
 139  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MCOSC(ICOSC))
        RETURN
      ENDIF
      CALL MESLIR(-211)
      CALL LIRMOT(MCOSC,NbCosc,ij,1)
      IF (IERR.NE.0) RETURN
      ICOSC=ij
      GOTO 1        
C ---------------
C  Option 'POTR'
C ---------------
 140  IF (ICHOI.EQ.2) THEN
        CALL ECRCHA(MPOTR(IOPOTR))
        RETURN
      ENDIF
      CALL MESLIR(-211)
      CALL LIRMOT(MPOTR,NbPotr,ij,1)
      IF (IERR.NE.0) RETURN
      IOPOTR=ij
      GOTO 1
C ----------------
C    option debug
C ----------------
  141 IF (ICHOI.EQ.2) THEN
         call ecrent (misaup)
         return
      ENDIF
      CALL LIRENT(MISAUP,1,iretou)
      IF(IERR.NE.0) RETURN
      GO TO 1
C ----------------
C    option 'LOCA'
C ----------------
  142 IF (ICHOI.EQ.2) THEN
         CALL ECRLOG(ZLOPRO)
         RETURN
      ENDIF
      CALL LIRLOG(ZLOPRO,1,IRETOU)
      IF (IERR.NE.0) RETURN
      GO TO 1
C -----------------
C  Fin des Options
C -----------------

C  Ouverture de fichier
C ----------------------
C  Option 'SGBD'
 1200 IF (IERR.NE.0) RETURN
      CLOSE (UNIT=IUNIT)
      L=LONG(CHA)
      IFIOLD=424
      OPEN (UNIT=IUNIT,STATUS='UNKNOWN',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000)
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Options 'DONN','LECT','ACQU'
C  Verification de l'existence du fichier lors de son ouverture
 1201 IF (IERR.NE.0) RETURN
      CLOSE (UNIT=IUNIT)
      L=LONG(CHA)
      IFIOLD=599
      OPEN (UNIT=IUNIT,STATUS='OLD',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Options 'IMPR','FTRA','SORT'
 1211 IF (IERR.NE.0) RETURN
      CLOSE (UNIT=IUNIT)
      L=LONG(CHA)
      IFIOLD=424
      OPEN (UNIT=IUNIT,STATUS='UNKNOWN',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Option 'SAUV' 'FORMAT'
 3201 IF (IERR.NE.0) RETURN
      CLOSE (UNIT=IUNIT)
      if (ixdrw.NE.0) ios=IXDRCLOSE( ixdrw,.TRUE. )
      ixdrw=0
      iformx=iform
      L=LONG(CHA)
      IFIOLD=424
      OPEN (UNIT=IUNIT,STATUS='UNKNOWN',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Option 'REST' 'FORMAT'
 2201 IF (IERR.NE.0) RETURN
      CLOSE (UNIT=IUNIT)
      if (ixdrr.NE.0) ios=IXDRCLOSE( ixdrr,.TRUE. )
      ixdrr=0
      iformx=iform
      L=LONG(CHA)
      IFIOLD=599
      OPEN (UNIT=IUNIT,STATUS='OLD',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Option 'SAUV' 'BINA' (format binaire)
 1202 IF (IERR.NE.0) RETURN
*     WRITE(IOIMP,*) ' sauv en binaire'
      CLOSE (UNIT=IUNIT)
      if (ixdrw.NE.0) ios=IXDRCLOSE( ixdrw,.TRUE. )
      iformx=iform
      ixdrw=0
      L=LONG(CHA)
      IFIOLD=424
      OPEN (UNIT=IUNIT,STATUS='UNKNOWN',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Options        'REST' ('BINA') (format binaire)
 2202 IF (IERR.NE.0) RETURN
*     WRITE(IOIMP,*) ' rest en binaire'
      CLOSE (UNIT=IUNIT)
      if (ixdrr.NE.0) ios=IXDRCLOSE( ixdrr,.TRUE. )
      iformx=iform
      ixdrr=0
      L=LONG(CHA)
      IFIOLD=599
      OPEN (UNIT=IUNIT,STATUS='OLD',FILE=CHA(1:L),
     .      IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
      IF (IOS.NE.0) GOTO 2000
      GOTO 1
C  Options 'SAUV' ('XDR')       (format XDR)
 1203 IF (IERR.NE.0) RETURN
      IF (ixdrw.NE.0) ios=IXDRCLOSE( ixdrw,.TRUE. )
      ixdrw=0
      L=LONG(CHA)
      IFIOLD=424
      IF (iform.GT.0) THEN
        ios=initxdr(CHA(1:L),'w',.TRUE.)
        if (ios.LT.0) GOTO 2000
        ixdrw=ios
        ICHA(1:10)='CASTEM XDR'
        ios=IXDRSTRING( ixdrw,ICHA(1:10))
      ENDIF
      IF (iform.LT.0) THEN
        ios=initxdr(CHA(1:L),'r',.TRUE.)
        ixdrw=ios
      ENDIF
      iform=2
      iformx=iform
      IF (IOS.LT.0) GOTO 2000
      GOTO 1
C  Options        'REST' (format XDR)
 2203 IF (IERR.NE.0) RETURN
      IF (ixdrr.NE.0) ios=IXDRCLOSE( ixdrr,.TRUE. )
      ixdrr=0
      L=LONG(CHA)
      IFIOLD=424
      IF (iform.GT.0) THEN
        ios=initxdr(CHA(1:L),'w',.TRUE.)
        if (ios.LT.0) GOTO 2000
        ixdrr=ios
        ICHA(1:10)='CASTEM XDR'
        ios=IXDRSTRING( ixdrr,ICHA(1:10))
      ENDIF
      IF (iform.LT.0) THEN
        IFIOLD=599
        ios=initxdr(CHA(1:L),'r',.TRUE.)
        ixdrr=ios
      ENDIF
      iform=2
      iformx=iform
      IF (IOS.LT.0) GOTO 2000
      GOTO 1

C Traitement des erreurs d'ouverture des fichiers
 2000 L=LONG(CHA)
      MOTERR=CHA(1:L)
      INTERR(1)=IOS
      CALL ERREUR(424)

      RETURN
      END