      SUBROUTINE ACTPS(NBON,IWAVE,IGOTO)
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_ombreiso.f'
      INCLUDE 'com_options.f'
      DIMENSION    XC(8),YC(8),ZC(8)
      CHARACTER*32 BID
      DATA R2R3 / .8164965809277260 /
      DATA RAC3 / 1.73205080756888  /
C
      IF (ICARRE*ICADPS.LT.0) THEN
        HX = HXA4
        HY = HXA4
      ELSEIF(ICARRE.LT.0.AND.ANGPS.EQ.0.) THEN
        HX = HXA4
        HY = HYA4
      ELSEIF(ICARRE.GT.0.AND.ANGPS.NE.0.) THEN
        HX = HYA4
        HY = HXA4
      ELSEIF(ANGPS.EQ.0.) THEN
        HX = HXA4
        HY = HXA4*HXA4/HYA4
      ELSE
        HX = HXA4*HXA4/HYA4
        HY = HXA4
      ENDIF
      IF (IBATCH.EQ.0) CALL GSPAT(16)
      IF (ICARRE.EQ.1) THEN
        YYLAR = XLARG
      ELSE
        YYLAR = XLARG*HYA4/HXA4
      ENDIF
      IF (ICADPS.GT.0) THEN
        IF (ICARRE.EQ.1) THEN
          XXLAR2 = XLARG*(2.*HYA4/HXA4-1.)
        ELSE
          XXLAR2 = 2.*YYLAR-XLARG
        ENDIF
      ELSE
        XXLAR2 = XLARG
      ENDIF
      I99 = 99
      IF (IDEFPS.GE.8) THEN
        ZERO = 0.
        IF (IBATCH.EQ.0) LONPS = 0
        CALL INITPS(I99,ZERO,ZERO,ANGPS,PROG,LPROG,NOMPS,LONPS,IPOSTCOL)
        IF (LONPS.LT.0) THEN
          IF (IBATCH.EQ.0) THEN
            IGOTO = 5003
            RETURN
          ELSE
            STOP
          ENDIF
        ENDIF
        IF (IBATCH.EQ.0) THEN
          IX0 = IVRAIECOORD(XHELP)
          IX1 = IVRAIECOORD(XDMAX)
          PIXEL = (XDMAX-XHELP)/REAL(IABS(IX0-IX1))
        ELSE
          CALL CALCDIM(YYLAR,1)
          PIXEL = (XDMAX-XHELP)/800.
        ENDIF
        IF (IDEFPS.EQ.8) THEN
          IF (IVIT.LT.0) THEN
            BORPI = PIXEL*30.
          ELSE
            BORPI = PIXEL*5.
          ENDIF
          BORPI2 = BORPI
C XFMIN = BIG si pas de fleche (idem XFMAX,YFMIN,YFMAX)
          XXMIN = XFMIN
          XXMAX = XFMAX
          YYMIN = YFMIN
          YYMAX = YFMAX
          IF (IBOITE.EQ.0) THEN
            DO N=1,NBON
              DO I=1,NDS
                XXMIN = MIN(XXMIN,XX(I,N))
                XXMAX = MAX(XXMAX,XX(I,N))
                YYMIN = MIN(YYMIN,YY(I,N))
                YYMAX = MAX(YYMAX,YY(I,N))
              ENDDO
            ENDDO
          ELSE
            CALL PROBOI(XC,YC,ZC)
            DO I=1,8
              XXMAX = MAX(XXMAX,XBOITE(I))
              XXMIN = MIN(XXMIN,XBOITE(I))
              YYMAX = MAX(YYMAX,YBOITE(I))
              YYMIN = MIN(YYMIN,YBOITE(I))
            ENDDO
            IF (IECBOI.GT.0.AND.MOD(IECBOI,2).EQ.0) THEN
              BORPI  = BORPI*7.
              BORPI2 = BORPI*2.5
            ELSEIF(IECBOI.EQ.1.OR.IECBOI.EQ.3) THEN
              BORPI  = BORPI*3.
              BORPI2 = BORPI
            ENDIF
          ENDIF
          XXMIN = MAX(XXMIN-BORPI2,XHELP)
          XXMAX = MIN(XXMAX+BORPI2,XDMAX)
          YYMIN = MAX(YYMIN-BORPI,YDMIN)
          YYMAX = MIN(YYMAX+BORPI,YDMAX)
          HXMIN = (XXMIN-XHELP)*HX/(XDMAX-XHELP)
          HXMAX = (XXMAX-XHELP)*HX/(XDMAX-XHELP)
          HYMIN = (YYMIN-YDMIN)*HY/(YDMAX-YDMIN)
          HYMAX = (YYMAX-YDMIN)*HY/(YDMAX-YDMIN)
        ELSE
          XXMIN = XDMAX
          XXMAX = XDMA2
          YYMIN = YDMIN
          IF (IINFO.EQ.-2) THEN
            YYMAX = .5*(YDMIN+YDMAX)
          ELSE
            YYMAX = YDMAX
          ENDIF
          HXMIN = (XXMIN-XHELP)*HX/(XDMA2-XHELP)
          HXMAX = (XXMAX-XHELP)*HX/(XDMA2-XHELP)
          HYMIN = (YYMIN-YDMIN)*HY/(YDMAX-YDMIN)
          HYMAX = (YYMAX-YDMIN)*HY/(YDMAX-YDMIN)
        ENDIF
        CALL INITPS2(HX,HY,ANGPS,HXMIN,HXMAX,HYMIN,HYMAX)
        XCADRE(1) = XXMIN
        YCADRE(1) = YYMIN
        YCADRE(2) = YYMAX
        XCADRE(3) = XXMAX
      ELSE
        IF (IBATCH.EQ.0) LONPS = 0
        CALL INITPS(I99,HX,HY,ANGPS,PROG,LPROG,NOMPS,LONPS,IPOSTCOL)
        IF (LONPS.LT.0) THEN
          IGOTO = 5003
          RETURN
        ENDIF
        XCADRE(1) = XCUR-XLARG
        YCADRE(1) = YCUR-YYLAR
        YCADRE(2) = YCUR+YYLAR
        XCADRE(3) = XCUR+XXLAR2
      ENDIF
      IF (IPOSTCOL.EQ.0) THEN
        IF (ILANG.EQ.0) THEN
          CCOU = ' N&B '
        ELSE
          CCOU = ' B&W '
        ENDIF
      ELSE
        IF (ILANG.EQ.0) THEN
          CCOU = ' Coul'
        ELSE
          CCOU = '  Col'
        ENDIF
      ENDIF
      IF (ANGPS.EQ.0.) THEN
        CCOR = ' ^'
      ELSE
        CCOR = ' >'
      ENDIF
      IPOST = -1
      IF (ISO.EQ.0) THEN
        TITRE = NOM_FICH
        LL    = LONG
      ELSE
        IF (NOM_ISO(1:1).EQ.'$') THEN
          TITRE = NOM_FICH(1:LONG)//' - '//NOM_ISO(2:LONISO)
          LL    = LONG + 2 + LONISO
        ELSE
          TITRE = NOM_FICH(1:LONG)//' - '//NOM_ISO(1:LONISO)
          LL    = LONG + 3 + LONISO
        ENDIF
      ENDIF
      IF (IBATCH.EQ.0) THEN
        CALL CHANGE_CURS(5)
        XCADRE(2) = XCADRE(1)
        YCADRE(3) = YCADRE(2)
        XCADRE(4) = XCADRE(3)
        YCADRE(4) = YCADRE(1)
C
        CALL GSLSS(IFONT8)
        XLH = XHELP-XDMIN
        XPTHER = (XDMIN+XHELP)*.5
        YPTHER = YDMI2+XLH*.075
        DXTHER = XLH*.9
        DYTHER = XLH*.1
        LSPS = LONPS+8
        SAUVPS(1:LSPS) = NOMPS(1:LONPS)//CCOU//CCOR
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        CALL THERMOMETRE(SAUVPS,LSPS,XPTHER,YPTHER,DXTHER
     &                  ,DYTHER,0,0,15,7,8,0,IBORDTHERMO,IRC)
C
        IF (ITERMC.EQ.4) THEN
          CALL GSCOL(2)
        ELSE
          CALL TABCOL(-7017,IWAVE)
          CALL GSCOL(16)
        ENDIF
        CALL GSLW(IEPBOR)
        CALL GSLT(1)
        CALL GSBND(XCADRE(1),XCADRE(3),YCADRE(1),YCADRE(3))
        CALL GSPLNEC(4,XCADRE,YCADRE)
        CALL GSLT(0)
        CALL GSLW(0)
        CALL GSBND(XDMIN,XHELP,YDMI2,YDMAX)
        CALL x11press
      ENDIF
C
C Commentaires dans le ps
C
      IF (NOMPS(1:1).EQ.'-'.AND.LONPS.EQ.1) THEN
        IO = 6
      ELSE
        IO = 99
      ENDIF
C
C Francais
C
      IF (IPERSP.EQ.1) THEN
        FAFA = R2R3
      ELSE
        FAFA = .5*RAC3
      ENDIF
      IF (ILANG.EQ.0) THEN
        IF (IDSEUL.LE.1) THEN
          WRITE(IO,'(A,G13.5," x",G13.5)')
     &         '%> Dimensions reelles     : '
     &         ,FAFA*(XCADRE(3)-XCADRE(1))
     &         ,FAFA*(YCADRE(3)-YCADRE(1))
          IF (NOM_FICH(1:5).EQ.'/tmp/'
     &         .AND.NOM_FICH(LONG:LONG).EQ.'D') THEN
            IF (INOPO.EQ.1) THEN
              WRITE(IO,'(A)') '%> Maillage               : '
     &             //NOM_FICH(6:LONG-7)//'nopo'
            ELSEIF(INOPO.EQ.2) THEN
              WRITE(IO,'(A)') '%> Maillage               : '
     &             //NOM_FICH(6:LONG-7)//'amdba'
            ELSEIF(INOPO.EQ.3) THEN
              WRITE(IO,'(A)') '%> Maillage               : '
     &             //NOM_FICH(6:LONG-7)//'am'
            ELSEIF(INOPO.EQ.4) THEN
              WRITE(IO,'(A)') '%> Maillage               : '
     &             //NOM_FICH(6:LONG-7)//'am_fmt'
            ELSE
              WRITE(IO,'(A)') '%> Maillage               : '
     &             //NOM_FICH(6:LONG-7)//'msh'
            ENDIF
          ELSE
            WRITE(IO,'(A)')
     &           '%> Maillage               : '//NOM_FICH(1:LONG)
          ENDIF
          IF (IDSEUL.EQ.1) WRITE(IO,'(A)')'%> Dessin seul.'
          IF (LONTIT.GT.0) WRITE(IO,'(A)')
     &         '%> Titre                  :"'//TITAV(1:LONTIT)//'"'
          IF (ISO.NE.0.OR.NSURF.GT.0) THEN
            IF (NOM_ISO(2:13).EQ.'Comparaison (') THEN
              WRITE(IO,'(A)')'%> Comparaison de fichiers scalaires : '
     &             //NOM_C1(1:LONC1)//' - '//NOM_C1(1:LONC1)
            ELSEIF(NOM_ISO(1:1).EQ.'$') THEN
              WRITE(IO,'(A)')
     &             '%> Champ scalaire auto    : '//NOM_ISO(2:LONISO)
            ELSE
              WRITE(IO,'(A)')
     &             '%> Fichier scalaire       : '//NOM_ISO(1:LONISO)
            ENDIF
          ENDIF
          IF (IVIT.LT.0) WRITE(IO,'(A)')
     &         '%> Fichier vectoriel      : '//NOM_VIT(1:LONVIT)
          WRITE(IO,'(A)')'%> Types d''elements       : '
     &         //ELEMENTS(1:LELEM)
          WRITE(IO,'(A,I8)')'%> Nombre de noeuds       :',NUMNP
          WRITE(IO,'(A,I8)')'%> Nombre d''elements      :',NEL
          IF (I2D.EQ.0)
     &         WRITE(IO,'(A,I8)')'%> Nombre de faces        :',NFACE
          WRITE(IO,'(A,I8)')'%> Nombre de sous-domaines:',NUMSD
          IF (NRECON.GT.1) THEN
            IF (ISYM.EQ.4) THEN
              IF (NRECON.EQ.2) THEN
                WRITE(IO,'(A)')'%> Symetrisation / Ox'
              ELSEIF(NRECON.EQ.3) THEN
                WRITE(IO,'(A)')
     &               '%> Symetrisation / Ox et Oy (3/4 de domaine)'
              ELSE
                WRITE(IO,'(A)')
     &               '%> Symetrisation / Ox et Oy (4/4 de domaine)'
              ENDIF
            ELSE
              WRITE(IO,'(A,I3,A,I3)')
     &             '%> Symetrie d''ordre',ISYM,', reconstitution',NRECON
            ENDIF
          ENDIF
          IF (NUMSD.GT.1) THEN
            ITOUS = 0
            DO I=1,NUMSD
              IF (ISDVU(I).EQ.0) ITOUS = ITOUS+1
            ENDDO
            IF (ITOUS.EQ.0) THEN
              WRITE(IO,'(A)') '%> Sous-domaines traces   : Tous'
            ELSE
              WRITE(BID(1:9),'(I4,"/",I4)') NUMSD-ITOUS,NUMSD
              II = 0
              DO I=1,9
                IF (BID(I:I).NE.' ') THEN
                  II = II+1
                  BID(II:II) = BID(I:I)
                ENDIF
              ENDDO
              WRITE(IO,'(A,$)')
     &             '%> Sous-domaines traces ('//BID(1:II)//') : '
              II = 0
              DO I=1,NUMSD
                IF (ISDVU(I).EQ.1) THEN
                  IF (II.GT.0) WRITE(IO,'(","$)')
                  IF (I.LT.10) THEN
                    WRITE(IO,'(I1,$)') I
                  ELSEIF(I.LT.100) THEN
                    WRITE(IO,'(I2,$)') I
                  ELSE
                    WRITE(IO,'(I4,$)') I
                  ENDIF
                  II = II+1
                ENDIF
              ENDDO
              WRITE(IO,'(" ")')
            ENDIF
          ENDIF
          IF (IEXAG.NE.0) THEN
            IF (ICOURB.GT.0.AND.FACEXA.NE.1.) THEN
              WRITE(IO,'(A,G8.2)')'%> Exageration            :',FACEXA
            ELSEIF(ICOURB.LT.0.AND.
     &             (FACEXAX.NE.1.
     &             .OR.FACEXAY.NE.1.
     &             .OR.FACEXAZ.NE.1.) ) THEN
              WRITE(IO,'(A,G8.2)')'%> Exageration en X       :',FACEXAX
              WRITE(IO,'(A,G8.2)')'%> Exageration en Y       :',FACEXAY
              WRITE(IO,'(A,G8.2)')'%> Exageration en Z       :',FACEXAZ
            ENDIF
          ENDIF
          IF (NSURF.GT.0) THEN
            IF (ICALSU.EQ.0) THEN
              WRITE(IO,'(A,G8.2)')'%> Isosurface             =',VISO
            ELSEIF(ICALSU.EQ.1) THEN
              WRITE(IO,'(A,G8.2)')'%> Isosurface            <=',VISO
            ELSE
              WRITE(IO,'(A,G8.2)')'%> Isosurface            >=',VISO
            ENDIF
          ENDIF
        ELSE
          WRITE(IO,'(A)')'%> Table de couleurs toute seule'
        ENDIF
        IF (ISO.NE.0.OR.VITCOUL) THEN
          WRITE(IO,'(A,I8)') '%> Nombre d''isovaleurs    :',NBCOL
          WRITE(IO,'(A,2G15.7)') '%> Bornes des isovaleurs  :',VMIN,VMAX
        ELSE
          WRITE(IO,'(A,I8)') '%> Nombre de couleurs     :',NBCOL
        ENDIF
        IF (ITABLE.EQ.51.OR.ITABLE.EQ.52) THEN
          WRITE(IO,'(A)') '%> Table de couleurs      :      51 (perso)'
          WRITE(IO,'(A,3I4,A,3I4)')    '%> RVB ---> RVB           :'
     &         ,IROUGE0,IVERT0,IBLEU0,' --->',IROUGE1,IVERT1,IBLEU1
        ELSE
          WRITE(IO,'(A,I8)') '%> Table de couleurs      :',ITABLE
        ENDIF
        IF (IDSEUL.LE.1) THEN
          WRITE(IO,'(A,I8)') '%> Direction des lumieres :',IDIRL
          IF (IPERSP.EQ.1) THEN
            WRITE(IO,'(A)') '%> Perspective            : isometrique'
          ELSEIF(IPERSP.EQ.-1) THEN
            WRITE(IO,'(A)') '%> Perspective            : lointaine'
          ELSEIF(IPERSP.EQ.-2) THEN
            WRITE(IO,'(A)') '%> Perspective            : moyenne'
          ELSEIF(IPERSP.EQ.-3) THEN
            WRITE(IO,'(A)') '%> Perspective            : proche'
          ENDIF
          CALL ARC(ANGX,ANGY,ANGZ)
          WRITE(IO,'(A,3F7.1)') '%> Position angulaire     :'
     &         ,ANGX,ANGY,ANGZ
          ZOOM = XLAREF/XLARG
          PETIT = 1.E-3
          IF (ABS(ZOOM-1.).GT.PETIT) THEN
            WRITE(BID,'(F7.3)') ZOOM
            CALL ENLEVE_TOUS_BLANCS(BID,L,7)
            WRITE(IO,'(A)') '%> Facteur de zoom        = '//BID(1:L)
          ENDIF
          IF (ABS((XCUR-XCUREF)/XLARG).GT.PETIT) THEN
            WRITE(BID,'(F9.4)') XCUR
            CALL ENLEVE_TOUS_BLANCS(BID,L,9)
            WRITE(IO,'(A)') '%> Centre du cadrage X    = '//BID(1:L)
          ENDIF
          IF (ABS((YCUR-YCUREF)/XLARG).GT.PETIT) THEN
            WRITE(BID,'(F9.4)') YCUR
            CALL ENLEVE_TOUS_BLANCS(BID,L,9)
            WRITE(IO,'(A)') '%> Centre du cadrage Y    = '//BID(1:L)
          ENDIF
C
        ENDIF
C
C Anglais
C
      ELSE
        IF (IDSEUL.LE.1) THEN
          WRITE(IO,'(A,G13.5," x",G13.5)')
     &         '%> Real dimensions        : '
     &         ,FAFA*(XCADRE(3)-XCADRE(1))
     &         ,FAFA*(YCADRE(3)-YCADRE(1))
          IF (NOM_FICH(1:5).EQ.'/tmp/'
     &         .AND.NOM_FICH(LONG:LONG).EQ.'D') THEN
            IF (INOPO.EQ.1) THEN
              WRITE(IO,'(A)') '%> Mesh                   : '
     &             //NOM_FICH(6:LONG-7)//'nopo'
            ELSEIF(INOPO.EQ.2) THEN
              WRITE(IO,'(A)') '%> Mesh                   : '
     &             //NOM_FICH(6:LONG-7)//'amdba'
            ELSEIF(INOPO.EQ.3) THEN
              WRITE(IO,'(A)') '%> Mesh                   : '
     &             //NOM_FICH(6:LONG-7)//'am'
            ELSEIF(INOPO.EQ.4) THEN
              WRITE(IO,'(A)') '%> Mesh                   : '
     &             //NOM_FICH(6:LONG-7)//'am_fmt'
            ELSE
              WRITE(IO,'(A)') '%> Mesh                   : '
     &             //NOM_FICH(6:LONG-7)//'msh'
            ENDIF
          ELSE
            WRITE(IO,'(A)')
     &           '%> Mesh                   : '//NOM_FICH(1:LONG)
          ENDIF
          IF (IDSEUL.EQ.1) WRITE(IO,'(A)')'%> Picture alone'
          IF (LONTIT.GT.0) WRITE(IO,'(A)')
     &         '%> Title                  :"'//TITAV(1:LONTIT)//'"'
          IF (ISO.NE.0.OR.NSURF.GT.0) THEN
            IF (NOM_ISO(2:13).EQ.'Comparison (') THEN
              WRITE(IO,'(A)')'%> Comparison of scalar datas        : '
     &             //NOM_C1(1:LONC1)//' - '//NOM_C1(1:LONC1)
            ELSEIF(NOM_ISO(1:1).EQ.'$') THEN
              WRITE(IO,'(A)')
     &             '%> Auto scalar field      : '//NOM_ISO(2:LONISO)
            ELSE
              WRITE(IO,'(A)')
     &             '%> Scalar data file       : '//NOM_ISO(1:LONISO)
            ENDIF
          ENDIF
          IF (IVIT.LT.0) WRITE(IO,'(A)')
     &         '%> Vector file            : '//NOM_VIT(1:LONVIT)
          WRITE(IO,'(A)')'%> Types of elements      : '
     &         //ELEMENTS(1:LELEM)
          WRITE(IO,'(A,I8)')'%> Number of nodes        :',NUMNP
          WRITE(IO,'(A,I8)')'%> Number of elements     :',NEL
          IF (I2D.EQ.0)
     &         WRITE(IO,'(A,I8)')'%> Number of facets       :',NFACE
          WRITE(IO,'(A,I8)')'%> Number of subdomains   :',NUMSD
          IF (NRECON.GT.1) THEN
            IF (ISYM.EQ.4) THEN
              IF (NRECON.EQ.2) THEN
                WRITE(IO,'(A)')'%> Symmetry / Ox'
              ELSEIF(NRECON.EQ.3) THEN
                WRITE(IO,'(A)')
     &               '%> Symmetry / Ox and Oy (3/4 of domain)'
              ELSE
                WRITE(IO,'(A)')
     &               '%> Symmetry / Ox and Oy (4/4 of domain)'
              ENDIF
            ELSE
              WRITE(IO,'(A)')
     &             '%> Symmetry of order',ISYM,', reconstitution',NRECON
            ENDIF
          ENDIF
          IF (NUMSD.GT.1) THEN
            ITOUS = 0
            DO I=1,NUMSD
              IF (ISDVU(I).EQ.0) ITOUS = ITOUS+1
            ENDDO
            IF (ITOUS.EQ.0) THEN
              WRITE(IO,'(A)') '%> Displayed subdomains   : All'
            ELSE
              WRITE(BID(1:9),'(I4,"/",I4)') NUMSD-ITOUS,NUMSD
              II = 0
              DO I=1,9
                IF (BID(I:I).NE.' ') THEN
                  II = II+1
                  BID(II:II) = BID(I:I)
                ENDIF
              ENDDO
              WRITE(IO,'(A,$)')
     &             '%> Displayed subdomains ('//BID(1:II)//') : '
              II = 0
              DO I=1,NUMSD
                IF (ISDVU(I).EQ.1) THEN
                  IF (II.GT.0) WRITE(IO,'(","$)')
                  IF (I.LT.10) THEN
                    WRITE(IO,'(I1,$)') I
                  ELSEIF(I.LT.100) THEN
                    WRITE(IO,'(I2,$)') I
                  ELSE
                    WRITE(IO,'(I4,$)') I
                  ENDIF
                  II = II+1
                ENDIF
              ENDDO
              WRITE(IO,'(" ")')
            ENDIF
          ENDIF
          IF (IEXAG.NE.0) THEN
            IF (ICOURB.GT.0.AND.FACEXA.NE.1.) THEN
              WRITE(IO,'(A,G8.2)')'%> Exageration            :',FACEXA
            ELSEIF(ICOURB.LT.0.AND.
     &             (FACEXAX.NE.1.
     &             .OR.FACEXAY.NE.1.
     &             .OR.FACEXAZ.NE.1.) ) THEN
              WRITE(IO,'(A,G8.2)')'%> Exageration along X    :',FACEXAX
              WRITE(IO,'(A,G8.2)')'%> Exageration along Y    :',FACEXAY
              WRITE(IO,'(A,G8.2)')'%> Exageration along Z    :',FACEXAZ
            ENDIF
          ENDIF
          IF (NSURF.GT.0) THEN
            IF (ICALSU.EQ.0) THEN
              WRITE(IO,'(A,G8.2)')'%> Isosurface             =',VISO
            ELSEIF(ICALSU.EQ.1) THEN
              WRITE(IO,'(A,G8.2)')'%> Isosurface            <=',VISO
            ELSE
              WRITE(IO,'(A,G8.2)')'%> Isosurface            >=',VISO
            ENDIF
          ENDIF
        ELSE
          WRITE(IO,'(A)')'%> Color table alone'
        ENDIF
        IF (ISO.NE.0.OR.VITCOUL) THEN
          WRITE(IO,'(A,I8)') '%> Number of contours     :',NBCOL
          WRITE(IO,'(A,2G15.7)') '%> Bounds of contour plot :',VMIN,VMAX
        ELSE
          WRITE(IO,'(A,I8)') '%> Number of colors       :',NBCOL
        ENDIF
        IF (ITABLE.EQ.51.OR.ITABLE.EQ.52) THEN
          WRITE(IO,'(A)') '%> Color table            :      51 (perso)'
          WRITE(IO,'(A,3I4,A,3I4)')    '%> RGB ---> RGB           :'
     &         ,IROUGE0,IVERT0,IBLEU0,' --->',IROUGE1,IVERT1,IBLEU1
        ELSE
          WRITE(IO,'(A,I8)') '%> Color table            :',ITABLE
        ENDIF
        IF (IDSEUL.LE.1) THEN
          WRITE(IO,'(A,I8)') '%> Direction of lightning :',IDIRL
          IF (IPERSP.EQ.1) THEN
            WRITE(IO,'(A)') '%> Perspective            : isometric'
          ELSEIF(IPERSP.EQ.-1) THEN
            WRITE(IO,'(A)') '%> Perspective            : faraway'
          ELSEIF(IPERSP.EQ.-2) THEN
            WRITE(IO,'(A)') '%> Perspective            : medium'
          ELSEIF(IPERSP.EQ.-3) THEN
            WRITE(IO,'(A)') '%> Perspective            : close'
          ENDIF
          CALL ARC(ANGX,ANGY,ANGZ)
          WRITE(IO,'(A,3F7.1)') '%> Angular position       :'
     &         ,ANGX,ANGY,ANGZ
          ZOOM = XLAREF/XLARG
          PETIT = 1.E-3
          IF (ABS(ZOOM-1.).GT.PETIT) THEN
            WRITE(BID,'(F7.3)') ZOOM
            CALL ENLEVE_TOUS_BLANCS(BID,L,7)
            WRITE(IO,'(A)') '%> Zoom coefficient       = '//BID(1:L)
          ENDIF
          IF (ABS((XCUR-XCUREF)/XLARG).GT.PETIT) THEN
            WRITE(BID,'(F9.4)') XCUR
            CALL ENLEVE_TOUS_BLANCS(BID,L,9)
            WRITE(IO,'(A)') '%> Crop center X coord.   = '//BID(1:L)
          ENDIF
          IF (ABS((YCUR-YCUREF)/XLARG).GT.PETIT) THEN
            WRITE(BID,'(F9.4)') YCUR
            CALL ENLEVE_TOUS_BLANCS(BID,L,9)
            WRITE(IO,'(A)') '%> Crop center Y coord.   = '//BID(1:L)
          ENDIF
        ENDIF
      ENDIF
C
      CALL ECOPT(IO)
C
      IFONT0 = 0
      IFONT1 = 1
      IFONT2 = 2
      IFONT3 = 3
      IFONT4 = 4
      IFONT5 = 5
      IFONT7 = 7
      IFONT8 = 8
      IEPBOR0 = IEPBOR
      IEPBOR = 6
      CALL INPRFD(I99,.FALSE.,.FALSE.,SIG,HX,HY,ANGPS,TITRE,LL,IPOSTCOL)
      IF (IBATCH.NE.0) THEN
        IF (ITABLE.GT.2) THEN
          IIII = -100000-NBCOL
        ELSE
          CALL CHNBCOL(NBCOL,NVAL,1,ITABLE)
          IIII = -100000-NVAL
        ENDIF
        CALL TABCOL(IIII,IWAVE)
      ENDIF
      IMULSAUV = IMUL
      CALL COMPLTABPS(IMUL,NBCOL)
      IGOTO = 5001
      END
C=======================================================================
      SUBROUTINE ACTISO(ISOINI,NBCOUL,IWAVE,IGOTO)
      INCLUDE 'com_options.f'
C
      IF (IFISO.NE.0) THEN
        IF (ICENTR.NE.0) THEN
          IF (ISO.EQ.3) THEN
            ICENTRISO = 0
            ISO = 1
          ELSEIF(ISO.EQ.0) THEN
            ISO = 3
          ELSEIF(ICENTRISO.EQ.0) THEN
            ICENTRISO = 1
          ELSE
            ICENTRISO = 0
            IF (ISO.EQ.2) THEN
              IF (IVALMAR.EQ.0) THEN
                IVALMAR = 1
              ELSE
                IVALMAR = 0
                ISO = 0
                ICADPS = -1
                ANGPS = 0.
                CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,1
     &                    ,ILANG)
cc              IREFRE = 1
              ENDIF
            ELSE
              IF (ISOFRO.EQ.0) THEN
                ISOFRO = 1
              ELSE
                IF (IVALMAR.EQ.0) THEN
                  IVALMAR = 1
                ELSE
                  IVALMAR = 0
                  ISO = 2
                  ISOFRO = 0
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ELSE
          IF (ISO.EQ.2) THEN
            IF (IVALMAR.EQ.0) THEN
              IVALMAR = 1
            ELSE
              IVALMAR = 0
              ISO = 0
              ICADPS = -1
              ANGPS = 0.
              CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,1,ILANG)
cc              IREFRE = 1
            ENDIF
          ELSEIF(ISO.EQ.1) THEN
            IF (ISOFRO.EQ.0) THEN
              ISOFRO = 1
            ELSE
              IF (IVALMAR.EQ.0) THEN
                IVALMAR = 1
              ELSE
                IVALMAR = 0
                ISO = 2
                ISOFRO = 0
              ENDIF
            ENDIF
          ELSE
            ISO = 1
          ENDIF
        ENDIF
        IF (ISOINI.EQ.0) THEN
          ICADPS = 1
          IF (ICARRE.EQ.1) THEN
            ANGPS = -90.
          ELSE
            ANGPS = 0.
          ENDIF
          CALL DEFPS(IDEFPS,SIG,ANGPS,ICADPS,HELPPS,IDSEUL,1,ILANG)
cc          IREFRE = 1
          IF (I2D.NE.0) THEN
            IFC0 = IFC
            IFC = 1
          ENDIF
          ITABLE0 = ITABLE
C
C Parametres par defaut pour optimisation topologique
C
          IF (LONISO.GT.6.AND.(NOM_ISO(LONISO-5:LONISO).EQ.'.theta'
     &                     .OR.NOM_ISO(LONISO-6:LONISO).EQ.'.thetap'))
     &         THEN
            VMIN = 0.
            VMAX = 1.
            IVFIXE = 0
            IF (ITABLE.NE.8.OR.NBCOUL.NE.100) THEN
              NBCOUL = 100
              ITABLE = 7
              IIII = -100000-NBCOUL
              CALL TABCOL(IIII,IWAVE)
              ITABLE = 8
              CALL TABCOL(IIII,IWAVE)
            ENDIF
C Levelset
          ELSEIF(LONISO.GT.4
     &      .AND.NOM_ISO(LONISO-3:LONISO).EQ.'.psi') THEN
            VMAMA = MAX(ABS(VMIN),VMAX)
            VMIN = -VMAMA
            VMAX = VMAMA
            IVFIXE = 0
            IF (ITABLE.NE.34.OR.NBCOUL.NE.8) THEN
              NBCOUL = 8
              ITABLE = 33
              IIII = -100000-NBCOUL
              CALL TABCOL(IIII,IWAVE)
              ITABLE = 34
              CALL TABCOL(IIII,IWAVE)
            ENDIF
          ELSE
            IVFIXE = 0
            IF (ITABLE.NE.1) THEN
              NBCOUL = 20
              ITABLE = 1
              IIII = -100000-NBCOUL
              CALL TABCOL(IIII,IWAVE)
            ENDIF
          ENDIF
        ELSEIF(ISO.EQ.0) THEN
          IF (I2D.NE.0) IFC = IFC0
          IF (ITABLE.NE.ITABLE0) THEN
            IVFIXE = 0
            NBCOUL = 75
            ITABLE = ITABLE0
            IIII = -100000-NBCOUL
            CALL TABCOL(IIII,IWAVE)
          ENDIF
        ENDIF
        IGOTO = 5000
      ELSE
        IGOTO = 5002
      ENDIF
      END
C=======================================================================
      SUBROUTINE ACTISO2(IDEROUL)
      INCLUDE 'com_options.f'
C
      IVALMAR = 0
      ISOFRO = 0
      IF (ICENTR.NE.0) THEN
        IF (IDEROUL.EQ.1) THEN
          ISO = 2
          IVALMAR = 1
          ICENTRISO = 1
        ELSEIF(IDEROUL.EQ.2) THEN
          ISO = 3
        ELSEIF(IDEROUL.EQ.3) THEN
          ISO = 1
          ICENTRISO = 1
        ELSEIF(IDEROUL.EQ.4) THEN
          ISO = 1
          ISOFRO = 1
          ICENTRISO = 1
        ELSEIF(IDEROUL.EQ.5) THEN
          ISO = 1
          ISOFRO = 1
          IVALMAR = 1
          ICENTRISO = 1
        ELSEIF(IDEROUL.EQ.6) THEN
          ISO = 2
          ICENTRISO = 1
        ELSEIF(IDEROUL.EQ.7) THEN
          ISO = 1
          ICENTRISO = 0
        ELSEIF(IDEROUL.EQ.8) THEN
          ISO = 1
          ISOFRO = 1
          ICENTRISO = 0
        ELSEIF(IDEROUL.EQ.9) THEN
          ISO = 1
          ISOFRO = 1
          IVALMAR = 1
          ICENTRISO = 0
        ELSEIF(IDEROUL.EQ.10) THEN
          ISO = 2
          ICENTRISO = 0
        ELSEIF(IDEROUL.EQ.11) THEN
          ISO = 2
          IVALMAR = 1
          ICENTRISO = 0
        ELSE
          ISO = 0
        ENDIF
      ELSE
        IF (IDEROUL.EQ.1) THEN
          ISO = 2
          IVALMAR = 1
        ELSEIF(IDEROUL.EQ.2) THEN
          ISO = 0
        ELSEIF(IDEROUL.EQ.3) THEN
          ISO = 1
        ELSEIF(IDEROUL.EQ.4) THEN
          ISO = 1
          ISOFRO = 1
        ELSEIF(IDEROUL.EQ.5) THEN
          ISO = 1
          ISOFRO = 1
          IVALMAR = 1
        ELSE
          ISO = 2
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE ACTLIVAL(IVAL,ICONTR,CBIDON,LBID,IREFRE,IGOTO)
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      INCLUDE 'com_options.f'
      DIMENSION XQ(2),YQ(2)
      INTEGER   LQ(2),ICOLQ(2),IOK(2),IEXCL(2),LTITRE(3),ICTITRE(3)
      CHARACTER*32  CQ(2),CTITRE(3)
      CHARACTER*128 CBIDON
C
      IREP = 0
      FACEXA0 = FACEXA
      IEXA = 0
      INOUVISO = 0
      IF (IVAL.EQ.1.OR.IVAL.EQ.4) THEN
        IDEPL = 1
        IF (NSURF.GT.0) THEN
          ITTTT = 0
          IF (LBID.GT.6.AND.LONISO.GT.6) THEN
            IF (CBIDON(LBID-5:LBID).EQ.'.theta'
     &     .AND.NOM_ISO(LONISO-5:LONISO).EQ.'.theta') ITTTT = 1
          ENDIF
          IF (LBID.GT.7.AND.LONISO.GT.7) THEN
            IF (CBIDON(LBID-6:LBID).EQ.'.thetap'
     &     .AND.NOM_ISO(LONISO-6:LONISO).EQ.'.thetap') ITTTT = 1
          ENDIF
          IF (LBID.GT.4) THEN
            IF (CBIDON(LBID-3:LBID).EQ.'.psi'
     &     .AND.NOM_ISO(LONISO-3:LONISO).EQ.'.psi') ITTTT = 1
          ENDIF
          IF (ITTTT.EQ.0) THEN
Cfj            CALL FSTERM(1)
Cfj            PRINT*,' '
Cfj            IF (ILANG.EQ.0) THEN
Cfj              CALL LIENTIER(
Cfj     &'Fichier scalaire pour nouvelle isosurface (0) '//
Cfj     &'ou à tracer sur l''iso (1) ?',0,IREP)
Cfj            ELSE
Cfj              CALL LIENTIER(
Cfj     &'Scalar field for a new isosurface (0) '//
Cfj     &'or to draw a contour plot on the old one (1) ?',0,IREP)
Cfj            ENDIF
            CALL GSLSS(IFONT8)
            CQ(1) = 'azertyuiopqsdfghjklmwxcvbn123456'
            T = TAILLE_CHAINE(CQ(1),32)
            XQ(1) = 0.5*(XDMAX+XHELP) - 0.6*T
            XQ(2) = 0.5*(XDMAX+XHELP) + 0.6*T
            YQ(1) = 0.5*(YDMAX+YDMIN) - 0.02*(YDMAX-YDMIN)
            YQ(2) = 0.5*(YDMAX+YDMIN) + 0.02*(YDMAX-YDMIN)
            IF (ILANG.EQ.0) THEN
              CQ(1) = 'Fichier scal. pour nouvelle iso'
              LQ(1) = 31
              CQ(2) = 'Fichier scal. à tracer sur l''iso'
              LQ(2) = 32
            ELSE
              CQ(1) = 'Scalar field for new isosurface'
              LQ(1) = 31
              CQ(2) = 'Contour plot over the old iso'
              LQ(2) = 29
            ENDIF
            ICOLQ(1) = 0
            ICOLQ(2) = 0
            IOK(1) = 1
            IOK(2) = 0
            IEXCL(1) = 1002
            IEXCL(2) = 1002
            CALL CHOIXACOCHER(CTITRE,LTITRE,0,ICTITRE,IFONT8
     &                       ,XQ,YQ,CQ,LQ,ICOLQ,2,IOK,1,IFONT7,IEXCL)
            IREP = IOK(2)
Cfj
            IF (IREP.NE.0) THEN
              DO I=1,NUMNP
                VALXB(I) = VALX(I)
              ENDDO
            ENDIF
          ENDIF
        ELSEIF(I2D.NE.0.AND.FACEXA.NE.0.) THEN
          IF (IGOTO.NE.0.AND.IDEFOR.EQ.2) THEN
Cfj            CALL FSTERM(1)
Cfj            PRINT*,' '
Cfj            IF (ILANG.EQ.0) THEN
Cfj              PRINT*,
Cfj     &'*** La config. actuelle est déformée (facteur d''exagération ='
Cfj     &             ,FACEXA,')'
Cfj              PRINT*,
Cfj     &'*** 0: nouvelle déformation (facteur d''exagération inchangé)'
Cfj              PRINT*,
Cfj     &'*** 1: nouvelle iso en gardant l''ancienne déformée'
Cfj              CALL LIENTIER('Option choisie ?',0,IREP)
Cfj            ELSE
Cfj              PRINT*,
Cfj     &'*** The current config is exagerated (exag. fac. =',FACEXA,')'
Cfj              PRINT*,
Cfj     &'*** 0: new deformation (unchanged exageration factor)'
Cfj              PRINT*,
Cfj     &'*** 1: new contour plot on the old deformed configuration'
Cfj              CALL LIENTIER('Chosen option?',0,IREP)
            CALL GSLSS(IFONT8)
            CQ(1) = 'azertyuiopqsdfghjklmwxcvbn123456'
            T = TAILLE_CHAINE(CQ(1),32)
            XQ(1) = 0.5*(XDMAX+XHELP) - 0.6*T
            XQ(2) = 0.5*(XDMAX+XHELP) + 0.6*T
            YQ(1) = 0.5*(YDMAX+YDMIN) - 0.02*(YDMAX-YDMIN)
            YQ(2) = 0.5*(YDMAX+YDMIN) + 0.02*(YDMAX-YDMIN)
            IF (ILANG.EQ.0) THEN
              CTITRE(1) = 'La config. actuelle est déformée'
              LTITRE(1) = 32
              CTITRE(2) = 'Facteur d''exagération = '
              WRITE(CTITRE(2)(25:32),'(G8.2)') FACEXA
              LTITRE(2) = 32
              CQ(1) = 'Nouvelle déformation (exag idem)'
              LQ(1) = 32
              CQ(2) = 'Nouvelle iso + ancienne déformée'
              LQ(2) = 32
            ELSE
              CTITRE(1) = 'The current config is exagerated'
              LTITRE(1) = 32
              CTITRE(2) = 'Exageration factor = '
              WRITE(CTITRE(2)(22:29),'(G8.2)') FACEXA
              LTITRE(2) = 29
              CQ(1) = 'New deformation (same exag fact)'
              LQ(1) = 32
              CQ(2) = 'New contour plot over old deform'
              LQ(2) = 32
            ENDIF
            ICTITRE(1) = 3
            ICTITRE(2) = 3
            ICOLQ(1) = 0
            ICOLQ(2) = 0
            IOK(1) = 1
            IOK(2) = 0
            IEXCL(1) = 1002
            IEXCL(2) = 1002
            CALL CHOIXACOCHER(CTITRE,LTITRE,2,ICTITRE,IFONT8
     &                       ,XQ,YQ,CQ,LQ,ICOLQ,2,IOK,1,IFONT7,IEXCL)
            IREP = IOK(2)
          ELSE
            INOUVISO = 1
            IREP = 1
            IF (FACEXA0.NE.0.) IEXA = 1
          ENDIF
          IF (IREP.EQ.0.OR.IEXA.NE.0) THEN
            DFACX = -FACEXA
            DFACY = -FACEXA
            DFACZ = -FACEXA
            CALL EXAGERE(DFACX,DFACY,DFACZ,0)
            IEXA = 1
          ELSEIF(IGOTO.NE.0) THEN
            IDEPL = 0
          ENDIF
        ENDIF
        CALL LIISO(ICLAS,CBIDON,LBID,IRC,ICONTR,IDEPL,IVAL)
        IF (INOUVISO.NE.0.AND.ISTDOUT.EQ.0) THEN
          IF (ILANG.EQ.0) THEN
            PRINT*,
     &     '*** On utilise le fichier scalaire pour une nouvelle iso'
          ELSE
            PRINT*,'*** Scalar field for new contour plot'
          ENDIF
        ENDIF
        IF (IEXA.EQ.1) THEN
          FACEXA = FACEXA0
          DFACX = FACEXA
          DFACY = FACEXA
          DFACZ = FACEXA
          CALL EXAGERE(DFACX,DFACY,DFACZ,0)
          IF (I2D.NE.0.AND.IDEFOR.EQ.2.AND.FACEXA.NE.0.) THEN
            IF (IPERSP.EQ.IPERSP0) IPERSP = 1
            IF (ICTFAC.EQ.ICTFAC00) ICTFAC = 99
          ENDIF
        ENDIF
        IF (NSURF.GT.0) THEN
          IF (IREP.EQ.0) THEN
            VMINISO = VMIN
            VMAXISO = VMAX
          ELSE
            DO I=1,NUMNP
              CALL ECHR(VALX(I),VALXB(I))
            ENDDO
            IF (IRC.EQ.0) IFVISO = 1
          ENDIF
        ELSE
          VMINISO = VMIN
          VMAXISO = VMAX
        ENDIF
      ELSE
        IF (IVAL.EQ.-1) THEN
          III = 2
        ELSE
          III = 0
        ENDIF
        ISOBID0 = ISOBID
        IF (FACEXA.EQ.0..OR.I2D.EQ.0) THEN
          CALL LIVIT(ICLAS,III,CBIDON,LBID,IRC,IGOTO,0)
        ELSE
          CALL LIVIT(ICLAS,III,CBIDON,LBID,IRC,IGOTO,1)
        ENDIF
        IF (ISOBID.NE.ISOBID0.AND.ISOBID0.NE.0) THEN
          ISOBID = ISOBID0
          CALL MYISO
        ENDIF
      ENDIF
      IF (IRC.NE.0) IGOTO = 1301
      CALL GSPATF(ICTFON)
      CALL GSLW(0)
      CALL INITBOUT
      IREFRE = 1
      IF (ISO.EQ.0.AND.(IVAL.EQ.1.OR.IVAL.EQ.4).AND.NSURF.LE.0) THEN
        IGOTO = 5001
      ELSE
        IF (IREP.EQ.0
     &.AND.((VISO.LT.VMINISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.1))
     &  .OR.(VISO.GT.VMAXISO.AND.(ICALSU.EQ.0.OR.ICALSU.EQ.2)))) THEN
          NSURF = 0
        ELSEIF(NSURF.GT.0) THEN
          IF (IREP.EQ.1.AND.ISOCOUP.EQ.1) THEN
            CALL INV3X3(ROTA,ROTLOC,IERR)
            CALL ROTATE(1)
            IF (IPCOUP.EQ.1) THEN
              DO I=1,NUMNP
                VALX(I) = X(I) + XMED0
              ENDDO
            ELSEIF(IPCOUP.EQ.2) THEN
              DO I=1,NUMNP
                VALX(I) = Y(I) + YMED0
              ENDDO
            ELSE
              DO I=1,NUMNP
                VALX(I) = Z(I) + ZMED0
              ENDDO
            ENDIF
            CALL INV3X3(ROTLOC,ROTA,IERR)
            CALL ROTATE(0)
            CALL CALSUR(1)
            DO I=1,NUMNP
              VALX(I) = VALXB(I)
            ENDDO
          ELSE
            CALL CALSUR(1)
          ENDIF
        ENDIF
        IGOTO = 5000
      ENDIF
      END
C=======================================================================
      SUBROUTINE ACTBOR2(IDEROUL)
      INCLUDE 'com_options.f'
C
      IF (IDEROUL.GE.5) THEN
        IMAILL = 4-IDEROUL
      ELSE
        IMAILL = 1
        IF (IDEROUL.EQ.1) THEN
          IBORD = 1
        ELSEIF(IDEROUL.EQ.2) THEN
          IBORD = 0
          IEPBOR2 = 2
        ELSE
          IBORD = -1
          IF (IDEROUL.EQ.3) THEN
            IEPBOR2 = 2
          ELSE
            IEPBOR2 = 1
          ENDIF
        ENDIF
      ENDIF
      IF (ISOCOUP.EQ.1) THEN
        IF (IBORD.NE.-1.AND.IMAILL.GT.0) THEN
          ICSUR = 8
        ELSE
          ICSUR = 16
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE CALCDIM(YYLAR,IOPT)
      INCLUDE 'com_options.f'
C
      IF (ICARRE.EQ.1) THEN
        YYLAR = XLARG
      ELSE
        YYLAR = XLARG*HYA4/HXA4
      ENDIF
      IF (IPOST.EQ.1.OR.ICADPS.GT.0) THEN
        IF (ICARRE.EQ.1) THEN
          XXLAR2 = XLARG*(2.*HYA4/HXA4-1.)
        ELSE
          XXLAR2 = 2.*YYLAR-XLARG
        ENDIF
      ELSE
        XXLAR2 = XLARG
      ENDIF
      IF (IPOST.EQ.1) THEN
        XXLAR3 = XLARG+YYLAR*.6
      ELSE
        XXLAR3 = XLARG
      ENDIF
      XCOCO  = (XXLAR2-XLARG)/YYLAR
      XCOTE3 = (XXLAR3-XLARG)/YYLAR
C
      XDMIN = XCUR-XXLAR3
      XDMA2 = XCUR+XXLAR2
      YDMIN = YCUR-YYLAR
      YDMAX = YCUR+YYLAR
      IF (IOPT.EQ.0) THEN
        IF (IPOST.EQ.1) THEN
          YDMI2  = YDMIN - .03*(YDMAX-YDMIN)
          CALL GSUWIN(XDMIN,XDMA2,YDMI2,YDMAX)
          CALL GSQWIN(XDMIN,XDMA2,YDMI2,YDMAX)
          YDMIN = YDMI2 + .03*(YDMAX-YDMI2)/1.03
        ELSE
          YDMI2  = YDMIN
          CALL GSUWIN(XDMIN,XDMA2,YDMI2,YDMAX)
          CALL GSQWIN(XDMIN,XDMA2,YDMI2,YDMAX)
          YDMIN = YDMI2
        ENDIF
        IX0 = IVRAIECOORD(XHELP)
        IX1 = IVRAIECOORD(XDMAX)
        PIXEL = (XDMAX-XHELP)/REAL(IABS(IX0-IX1))
      ENDIF
      XDMAX = XDMA2 - .5*XCOCO*(YDMAX-YDMIN)
      XHELP = XDMIN + .5*XCOTE3*(YDMAX-YDMIN)
      XINFO = XHELP + .5*(YDMIN-YDMI2)
      YINFO = YDMI2 + .3*(YDMIN-YDMI2)
      END
