Sources Esope | Cast3M

ptrini
C PTRINI    SOURCE    CB215821  20/08/04    21:15:14     10680          
CSSP TRINIT VERSION 04/08/89 MODIFIEE POUR DRIVER PHIGS
C------------------------------------------------------
      SUBROUTINE PTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
*****
*****   definitions standards de PHIGS
*****
      IMPLICIT INTEGER(I-N)
      external long
      PARAMETER  (PUNCON            =  1  )
      PARAMETER  (PLDLN             =  2  )
C    archive state
      PARAMETER  (PARCL             =  0  )
      PARAMETER  (PAROP             =  1  )
C    attribute identifier
      PARAMETER  (PLN        =  0  )
      PARAMETER  (PLWSC      =  1  )
      PARAMETER  (PPLCI      =  2  )
      PARAMETER  (PMK        =  3  )
      PARAMETER  (PMKSC      =  4  )
      PARAMETER  (PPMCI      =  5  )
      PARAMETER  (PTXFN      =  6  )
      PARAMETER  (PTXPR      =  7  )
      PARAMETER  (PCHXP      =  8  )
      PARAMETER  (PCHSP      =  9  )
      PARAMETER  (PTXCI      = 10  )
      PARAMETER  (PIS        = 11  )
      PARAMETER  (PISI       = 12  )
      PARAMETER  (PICI       = 13  )
      PARAMETER  (PEDFG      = 14  )
      PARAMETER  (PEDT       = 15  )
      PARAMETER  (PEWSC      = 16  )
      PARAMETER  (PEDCI      = 17  )
      PARAMETER  (PPSHM      = 18  )
      PARAMETER  (PISHM      = 19  )
      PARAMETER  (PIRPR      = 20  )
      PARAMETER  (PIREQ      = 21  )
      PARAMETER  (PBIS       = 22  )
      PARAMETER  (PBISI      = 23  )
      PARAMETER  (PBIC       = 24  )
      PARAMETER  (PBISHM     = 25  )
      PARAMETER  (PBIRPR     = 26  )
      PARAMETER  (PBIREQ     = 27  )
      PARAMETER  (PCAPCR     = 28  )
      PARAMETER  (PSAPCR     = 29  )
C    aspect source
      PARAMETER  (PBUNDL     =  0  )
      PARAMETER  (PINDIV     =  1  )
C    clipping indicator
      PARAMETER  (PNCLIP     =  0  )
      PARAMETER  (PCLIP      =  1  )
C    colour available
      PARAMETER  (PMONOC     =  0  )
      PARAMETER  (PCOLOR     =  1  )
C    colour model
      PARAMETER  (PINDCT     =  0  )
      PARAMETER  (PRGB       =  1  )
      PARAMETER  (PCIE       =  2  )
      PARAMETER  (PHSV       =  3  )
      PARAMETER  (PHLS       =  4  )
C    composition type
      PARAMETER  (PCPRE      =  0  )
      PARAMETER  (PCPOST     =  1  )
      PARAMETER  (PCREPL     =  2  )
C    conflict resolution
      PARAMETER  (PCRMNT     =  0  )
      PARAMETER  (PCRABA     =  1  )
      PARAMETER  (PCRUPD     =  2  )
C    control flag
      PARAMETER  (PCONDI     =  0  )
      PARAMETER  (PALWAY     =  1  )
C    deferral mode
      PARAMETER  (PASAP      =  0  )
      PARAMETER  (PBNIG      =  1  )
      PARAMETER  (PBNIL      =  2  )
      PARAMETER  (PASTI      =  3  )
      PARAMETER  (PWAITD     =  4  )
C    device coordinate units
      PARAMETER  (PMETRE     =  0  )
      PARAMETER  (POTHU      =  1  )
C    display surface empty
      PARAMETER  (PNEMPT     =  0  )
      PARAMETER  (PEMPTY     =  1  )
C    dynamic modification
      PARAMETER  (PIRG       =  0  )
      PARAMETER  (PIMM       =  1  )
      PARAMETER  (PCBS       =  2  )
C    echo switch
      PARAMETER  (PNECHO     =  0  )
      PARAMETER  (PECHO      =  1  )
C    edit mode
      PARAMETER  (PINSRT     =  0  )
      PARAMETER  (PREPLC     =  1  )
C    element type
      PARAMETER  ( PEALL  =  0     )
      PARAMETER  ( PENIL  =  1     )
      PARAMETER  ( PEPL3  =  2     )
      PARAMETER  ( PEPL   =  3     )
      PARAMETER  ( PEPM3  =  4     )
      PARAMETER  ( PEPM   =  5     )
      PARAMETER  ( PETX3  =  6     )
      PARAMETER  ( PETX   =  7     )
      PARAMETER  ( PEATR3 =  8     )
      PARAMETER  ( PEATR  =  9     )
      PARAMETER  ( PEFA3  =  10    )
      PARAMETER  ( PEFA   =  11    )
      PARAMETER  ( PEFAS3 =  12    )
      PARAMETER  ( PEFAS  =  13    )
      PARAMETER  ( PECA3  =  14    )
      PARAMETER  ( PECA   =  15    )
      PARAMETER  ( PEGDP3 =  16    )
      PARAMETER  ( PEGDP  =  17    )
      PARAMETER  ( PEPLI  =  18    )
      PARAMETER  ( PEPMI  =  19    )
      PARAMETER  ( PETXI  =  20    )
      PARAMETER  ( PEII   =  21    )
      PARAMETER  ( PEEDI  =  22    )
      PARAMETER  ( PELN   =  23    )
      PARAMETER  ( PELWSC =  24    )
      PARAMETER  ( PEPLCI =  25    )
      PARAMETER  ( PEMK   =  26    )
      PARAMETER  ( PEMKSC =  27    )
      PARAMETER  ( PEPMCI =  28    )
      PARAMETER  ( PETXFN =  29    )
      PARAMETER  ( PETXPR =  30    )
      PARAMETER  ( PECHXP =  31    )
      PARAMETER  ( PECHSP =  32    )
      PARAMETER  ( PETXCI =  33    )
      PARAMETER  ( PECHH  =  34    )
      PARAMETER  ( PECHUP =  35    )
      PARAMETER  ( PETXP  =  36    )
      PARAMETER  ( PETXAL =  37    )
      PARAMETER  ( PEATCH =  38    )
      PARAMETER  ( PEATCU =  39    )
      PARAMETER  ( PEATP  =  40    )
      PARAMETER  ( PEATAL =  41    )
      PARAMETER  ( PEANST =  42    )
      PARAMETER  ( PEIS   =  43    )
      PARAMETER  ( PEISI  =  44    )
      PARAMETER  ( PEICI  =  45    )
      PARAMETER  ( PEEDFG =  46    )
      PARAMETER  ( PEEDT  =  47    )
      PARAMETER  ( PEEWSC =  48    )
      PARAMETER  ( PEEDCI =  49    )
      PARAMETER  ( PEPA   =  50    )
      PARAMETER  ( PEPRPV =  51    )
      PARAMETER  ( PEPARF =  52    )
      PARAMETER  ( PEADS  =  53    )
      PARAMETER  ( PERES  =  54    )
      PARAMETER  ( PEIASF =  55    )
      PARAMETER  ( PEHRID =  56    )
      PARAMETER  ( PELMT3 =  57    )
      PARAMETER  ( PELMT  =  58    )
      PARAMETER  ( PEGMT3 =  59    )
      PARAMETER  ( PEGMT  =  60    )
      PARAMETER  ( PEMCV3 =  61    )
      PARAMETER  ( PEMCV  =  62    )
      PARAMETER  ( PEMCLI =  63    )
      PARAMETER  ( PERMCV =  64    )
      PARAMETER  ( PEVWI  =  65    )
      PARAMETER  ( PEEXST =  66    )
      PARAMETER  ( PELB   =  67    )
      PARAMETER  ( PEAP   =  68    )
      PARAMETER  ( PEGSE  =  69    )
      PARAMETER  ( PEPKID =  70    )
C    element type PHIGS+
      PARAMETER  ( PEPLS3 =  71    )
      PARAMETER  ( PEFSD3 =  72    )
      PARAMETER  ( PETRS3 =  73    )
      PARAMETER  ( PEQMD3 =  74    )
      PARAMETER  ( PESFS3 =  75    )
      PARAMETER  ( PENBSC =  76    )
      PARAMETER  ( PENBSS =  77    )
      PARAMETER  ( PECAP3 =  78    )
      PARAMETER  ( PETXCL =  79    )
      PARAMETER  ( PEPMCL =  80    )
      PARAMETER  ( PEEDCL =  81    )
      PARAMETER  ( PEPLCL =  82    )
      PARAMETER  ( PECAPC =  83    )
      PARAMETER  ( PEPLSM =  84    )
      PARAMETER  ( PEICL  =  85    )
      PARAMETER  ( PEBICL =  86    )
      PARAMETER  ( PEBISY =  87    )
      PARAMETER  ( PEBISI =  88    )
      PARAMETER  ( PERFP  =  89    )
      PARAMETER  ( PEBRFP =  90    )
      PARAMETER  ( PEISM  =  91    )
      PARAMETER  ( PEBISM =  92    )
      PARAMETER  ( PEIRFE =  93    )
      PARAMETER  ( PEBIRE =  94    )
      PARAMETER  ( PESAPC =  95    )
      PARAMETER  ( PEPSCH =  96    )
      PARAMETER  ( PEFDGM =  97    )
      PARAMETER  ( PEFCUM =  98    )
      PARAMETER  ( PELSST =  99    )
      PARAMETER  ( PEDPCI =  100   )
      PARAMETER  ( PECMI  =  101   )
      PARAMETER  ( PERCLM =  102   )
C    GDP attributes
      PARAMETER  (PPLATT  =     0  )
      PARAMETER  (PPMATT  =     1  )
      PARAMETER  (PTXATT  =     2  )
      PARAMETER  (PINATT  =     3  )
      PARAMETER  (PEDATT  =     4  )
C    input class
      PARAMETER  (PNCLAS  =     0  )
      PARAMETER  (PLOCAT  =     1  )
      PARAMETER  (PSTROK  =     2  )
      PARAMETER  (PVALUA  =     3  )
      PARAMETER  (PCHOIC  =     4  )
      PARAMETER  (PPICK   =     5  )
      PARAMETER  (PSTRIN  =     6  )
C    input device status
      PARAMETER  (PNONE   =     0  )
      PARAMETER  (POK     =     1  )
      PARAMETER  (PNPICK  =     2  )
      PARAMETER  (PNCHOI  =     2  )
C    interior style
      PARAMETER  (PHOLLO  =     0  )
      PARAMETER  (PSOLID  =     1  )
      PARAMETER  (PPATTR  =     2  )
      PARAMETER  (PHATCH  =     3  )
      PARAMETER  (PISEMP  =     4  )
C    linetype
      PARAMETER  (PLSOLI  =     1  )
      PARAMETER  (PLDASH  =     2  )
      PARAMETER  (PLDOT   =     3  )
      PARAMETER  (PLDASD  =     4  )
C    makertype
      PARAMETER  (PPOINT  =     1  )
      PARAMETER  (PPLUS   =     2  )
      PARAMETER  (PAST    =     3  )
      PARAMETER  (POMARK  =     4  )
      PARAMETER  (PXMARK  =     5  )
C    modellin clipping operater
      PARAMETER  (PMCREP  =     1  )
      PARAMETER  (PMCINT  =     2  )
C    modification mode
      PARAMETER  (PNIVE   =     0  )
      PARAMETER  (PUWOR   =     1  )
      PARAMETER  (PUQUM   =     2  )
C    more simultaneous events
      PARAMETER  (PNMORE  =     0  )
      PARAMETER  (PMORE   =     1  )
C    off/on switch for edge flag and error handling mode
      PARAMETER  (POFF    =     0  )
      PARAMETER  (PON     =     1  )
C    open-structure status
      PARAMETER  (PNONST  =     0  )
      PARAMETER  (POPNST  =     1  )
C    operating mode
      PARAMETER  (PREQU   =     0  )
      PARAMETER  (PSAMPL  =     1  )
      PARAMETER  (PEVENT  =     2  )
C    path order
      PARAMETER  (PPOTOP  =     0  )
      PARAMETER  (PPOBOT  =     1  )
C    polyline/fill area control flag
      PARAMETER  (PPLINE  =     0  )
      PARAMETER  (PFILLA  =     1  )
      PARAMETER  (PFILAS  =     2  )
C    presence of invalid values
      PARAMETER  (PABSNT  =     0  )
      PARAMETER  (PPRSNT  =     1  )
C    reference handling flag
      PARAMETER  (PDELE   =     0  )
      PARAMETER  (PKEEP   =     1  )
C    regeneration flag
      PARAMETER  (PPOSTP  =     0  )
      PARAMETER  (PPERFO  =     1  )
C /  relative input priority
      PARAMETER  (PHIGHR  =     0  )
      PARAMETER  (PLOWER  =     1  )
C    search direction
      PARAMETER  (PBWD    =     0  )
      PARAMETER  (PFWD    =     1  )
C    search success indicator
      PARAMETER  (PFAIL   =     0  )
      PARAMETER  (PSUCC   =     1  )
C    state of visual representation
      PARAMETER  (PVROK   =     0  )
      PARAMETER  (PVRDFR  =     1  )
      PARAMETER  (PVRSIM  =     2  )
C    structure network source
      PARAMETER  (PCSS    =     0  )
      PARAMETER  (PARCHV  =     1  )
C    structure state value
      PARAMETER  (PSTCL   =     0  )
      PARAMETER  (PSTOP   =     1  )
C    structure status indicator
      PARAMETER  (PSNOEX  =     0  )
      PARAMETER  (PSEMPT  =     1  )
      PARAMETER  (PSNEMP  =     2  )
C    system state value
      PARAMETER  (PPHCL   =     0  )
      PARAMETER  (PPHOP   =     1  )
C    text alignment horizontal
      PARAMETER  (PAHNOR  =     0  )
      PARAMETER  (PALEFT  =     1  )
      PARAMETER  (PACENT  =     2  )
      PARAMETER  (PARITE  =     3  )
C    text alignment vartical
      PARAMETER  (PAVNOR  =     0  )
      PARAMETER  (PATOP   =     1  )
      PARAMETER  (PACAP   =     2  )
      PARAMETER  (PAHALF  =     3  )
      PARAMETER  (PABASE  =     4  )
      PARAMETER  (PABOTT  =     5  )
C    text path
      PARAMETER  (PRIGHT  =     0  )
      PARAMETER  (PLEFT   =     1  )
      PARAMETER  (PUP     =     2  )
      PARAMETER  (PDOWN   =     3  )
C    text precision
      PARAMETER  (PSTRP   =     0  )
      PARAMETER  (PCHARP  =     1  )
      PARAMETER  (PSTRKP  =     2  )
C    type of returned values
      PARAMETER  (PSET    =     0  )
      PARAMETER  (PREALI  =     1  )
C    update state
      PARAMETER  (PNPEND  =     0  )
      PARAMETER  (PPEND   =     1  )
C    vector/raster/other type
      PARAMETER  (PVECTR  =     0  )
      PARAMETER  (PRASTR  =     1  )
      PARAMETER  (POTHWK  =     2  )
C    viewtype
      PARAMETER  (PPARL   =     0  )
      PARAMETER  (PPERS   =     1  )
C    workstation category
      PARAMETER  (POUTPT  =     0  )
      PARAMETER  (PINPUT  =     1  )
      PARAMETER  (POUTIN  =     2  )
      PARAMETER  (PMO     =     3  )
      PARAMETER  (PMI     =     4  )
C    workstation dependence indicator
      PARAMETER  (PWKI    =     0  )
      PARAMETER  (PWKD    =     1  )
C    workstation state value
      PARAMETER  (PWSCL   =     0  )
      PARAMETER  (PWSOP   =     1  )
C    current(and requested values
      PARAMETER  (PCURVL  =     0  )
      PARAMETER  (PRQSVL  =     1  )
C    error handling
      PARAMETER  (EOPPH   =     0  )
      PARAMETER  (ECLPH   =     1  )
      PARAMETER  (EOPWK   =     2  )
      PARAMETER  (ECLWK   =     3  )
      PARAMETER  (ERST    =     4  )
      PARAMETER  (EUWK    =     5  )
      PARAMETER  (ESDUS   =     6  )
      PARAMETER  (EMSG    =     7  )
      PARAMETER  (EPL3    =     8  )
      PARAMETER  (EPL     =     9  )
      PARAMETER  (EPM3    =     10 )
      PARAMETER  (EPM     =     11 )
      PARAMETER  (ETX3    =     12 )
      PARAMETER  (ETX     =     13 )
      PARAMETER  (EATR3   =     14 )
      PARAMETER  (EATR    =     15 )
      PARAMETER  (EFA3    =     16 )
      PARAMETER  (EFA     =     17 )
      PARAMETER  (EFAS3   =     18 )
      PARAMETER  (EFAS    =     19 )
      PARAMETER  (ECA3    =     20 )
      PARAMETER  (ECA     =     21 )
      PARAMETER  (EGDP3   =     22 )
      PARAMETER  (EGDP    =     23 )
      PARAMETER  (ESPLI   =     24 )
      PARAMETER  (ESPMI   =     25 )
      PARAMETER  (ESTXI   =     26 )
      PARAMETER  (ESII    =     27 )
      PARAMETER  (ESEDI   =     28 )
      PARAMETER  (ESLN    =     29 )
      PARAMETER  (ESLWSC  =     30 )
      PARAMETER  (ESPLCI  =     31 )
      PARAMETER  (ESMK    =     32 )
      PARAMETER  (ESMKSC  =     33 )
      PARAMETER  (ESPMCI  =     34 )
      PARAMETER  (ESTXFN  =     35 )
      PARAMETER  (ESTXPR  =     36 )
      PARAMETER  (ESCHXP  =     37 )
      PARAMETER  (ESCHSP  =     38 )
      PARAMETER  (ESTXCI  =     39 )
      PARAMETER  (ESCHH   =     40 )
      PARAMETER  (ESCHUP  =     41 )
      PARAMETER  (ESTXP   =     42 )
      PARAMETER  (ESTXAL  =     43 )
      PARAMETER  (ESATCH  =     44 )
      PARAMETER  (ESATCU  =     45 )
      PARAMETER  (ESATP   =     46 )
      PARAMETER  (ESATAL  =     47 )
      PARAMETER  (ESANS   =     48 )
      PARAMETER  (ESIS    =     49 )
      PARAMETER  (ESISI   =     50 )
      PARAMETER  (ESICI   =     51 )
      PARAMETER  (ESEDFG  =     52 )
      PARAMETER  (ESEDT   =     53 )
      PARAMETER  (ESEWSC  =     54 )
      PARAMETER  (ESEDCI  =     55 )
      PARAMETER  (ESPA    =     56 )
      PARAMETER  (ESPRPV  =     57 )
      PARAMETER  (ESPARF  =     58 )
      PARAMETER  (EADS    =     59 )
      PARAMETER  (ERES    =     60 )
      PARAMETER  (ESIASF  =     61 )
      PARAMETER  (ESPLR   =     62 )
      PARAMETER  (ESPMR   =     63 )
      PARAMETER  (ESTXR   =     64 )
      PARAMETER  (ESIR    =     65 )
      PARAMETER  (ESEDR   =     66 )
      PARAMETER  (ESPAR   =     67 )
      PARAMETER  (ESCR    =     68 )
      PARAMETER  (ESHLFT  =     69 )
      PARAMETER  (ESIVFT  =     70 )
      PARAMETER  (ESCMD   =     71 )
      PARAMETER  (ESHRID  =     72 )
      PARAMETER  (ESHRM   =     73 )
      PARAMETER  (ESLMT3  =     74 )
      PARAMETER  (ESLMT   =     75 )
      PARAMETER  (ESGMT3  =     76 )
      PARAMETER  (ESGMT   =     77 )
      PARAMETER  (ESMCV3  =     78 )
      PARAMETER  (ESMCV   =     79 )
      PARAMETER  (ESMCLI  =     80 )
      PARAMETER  (ERMCV   =     81 )
      PARAMETER  (ESVWI   =     82 )
      PARAMETER  (ESVWR3  =     83 )
      PARAMETER  (ESVWR   =     84 )
      PARAMETER  (ESVTIP  =     85 )
      PARAMETER  (ESWKW3  =     86 )
      PARAMETER  (ESWKW   =     87 )
      PARAMETER  (ESWKV3  =     88 )
      PARAMETER  (ESWKV   =     89 )
      PARAMETER  (EOPST   =     90 )
      PARAMETER  (ECLST   =     91 )
      PARAMETER  (EEXST   =     92 )
      PARAMETER  (ELB     =     93 )
      PARAMETER  (EAP     =     94 )
      PARAMETER  (EGSE    =     95 )
      PARAMETER  (ESEDM   =     96 )
      PARAMETER  (ECELST  =     97 )
      PARAMETER  (ESEP    =     98 )
      PARAMETER  (EOSEP   =     99 )
      PARAMETER  (ESEPLB  =     100)
      PARAMETER  (EDEL    =     101)
      PARAMETER  (EDELRA  =     102)
      PARAMETER  (EDELLB  =     103)
      PARAMETER  (EEMST   =     104)
      PARAMETER  (EDST    =     105)
      PARAMETER  (EDSN    =     106)
      PARAMETER  (EDSA    =     107)
      PARAMETER  (ECSTID  =     108)
      PARAMETER  (ECSTRF  =     109)
      PARAMETER  (ECSTIR  =     110)
      PARAMETER  (EPOST   =     111)
      PARAMETER  (EUPOST  =     112)
      PARAMETER  (EUPAST  =     113)
      PARAMETER  (EOPARF  =     114)
      PARAMETER  (ECLARF  =     115)
      PARAMETER  (EARST   =     116)
      PARAMETER  (EARSN   =     117)
      PARAMETER  (EARAST  =     118)
      PARAMETER  (ESCNRS  =     119)
      PARAMETER  (ERSID   =     120)
      PARAMETER  (EREST   =     121)
      PARAMETER  (ERESN   =     122)
      PARAMETER  (ERAST   =     123)
      PARAMETER  (EREPAN  =     124)
      PARAMETER  (EREPED  =     125)
      PARAMETER  (EDSTAR  =     126)
      PARAMETER  (EDSNAR  =     127)
      PARAMETER  (EDASAR  =     128)
      PARAMETER  (ESPKID  =     129)
      PARAMETER  (ESPKFT  =     130)
      PARAMETER  (EINLC3  =     131)
      PARAMETER  (EINLC   =     132)
      PARAMETER  (EINSK3  =     133)
      PARAMETER  (EINSK   =     134)
      PARAMETER  (EINVL3  =     135)
      PARAMETER  (EINVL   =     136)
      PARAMETER  (EINCH3  =     137)
      PARAMETER  (EINCH   =     138)
      PARAMETER  (EINPK3  =     139)
      PARAMETER  (EINPK   =     140)
      PARAMETER  (EINST3  =     141)
      PARAMETER  (EINST   =     142)
      PARAMETER  (ESLCM   =     143)
      PARAMETER  (ESSKM   =     144)
      PARAMETER  (ESVLM   =     145)
      PARAMETER  (ESCHM   =     146)
      PARAMETER  (ESPKM   =     147)
      PARAMETER  (ESSTM   =     148)
      PARAMETER  (ERQLC3  =     149)
      PARAMETER  (ERQLC   =     150)
      PARAMETER  (ERQSK3  =     151)
      PARAMETER  (ERQSK   =     152)
      PARAMETER  (ERQVL   =     153)
      PARAMETER  (ERQCH   =     154)
      PARAMETER  (ERQPK   =     155)
      PARAMETER  (ERQST   =     156)
      PARAMETER  (ESMLC3  =     157)
      PARAMETER  (ESMLC   =     158)
      PARAMETER  (ESMSK3  =     159)
      PARAMETER  (ESMSK   =     160)
      PARAMETER  (ESMVL   =     161)
      PARAMETER  (ESMCH   =     162)
      PARAMETER  (ESMPK   =     163)
      PARAMETER  (ESMST   =     164)
      PARAMETER  (EWAIT   =     165)
      PARAMETER  (EFLUSH  =     166)
      PARAMETER  (EGTLC3  =     167)
      PARAMETER  (EGTLC   =     168)
      PARAMETER  (EGTSK3  =     169)
      PARAMETER  (EGTSK   =     170)
      PARAMETER  (EGTVL   =     171)
      PARAMETER  (EGTCH   =     172)
      PARAMETER  (EGTPK   =     173)
      PARAMETER  (EGTST   =     174)
      PARAMETER  (EWITM   =     175)
      PARAMETER  (EGTITM  =     176)
      PARAMETER  (ERDITM  =     177)
      PARAMETER  (EIITM   =     178)
      PARAMETER  (ESERHM  =     179)
      PARAMETER  (EESC    =     180)
      PARAMETER  (EPREC   =     181)
      PARAMETER  (EUREC   =     182)
C    error handling PHIGS+
      PARAMETER  (EPLSD3  =     301)
      PARAMETER  (EFASD3  =     302)
      PARAMETER  (ECAP3   =     303)
      PARAMETER  (ESOFA3  =     304)
      PARAMETER  (ETSD3   =     305)
      PARAMETER  (EQMD3   =     306)
      PARAMETER  (ENUBSC  =     307)
      PARAMETER  (ENUBSS  =     308)
      PARAMETER  (ESBII   =     309)
      PARAMETER  (ESPLC   =     310)
      PARAMETER  (ESPLSM  =     311)
      PARAMETER  (ESPMC   =     312)
      PARAMETER  (ESTXC   =     313)
      PARAMETER  (ESFDM   =     314)
      PARAMETER  (ESFCM   =     315)
      PARAMETER  (ESIC    =     316)
      PARAMETER  (ESISM   =     317)
      PARAMETER  (ESRFP   =     318)
      PARAMETER  (ESRFE   =     319)
      PARAMETER  (ESBIS   =     320)
      PARAMETER  (ESBISI  =     321)
      PARAMETER  (ESBIC   =     322)
      PARAMETER  (ESBISM  =     323)
      PARAMETER  (ESBRFP  =     324)
      PARAMETER  (ESBRFE  =     325)
      PARAMETER  (ESLSS   =     326)
      PARAMETER  (ESEDC   =     327)
      PARAMETER  (ESCAC   =     328)
      PARAMETER  (ESSAC   =     329)
      PARAMETER  (ESPCH   =     330)
      PARAMETER  (ESRCM   =     331)
      PARAMETER  (ESDCI   =     332)
      PARAMETER  (ESCMI   =     333)
      PARAMETER  (ESPLRP  =     334)
      PARAMETER  (ESPMRP  =     335)
      PARAMETER  (ESTXRP  =     336)
      PARAMETER  (ESIRP   =     337)
      PARAMETER  (ESEDRP  =     338)
      PARAMETER  (ESPARP  =     339)
      PARAMETER  (ESLSR   =     340)
      PARAMETER  (ESDCR   =     341)
      PARAMETER  (ESCMR   =     342)
C    error handling PEX
      PARAMETER  (EWTCRE  =     -1 )
      PARAMETER  (EWTSET  =     -2 )
      PARAMETER  (EWTGET  =     -3 )
      PARAMETER  (EWTDES  =     -4 )
      PARAMETER  (EOPPEX  =     -5 )
C    culling mode
      PARAMETER  (PNCUL   =     0  )
      PARAMETER  (PBFAC   =     1  )
      PARAMETER  (PFFAC   =     2  )
C    disting mode
      PARAMETER  (PDSNO   =     0  )
      PARAMETER  (PDSYES  =     1  )
C    depth cue mode
      PARAMETER  (PSUPPR  =     0  )
      PARAMETER  (PALLOW  =     1  )
C    facet flag
      PARAMETER  (PNOF    =     0  )
      PARAMETER  (PFCOLR  =     1  )
      PARAMETER  (PFNORM  =     2  )
      PARAMETER  (PFCONO  =     3  )
C    rationality
      PARAMETER  (PRATIO  =     0  )
      PARAMETER  (PNONRA  =     1  )
C    vertex flag
      PARAMETER  (PCOORD  =     0  )
      PARAMETER  (PCCOLR  =     1  )
      PARAMETER  (PCNORM  =     2  )
      PARAMETER  (PCCONO  =     3  )
C    edge flag
      PARAMETER  (PNOE    =     0  )
      PARAMETER  (PEVIS   =     1  )
C    HLHSR identifier
      PARAMETER  (PHIOFF  =     0  )
      PARAMETER  (PHION   =     1  )
C    HLHSR mode
      PARAMETER  (PHMNON  =     0  )
      PARAMETER  (PHMZBF  =     1  )
C    ESCAPE error synchronization mode
      PARAMETER  (PESOFF  =     0  )
      PARAMETER  (PESON   =     1  )
C    ESCAPE local input transformation type
      PARAMETER  (PLCMOD  =     0  )
      PARAMETER  (PLCVIW  =     1  )
C    ESCAPE local input transformation matrix create type
      PARAMETER  (PLCACC  =     0  )
      PARAMETER  (PLCGEN  =     1  )
C    ESCAPE local input conflation type
      PARAMETER  (PLCABU  =     0  )
      PARAMETER  (PLCPRC  =     1  )
      PARAMETER  (PLCPRU  =     2  )
C    ESCAPE local input local input rotate axis
      PARAMETER  (PLCFIR  =     0  )
      PARAMETER  (PLCSEC  =     1  )
      PARAMETER  (PLCTHI  =     2  )
C    ESCAPE view transformation effect mode
      PARAMETER  (PNPC    =     0  )
      PARAMETER  (PVPC    =     1  )
C    ESCAPE input value reference mode
      PARAMETER  (PINVAL  =     0  )
C     PARAMETER  (PVAL    =     1  ) En conflit avec l'entry   PV
C    GDP arc close type
      PARAMETER  (PACFAN  =     0  )
      PARAMETER  (PACCHD  =     1  )
C    GSE side point attribute
      PARAMETER  (PSPCIR  =     0  )
      PARAMETER  (PSPSQU  =     1  )
      PARAMETER  (PSPFLA  =     2  )
C    PHIGS moniter ON/OFF flag
      PARAMETER  (PMON    =     0  )
      PARAMETER  (PNOMON  =     1  )
C    clients side CSS flag
      PARAMETER  (PSERVR  =     0  )
      PARAMETER  (PCLIET  =     1  )
C    buffer mode
      PARAMETER  (PSINGL  =     0  )
      PARAMETER  (PDOUBL  =     1  )
*****  fin de declaration pour PHIGS
*****
*****
      SAVE IWKIDLI,KMETA,WKTY
      SAVE ICCOL,ICOISI,WKID,X1,X2,Y1,Y2,WRATIO,INUSEG
      SAVE XINID,YINID,SXMIN,SXXAX,SYMIN,SYYAX,RX,RY,AX,AY
      SAVE TEXTX,TEXTY,INCOOR,TEXTE,ICCLE,IACT,IWISS,VALEUR
      SAVE NHAUT,HAUT
      SAVE IPF
      SAVE IPPP,INMP,IDEFOR,IFF
      DIMENSION IPF(24)
C
C     declaration des variables utilisees par la partie PHIGS
C     -------------------------------------------------------
      SAVE PGSVWI,PGIVNB,PGIVIN,PGHPNB,PGHPIN,PGFLAG,PGFLZO
      SAVE PGX1,PGX2,PGY1,PGY2
      SAVE PGRX,PGRY
      save tool1
C..... sert  dans trtext a ne definir qu'une fois la vue 4
      SAVE IFV
      integer tool1
      REAL PGRX,PGRY,PGRAP
      REAL PGX1,PGX2,PGY1,PGY2
      INTEGER PGSVWI,PGIVNB,PGHPNB,PGTYPE
      INTEGER PGIVEX(1),PGHPEX(1),PGIVIN(4096),PGHPIN(4096),LIST(4096)
      INTEGER PGFLAG,PGFLZO
      INTEGER PGDEPT,PGPATH(3,2)
      REAL VWWNLM(4),PJVPLM(4)
      REAL VXMIN,VXMAX
      SAVE VXMIN,VXMAX
      INTEGER IERR,XYCLIPI,ISEG
      REAL VWMPMT(3,3),VWORMT(3,3)
C---> tableaux de correspondance des couleurs
C
C     fin modif
C-----------------------------------------------------------------------
 
      CHARACTER*(*) TITRE
      DIMENSION XTR(*),YTR(*),ZTR(*)
      DIMENSION RMAT(9)
      DIMENSION IBOIF(8)
      CHARACTER*5 NBOIF(8)
      CHARACTER*8 NAME
      CHARACTER*(*) CARACT
      CHARACTER*(500) LEGEND
      LOGICAL VALEUR,FENET,VALEU
      CHARACTER*20 STRING
      DIMENSION PXA(4),PYA(4)
      DIMENSION TEXTX(50),TEXTY(50)
      CHARACTER*1 CARELE(10)
      CHARACTER*6 STR
      CHARACTER*4 STR1
      CHARACTER*15 TEXTE(50)
      INTEGER WKID,WKCON,WKTY
      INTEGER STAT
      DATA ICCOUN/0/
      DATA CARELE /'0','1','2','3','4','5','6','7','8','9'/
      DATA STR1 /'META'/
      DATA WKID/3/
      DATA ICCOL/7/
      DATA IACT/0/
      DATA IWISS/0/
C-----------------------------------------------------------------------
C     data utilisees par la partie PHIGS
C
      DATA PGSVWI/0/
      DATA PGIVNB/0/
      DATA PGHPNB/0/
      DATA PGFLAG/0/
      DATA PGFLZO/0/
C indices de couleurs
C
C pour le 2 menu :pave correspondant aux isovaleurs
      DATA NBOIF/'ZOOM ','INI  ','VAL  ','ANIM ','IMPR ','     ',
     &           '     ','FIN  '/
      DATA IBOIF/10,13,15,11,12,0,0,17/
C-----------------------------------------------------------------------
      NCOUMA=16
      HAUT=HAUTT
      NHAUT=31
      VALEUR=VALEU
      KSEGN=0
      AX=AXAX
      AY=AYAY
C     DO 1 NBCR=72,2,-1
      DO1NBCR=72,2,-1
      IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2
   1  CONTINUE
   2  CONTINUE
C
C PTRINIT1
C  debut du bloc phigs de TRINIT
C
  60  CONTINUE
C ---------------------------------------------------------------
C :                       menu     fen princ   legendes  texte  :
C :   numeros de vues      1          2          3        4     :
C ---------------------------------------------------------------
 
C     iff sert a gerer l'effac. des stuct.ass. a du texte
      IFF=0
      IFV=0
*  je ne sais pas a quoi ca sert
      IPPP=0
      INMP=0
      IDEFOR=0
      IFF=0
C     indicateur de zoom
      PGFLZO=0
 
C     numero de vue
      PGSVWI=0
 
C     indicateur d'impresssion pour les fichiers trace
C     (mettre inmp=1 si aucun fichier trace n'est desire)
      ippp=0
      inmp=0
C
      X1=0.
      X2=0.
      Y1=0.
      Y2=0.
      INCOOR=0
C     numeros de structures associes au texte (vue 4)
      INUSEG=50+(100*(WKID-1))
      IXSEG=0
      ICCLE=0
      IF(IACT.EQ.1) THEN
C permet de savoir si une structure est ouverte
       CALL PQOPST(IIERR,PGTYPE,INUM)
C       si oui elle est fermee
       IF(PGTYPE.EQ.POPNST) CALL PCLST
       NWAC=0
C       permet de savoir si Work station est ouverte
C       Dans FIGARO il ne peut y avoir qu'une seule Work station
C  d'ouverte a la fois
  62   CALL PQOPWK(NWAC,IERR,NTWAC,NWID)
       IF(NWID.EQ.WKID)GOTO 61
       IF(NWAC.EQ.NTWAC)GOTO 63
       NWAC=NWAC+1
       GOTO 62
  61   CONTINUE
C       si oui les structures associes sont depostees
       CALL PUPAST(WKID)
       GOTO 65
  63   CONTINUE
       GOTO 64
      ENDIF
C       si phigs n'a pas ete ouvert il est ouvert ici
      IF (PGFLAG.EQ.0) THEN
         CALL POPPH(6,0)
C        on definit les parametres de la fenetre graphique
*        CALL PHIGSWSTCREATE(phigswsttool, tool1)
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLFGDCLR,120,120,120)
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLLABEL,"Graphique CASTEM2000")
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLWIDTH, 600)
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLHEIGHT, 600)
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLX, 542)
*        CALL PHIGSWSTSET(tool1, PHIGSTOOLY, 277)
         PGFLAG = 1
      ENDIF
 
  64  CONTINUE
      WKCON=0
C       ouverture de la Work station WKID
C*****      CALL POPWK(WKID,WKCON,phigswsttool)
      tool1=0
      CALL POPWK(WKID,WKCON,tool1)
      CALL PSDUS(WKID,4,0)
  65  CONTINUE
C      WKCON=0
      IWKIDLI=3
      KMETA=1
      WKTY=0
      IACT=1
*  creation de la structure initiale : 1   PV
      CALL POPST(1)
      CALL PEMST(1)
      ISGNEW=9+(100*(WKID-1))
       CALL PEXST(ISGNEW)
       CALL PEXST(3)
      ISEG=6+(100*(WKID-1))
      CALL PEXST(ISEG)
      CALL PCLST
      CALL POPST(ISGNEW)
       CALL PEMST(ISGNEW)
      CALL PCLST
      CALL POPST(3)
      CALL PEMST(3)
      CALL PADS(1,3)
      CALL PSVWI(PGSVWI)
      CALL PCLST
      CALL PPOST(WKID,1,1.)
C       ouverture de la structure ISEG
      CALL POPST(ISEG)
C       la structure ISEG est videe
      CALL PEMST(ISEG)
C       la structure ISEG est postee sur la Work station WKID
C     CALL PPOST(WKID,ISEG,1.)
C       name set utilse par les filtres d'invisibilite et de detectabili
      CALL PADS(1,ISEG)
C       la structure ISEG est associee a la vue PGSVWI
      CALL PSVWI(PGSVWI)
C       mise a jour des filtres d'invisiblite
      CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
      CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
      CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
      CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
C       redefinition des couleurs
*       XAllocNamedColor(dp,colors,"white",&xcsd[0],&xced);
*       XAllocNamedColor(dp,colors,"blue",&xcsd[1],&xced);
*       XAllocNamedColor(dp,colors,"red",&xcsd[2],&xced);
*       XAllocNamedColor(dp,colors,"magenta",&xcsd[3],&xced);
*       XAllocNamedColor(dp,colors,"green",&xcsd[4],&xced);
*       XAllocNamedColor(dp,colors,"MediumTurquoise",&xcsd[5],&xced);
*       XAllocNamedColor(dp,colors,"yellow",&xcsd[6],&xced);
*       XAllocNamedColor(dp,colors,"white",&xcsd[7],&xced);
*       XAllocNamedColor(dp,colors,"black",&xcsd[8],&xced);
*       XAllocNamedColor(dp,colors,"DarkSlateBlue",&xcsd[9],&xced);
*       XAllocNamedColor(dp,colors,"orange",&xcsd[10],&xced);
*       XAllocNamedColor(dp,colors,"VioletRed",&xcsd[11],&xced);
*       XAllocNamedColor(dp,colors,"MediumSeaGreen",&xcsd[12],&xced);
*       XAllocNamedColor(dp,colors,"DarkTurquoise",&xcsd[13],&xced);
*       XAllocNamedColor(dp,colors,"YellowGreen",&xcsd[14],&xced);
*       XAllocNamedColor(dp,colors,"LightGrey",&xcsd[15],&xced);
      CALL PSCR(WKID,0,3,0.0,0.0,0.0)
      CALL PSCR(WKID,1,3,0.0,0.0,1.0)
      CALL PSCR(WKID,2,3,1.0,0.0,0.0)
      CALL PSCR(WKID,3,3,1.0,0.0,1.0)
      CALL PSCR(WKID,4,3,0.0,1.0,0.0)
      CALL PSCR(WKID,5,3,72/255.,209/255.,204/255.)
      CALL PSCR(WKID,6,3,1.0,1.0,0.0)
      CALL PSCR(WKID,7,3,1.0,1.0,1.0)
      CALL PSCR(WKID,8,3,0.0,0.0,0.0)
      CALL PSCR(WKID,9,3,112/255.,101/255.,179/255.)
      CALL PSCR(WKID,10,3,255/255.,165/255.,0.0)
      CALL PSCR(WKID,11,3,208/255.,32/255.,144/255.)
      CALL PSCR(WKID,12,3,60/255.,179/255.,113/255.)
      CALL PSCR(WKID,13,3,0.0,206/255.,209/255.)
      CALL PSCR(WKID,14,3,154/255.,205/255.,50/255.)
      CALL PSCR(WKID,15,3,211/255.,211/255.,211/255.)
C
C       permet de connaitre les dimensions de la fenetre SunPHIGS
C****      CALL PQDSP(phigswsttool,IERR,DC,RX,RY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,RX,RY,LX,LY)
      WRATIO=RY/RX
      R=RY
      IF(WRATIO.GT.1)THEN
      R=RX
      WRATIO=1./WRATIO
      ENDIF
C       definition de la window et de la viewport en fonction du ratio
      CALL PSWKW(WKID,0.,1.,0.,1.)
      IF (RX.LE.RY) THEN
        VXMIN = 0.
        VXMAX = RX
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ELSE
        VXMIN = 0.
        VXMAX = RY
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ENDIF
      WRATIO=1.
C      CALL OSVMP(WKID,1,0.,80.,0.,2.,0.,1.,0.,(WRATIO)*0.1)
      VWWNLM(1) = 0.
      VWWNLM(2) = 80.
      VWWNLM(3) = 0.
      VWWNLM(4) = 2.
      PJVPLM(1) = 0.
      PJVPLM(2) = 1.
      PJVPLM(3) = 0.
      PJVPLM(4) = (WRATIO)*0.1
      CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
      VWORMT(1,1) = 1.
      VWORMT(2,2) = 1.
      VWORMT(3,3) = 1.
      VWORMT(1,2) = 0.
      VWORMT(1,3) = 0.
      VWORMT(2,1) = 0.
      VWORMT(2,3) = 0.
      VWORMT(3,1) = 0.
      VWORMT(3,2) = 0.
      XYCLIPI = 1
      CALL PSVWR(WKID,1,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      PGSVWI=1
C       si une structure est ouverte ,elle est associe a la vue 1
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
C       declaration de la taille du text annote
C*      CALL PSATCH(0.02)
      CALL PSATCH(0.015)
C       definition de la couleur du text
       CALL PSTXCI(7)
C       choix de la police de caracteres
C      CALL PSTXFN(-1)
      CALL PSTXFN(-5)
C      CALL PSHSP(0.2)
C       definition de la precision du text
      CALL PSTXPR(2)
C       ecriture du text annote
      CALL PATR(63.,1.3,0.,0.,'CASTEM 2000')
      CALL PATR(.6,1.3,0.,0.,TITRE)
      CALL PCLST
C      CALL PUWK(WKID,1)
      RETURN
C***********************************************************************
 
C
C     subroutine DFENET
C
      ENTRY PDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET)
      EC1=AX-3.
      EC2=AY-3.
C
C   PDFENET 2
C debut du bloc phigs de DFENET
C
 160  CONTINUE
C       calcule de la fenetre de la vue 2
      SXMIN=XMIN
      SXXAX=XXAX
      SYMIN=YMIN
      SYYAX=YYAX
C       on se laisse une marge pour le text
      XDIFF=(XXAX-XMIN)/2.*1.10
      YDIFF=(YYAX-YMIN)/2.*1.10
      XMILL=(XXAX+XMIN)/2.
      YMILL=(YYAX+YMIN)/2.
      IF (FENET) THEN
      RAP=(XDIFF/YDIFF)
      ELSE
      RAP=1.
      ENDIF
      IF (RAP.GE.1) THEN
       X1=XMILL-XDIFF
       X2=XMILL+XDIFF
       Y1=YMILL-(YDIFF*RAP)
       Y2=YMILL+(YDIFF*RAP)
      ELSE
       X1=XMILL-(XDIFF/RAP)
       X2=XMILL+(XDIFF/RAP)
       Y1=YMILL-YDIFF
       Y2=YMILL+YDIFF
      ENDIF
C       sauvegarde des valeurs de la fenetre pour le retour a la vue
C  initiale
      PGX1=X1
      PGX2=X2
      PGY1=Y1
      PGY2=Y2
C  (pour pouvoir faire un req loc)
C      CALL PSVWCS(WKID,2,1,1,1,0,0)
      CALL PSVTIP(WKID,2,0,0)
 
C****      CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
      PGRAP=MIN (PGRX/RX,PGRY/RY)
      IF (PGRX .LE. PGRY) THEN
        VXMIN = .5*(PGRX-PGRAP*RX)
        VXMAX = .5*(PGRX+PGRAP*RX)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ELSE
        VXMIN = .5*(PGRX-PGRAP*RY)
        VXMAX = .5*(PGRX+PGRAP*RY)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ENDIF
 
      VWWNLM(1) = X1
      VWWNLM(2) = X2
      VWWNLM(3) = Y1
      VWWNLM(4) = Y2
      VWORMT(1,1) = 1.
      VWORMT(2,2) = 1.
      VWORMT(3,3) = 1.
      VWORMT(1,2) = 0.
      VWORMT(1,3) = 0.
      VWORMT(2,1) = 0.
      VWORMT(2,3) = 0.
      VWORMT(3,1) = 0.
      VWORMT(3,2) = 0.
      XYCLIPI = 1
      PJVPLM(1) = 0.
      PJVPLM(3) = (WRATIO)*0.1
      IF(VALEUR) THEN
C       CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.8,(WRATIO)*0.1,(WRATIO)*0.9)
        PJVPLM(2) = 0.8
 
        PJVPLM(4) = (WRATIO)*0.9
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ELSE
C       CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.9,(WRATIO)*0.1,(WRATIO))
        PJVPLM(2) = 0.9
 
        PJVPLM(4) = WRATIO
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ENDIF
 
      PGSVWI=2
C       si une structure est ouverte ,elle est associe a la vue 2
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
      XINID=(X1+X2)/2.
      YINID=(Y1+Y2)/2.
      XR1=XMIN
      XR2=XXAX
      YR1=YMIN
      YR2=YYAX
C       fermeture eventuelle d'une structure ouverte ,elle est aussi vid
      CALL PQOPST(IIERRI,PGTYPE,INUM)
      IF(PGTYPE.EQ.POPNST) THEN
       CALL PCLST
       CALL PEMST(INUM)
      ENDIF
      INUM=8+(100*(WKID-1))
      CALL PEMST(INUM)
      ISEG=1+(100*(WKID-1))
C............................................
C reinitialisation du contexte
C       ouverture de la structure ISEG
       CALL POPST(1)
       CALL PEXST(ISEG)
       CALL PCLST
      CALL POPST(ISEG)
C       la structure ISEG est videe
      CALL PEMST(ISEG)
      CALL PADS(1,ISEG)
C       la structure ISEG est associee a la vue PGSVWI
      CALL PSVWI(PGSVWI)
C       la structure est declaree visible et detectable
      CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
      CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
      CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
      CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
      IXSEG=1
C       choix de la police de caracteres
      CALL PSTXFN(-4)
C       definition de la precision du text
      CALL PSTXPR(2)
      CHH=(Y2-Y1)/50.0
C       taille des caracteres par defaut ( important pour le trace de
C       courbes
      CALL PSCHSP(0.15)
C       declaration de la taille du text annote
      CALL PSATCH(0.010)
      CHXPO = 1.
      CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
C       definition des attributs de couleur en fonction de la couleur
C  courant (ICCOL)
      CALL PSICI(ICCOL)
      CALL PSPLCI(ICCOL)
      CALL PSPMCI(ICCOL)
      CALL PSTXCI(ICCOL)
      ICOISI=-100
C...... ecriture du fichier trace
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
      RETURN
C***********************************************************************
C
C     subroutine TRLABL
C
      ENTRY PTRLAB(X,Y,CARACT,NCAR,HAUTT)
      HAUT=HAUTT
C     DO 201 ICAR=NCAR,1,-1
      DO201ICAR=NCAR,1,-1
      IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202
 201  CONTINUE
      RETURN
 202  CONTINUE
C
C   PTRLABL 3
C  debut du bloc phigs de TRLABL
C
 260  CONTINUE
      CALL PQOPST(IERR,ISTYPE,ID)
      IF (ISTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
C      CALL PSCHSP(0.10)
      CALL PSCHSP(0.20)
      CALL PSTXFN(-2)
C     on retrace le texte
      CALL PATR(X,Y,0.,0.,CARACT)
      RETURN
C***********************************************************************
 
C
C     subroutine TRBOX
C
      ENTRY PTRBOX (HAUTX,HAUTY)
C
C  debut du bloc phigs de TRBOX
C
 1260 CONTINUE
CCCC      CALL PSTXFN(-1)
C       definition de la precision du texte
 
      CALL PSTXPR(2)
      CHH = 0.01
      CHXP = 1.
      RETURN
C***********************************************************************
C
C     subroutine CHCOUL
C
      ENTRY PCHCOU(JCOLO)
C
C   PCHCOUL 5
C  debut du bloc phigs de CHCOUL
C
 345  CONTINUE
C       si il n'y a pas eu de zoom
C       definition des attributs de couleur en fonction de la couleur
C  courante (ICCOL)
C      IF (PGFLZO.EQ.0) THEN
       CALL PSICI(JCOLO)
       CALL PSPLCI(JCOLO)
       CALL PSPMCI(JCOLO)
       CALL PSTXCI(JCOLO)
C      ENDIF
      RETURN
C***********************************************************************
 
C
C     subroutine FVALIS
C
      ENTRY PFVALI(IFENI,IRESU,NH)
C
C  PFVALIS 6
C  debut du bloc phigs de FVALIS
C
 390  CONTINUE
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
C
      IF (IFENI.EQ.1) THEN
      WRATIO=1
      IRESU=0
C........................................................
 
C.... definition de la vue numero 3
C****      CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
      PGRAP=MIN (PGRX/RX,PGRY/RY)
      IF (PGRX .LE. PGRY) THEN
        VXMIN = .5*(PGRX-PGRAP*RX)
        VXMAX = .5*(PGRX+PGRAP*RX)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ELSE
        VXMIN = .5*(PGRX-PGRAP*RY)
        VXMAX = .5*(PGRX+PGRAP*RY)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ENDIF
 
C      CALL OSVMP(WKID,3,0.,1.,2.,33.,0.81,1.,(WRATIO)*0.1,(WRATIO)*0.9)
      VWWNLM(1) = 0.
      VWWNLM(2) = 1.
      VWWNLM(3) = 2.
      VWWNLM(4) = 33.
      PJVPLM(1) = 0.81
      PJVPLM(2) = 1.
      PJVPLM(3) = (WRATIO)*0.1
      PJVPLM(4) = (WRATIO)*0.9
      CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
      VWORMT(1,1) = 1.
      VWORMT(2,2) = 1.
      VWORMT(3,3) = 1.
      VWORMT(1,2) = 0.
      VWORMT(1,3) = 0.
      VWORMT(2,1) = 0.
      VWORMT(2,3) = 0.
      VWORMT(3,1) = 0.
      VWORMT(3,2) = 0.
      XYCLIPI = 1
      CALL PSVWR(WKID,3,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      PGSVWI=3
C......................................................
C     si une structure est ouverte ,elle est associe a la vue 3
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
      ELSE
      PGSVWI=2
C       si une structure est ouverte ,elle est associe a la vue 2
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
      ENDIF
      NH=31
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
      RETURN
C***********************************************************************
 
C
C     subroutine MENU
C
      ENTRY PMENU(LEGEND,NCASE,LLONG)
C
C  debut du bloc phigs de MENU
C
      DO 805 II=1,24
      IPF(II)=1
 805  CONTINUE
 460  CONTINUE
C     remise a 0 du flag de zoom lors de la definition des menus
      PGFLZO = 0
      PGSVWI=1
C       si une structure est ouverte ,on l'associe a la vue 1 et elle
C  est fermee
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) THEN
        CALL PSVWI(PGSVWI)
 
        CALL PCLST
 
      ENDIF
       XB=1.
      NCASE1=0
      DO 464 KBOIT=1,13
       IF(KBOIT.LE.NCASE) THEN
           MLONG=LLONG
       ELSE
           MLONG=1
       ENDIF
       IF (MLONG.NE.1) NCASE1=NCASE1+1
C         on efface les menus pouvant subsister !
          ISEG=KBOIT+9+(100*(WKID-1))
       CALL POPST(ISEG)
       CALL PEMST(ISEG)
       CALL PCLST
 464  CONTINUE
      DO 465 KBOIT=1,13
       KKIMP=0
       IF(KBOIT.LE.NCASE) THEN
           MLONG=LLONG
       ELSE
           MLONG=1
       ENDIF
       IF (KBOIT.EQ.12.AND.IPF(2).NE.0.AND.MLONG.EQ.1) KKIMP=1
       IF (KKIMP.EQ.1) MLONG=4
       IF (MLONG.EQ.1) GOTO 447
C       definition d'autant de structures que de paves necessaire au
C  menu
       ISEG=KBOIT+9+(100*(WKID-1))
       CALL POPST(1)
       CALL PEXST(ISEG)
       CALL PCLST
       CALL POPST(ISEG)
       CALL PEMST(ISEG)
       CALL PADS(1,ISEG)
       CALL PSVWI(PGSVWI)
       CALL PSPKID(ISEG)
C       ils sont tous rendus visibles et detectables
       CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
       CALL PSVIS(PGHPNB,PGHPIN,ISEG,1)
       CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
       CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
       CALL PSIS(1)
          CALL PSICI(2)
C
       PXA(1)=XB
       PXA(2)=PXA(1)+2.0
       PXA(3)=PXA(2)
       PXA(4)=PXA(1)
       PYA(1)=0.6
       PYA(2)=PYA(1)
       PYA(3)=PYA(1)+0.4
       PYA(4)=PYA(3)
C       definition du pave
       CALL PFA(4,PXA,PYA)
C textes en rouge sous les paves du menu
       CALL PSTXCI(2)
C definition de la police de caracteres et de la precision
       CALL PSTXFN(-1)
       CALL PSTXPR(2)
       CALL PSCHSP(0.15)
C       definition de la hauteur du text annote
       CALL PSATCH(0.014)
C       ecriture du text correspondant au pave
       IF (KKIMP.EQ.1) THEN
        CALL PATR(PXA(1),0.1,0.,0.,'Meta')
       ELSE
        IDEBTX=1
        DO 466 IIT=1,MLONG
C         IF (LEGEND(KBOIT)(IIT:IIT).NE.' ') GOTO 467
          IF (LEGEND(IIT+(KBOIT-1)*MLONG:
     &               IIT+(KBOIT-1)*MLONG).NE.' ') GOTO 467
 466    CONTINUE
 467    CONTINUE
C       CALL PATR(PXA(1),0.1,0.,0.,LEGEND(KBOIT)(IIT:MLONG))
        CALL PATR(PXA(1),0.1,0.,0.,LEGEND(IIT+(KBOIT-1)*MLONG:
     &                                    KBOIT*MLONG))
       ENDIF
       CALL PCLST
       XB=XB+80./(NCASE1+1)
 447   CONTINUE
 465  CONTINUE
      IF (PGTYPE.EQ.POPNST) CALL POPST(INUM)
      PGSVWI=2
C       si une structure est ouverte elle est associee a la vue 2
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
      RETURN
C***********************************************************************
C
C     subroutine INSEGT
C
      ENTRY PINSEG(NBSEGT,IRESS)
C ce ssp entre en jeu dans l'ecriture des neouds,elements et objets
C -----------------------------------------------------------------
C
C  debut du bloc phigs de INSEGT
C
 560  CONTINUE
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
C       si un zoom n'a pas ete fait
      IF (PGFLZO.EQ.0) THEN
       IF (IRESS.NE.2) THEN
          IF (IRESS.LT.2.OR.IRESS.GT.5) THEN
         CALL PCLST
        ENDIF
       ELSE
        IRESS=7
       ENDIF
C       si une structure est ouverte elle est fermee
       CALL PQOPST(IIERR,PGTYPE,IOP)
       IF (PGTYPE.EQ.POPNST) CALL PCLST
       ISEG=NBSEGT+(100*(WKID-1))
       CALL POPST(1)
       CALL PEXST(ISEG)
       CALL PCLST
       CALL POPST(ISEG)
       CALL PEMST(ISEG)
       CALL PADS(1,ISEG)
       CALL PSVWI(PGSVWI)
       CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
       CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
       CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
       CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
C       definition du style du text annote
       CALL PSANS(2)
C       definition de la hauteur du text annote
C*       CALL PSATCH(0.014)
       CALL PSATCH(0.017)
      ENDIF
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
      RETURN
C***********************************************************************
 
C
C     subroutine POLRL
C
      ENTRY PPOLRL(NTRSTU,XTR,YTR,ZTR)
      NTR=NTRSTU
      IF (NTR.LE.1) RETURN
C  PPOLRL 9
C  debut du bloc phigs de POLRL
C
 660  CONTINUE
      IF (NTR.LE.1) RETURN
      PGSVWI=2
C       la sructure ouverte est associee a la vue 2
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
 
C       definition d'une polyline
      CALL PPL(NTR,XTR(1),YTR(1))
      RETURN
C***********************************************************************
 
C
C     subroutine TRDIG
C
      ENTRY PTRDIG(X,Y,INCLE)
      INCLE=0
C  debut du bloc phigs de TRDIG
C
 860  CONTINUE
C****      CALL PQDSP(phigswsttool,IERR,DC,NRX,NRY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,PNRX,PNRY,LX,LY)
      NWRATIO=PNRY/PNRX
      IF(NWRATIO.GT.1)THEN
      NWRATIO=1./NWRATIO
      ENDIF
C updater la structure --- PV
       CALL PUWK(WKID,1)
C..... locator en mode request
      CALL PSLCM(WKID,1,0,1)
      CALL PRQLC(WKID,1,ISTAT,ITNR,X,Y)
C..... calcul des coordonnees
C           y=y*nwratio
           y=y*wratio
C  Effacer le message --- PV
       CALL PEMST(2)
C.....
      IF((X.LT.X1).OR.(X.GT.X2))INCLE=3
      IF((Y.LT.Y1).OR.(Y.GT.Y2))INCLE=3
 
C..... reinitialisation des variables de sorties
      XINID=X
      YINID=Y
      RETURN
C***********************************************************************
C
C     subroutine TRFACE
C
      ENTRY PTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF)
      IEFF=0
      KP=INT(ZN*4./1.58)+1
C
C  debut du bloc phigs de TRFACE
C
 960  CONTINUE
      IEFF=0
      PGSVWI=2
C       la structure ouverte est associe a la vue 2
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
      IEFF=1
      IF (KP.NE.4) THEN
      ENDIF
C       definition de la couleur et du style de la facette
      CALL PSICI(ICOLE)
      CALL PSIS(1)
C       definition de la facette
      CALL PFA(NP,XTR,YTR)
      RETURN
C***********************************************************************
C
C     subroutine TRAISO
C
      ENTRY PTRAIS(NP,XTR,YTR,ICOLE)
C
C   PTRAISO 12
C  debut du bloc phigs de TRAISO
C
1060  CONTINUE
C pour pallier un petit bug dans le trace de la mire d'isovaleurs
      ICOISI=ICOLE
C       definition de la couleur de la facette
      CALL PSICI(ICOISI)
      CALL PQOPST(IERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
 
      CALL PSIS(1)
      CALL PFA(NP,XTR,YTR)
      RETURN
C***********************************************************************
 
C
C     subroutine TREFF
C
      ENTRY PTREFF
 1160 CONTINUE
      RETURN
C***********************************************************************
C
C     subroutine TRAFF
C
      ENTRY PTRAFF(ICLE)
      ICLE=0
C
C   PTRAFF 17
C  debut du bloc phigs de TRAFF
C
 1560 CONTINUE
      ICLE=0
      CALL PQOPST(IIERRI,PGTYPE,INUM)
C
      ISGNEW=9+(100*(WKID-1))
      IF(PGTYPE.EQ.POPNST)   CALL PCLST
      CALL POPST(ISGNEW)
      ISEG=0
       CALL PSPKM(WKID,1,0,1)
        CALL PUWK(WKID,1)
C        CALL PRST(WKID,1)
 1561  CONTINUE
C
       CALL PRQPK(WKID,1,2,ISTAT,PGDEPT ,PGPATH)
           ICHNR=PGPATH(1,2)
           PCID=PGPATH(2,2)
           ISEG=ICHNR-(100*(WKID-1))
       IF (ISTAT.NE.1.OR.ICHNR.EQ.0) THEN
        CALL PSDUS(WKID,3,0)
        CALL PSDUS(WKID,4,0)
        GOTO 1561
       ENDIF
C effacer message dialogue
       CALL PEMST(2)
       IF(ISEG.GE.50) THEN
        CALL PSSTM(WKID,1,0,1)
        CALL PRQST(WKID,1,ISTAT,IL,STRING)
        CALL PEMST(ICHNR)
       CALL POPST(1)
       CALL PEXST(ICHNR)
       CALL PCLST
        CALL POPST(ICHNR)
C       CALL PPOST(WKID,ICHNR,1.)
        CALL PADS(1,ICHNR)
        CALL PSVWI(PGSVWI)
        CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
        CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
        XX=TEXTX(ISEG-50+1)
        YY=TEXTY(ISEG-50+1)
        CALL PATR(XX,YY,0.,0.,STRING)
        CALL PCLST
       CALL PSVIS(PGHPNB,PGHPIN,ICHNR,1)
        CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
        TEXTE(ISEG-50+1)(1:15)=STRING(1:15)
       ENDIF
       ICLE=ISEG
       ICLE=ICLE-10
       write (6,*) ' icle ',icle
       if (icle.ne.0.and.ipf(icle).eq.0) goto 1560
C
      CALL PSDUS(WKID,4,0)
C
      CALL PSVWI(PGSVWI)
      CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
      CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
C
      RMAT(1)=1.
      RMAT(2)=0.
      RMAT(3)=0.
      RMAT(4)=1.
      RMAT(5)=0.
      RMAT(6)=0.
      IF (INMP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
C
      RETURN
C***********************************************************************
C
C     subroutine TRMFIN
C
      ENTRY PTRMFI
C   PTRNFN 19
C  debut du bloc phigs de TRMFIN
C
 1860 CONTINUE
*     IACT=0
      IWISS=0
C  essai
C devrait permettre a l'utilisateur de savoir qu'il a selectionne la tou
*      CALL POPST(1)
*      CALL PEXST(INUSEG)
*      CALL PCLST
*     CALL POPST(INUSEG)
*        CALL PSTXPR(2)
*        CALL PSTXFN(-1)
*        CALL PSCHSP(0.1)
*        CALL PSATCH(0.015)
*        CALL PSTXCI(7)
*     CALL PATR(3.,34.,0.,0.,'Fin de session de CASTEM2000')
*     CALL PCLST
C     CALL PPOST(WKID,INUSEG,1.)
C      CALL PXPSV(WKID,4,INUSEG,1.)
*     CALL PUWK(WKID,1)
*     PGFLAG = 0
      RETURN
C***********************************************************************
 
C
C     subroutine ZOOM
C
*     ENTRY PZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
      ENTRY PZOOM(IZOOM,XMI,XMA,YMI,YMA)
C
C   PZOOM 20
C  debut du bloc phigs de ZOOM
C
2060  CONTINUE
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
C................................
      IRESU=1
      ITNR=2
*1093 ISORT=1
 
C       la flag du zoom est mis a 1
      PGFLZO = 1
C      CALL PSVWCS(WKID,2,1,1,1,0,0)
      CALL PSVTIP(WKID,2,0,0)
      PGSVWI=0
C       la structure ouverte est associee a la vue 0
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
C.... locator en mode request
      CALL PSLCM(WKID,1,0,1)
C       demande du premier locator
      CALL PRQLC(WKID,1,STAT,ITNR1,XRO,YRO)
C       demande du deuxieme locator
      CALL PRQLC(WKID,1,STAT,ITNR1,XCOL,YCOL)
 
C       definition du carre inscrit dans la zone saisie
      XMI=MIN(XRO,XCOL)
      XMA=MAX(XRO,XCOL)
      YMI=MIN(YRO,YCOL)
      YMA=MAX(YRO,YCOL)
C..... pour eviter les messages d'erreur dus aux valeurs trop petites
      A=XMA-XMI
      B=YMA-YMI
      IF (A.LE.0.001) THEN
         XMI=XMI*0.85
         XMA=XMA*1.25
      ENDIF
      IF (B.LE.0.001) THEN
         YMI=YMI*0.85
         YMA=YMA*1.25
      ENDIF
 
      XC=XMI+A/2
      YC=YMI+B/2
      C=(A/2+B/2)/2
      IF ((A/B.LT.1).OR.(B/A.LT.1)) THEN
C pour les cas particuliers ou a&lt;&lt;b ou b&lt;&lt;a
          IF(A/B.LE.10) THEN
              XMI=XC-A/2
              XMA=XC+A/2
          ELSE
             IF (B/A.LE.10) THEN
                YMI=YC-B/2
                YMA=YC+B/2
             ENDIF
          ENDIF
      ELSE
C cas ou a et b sont du meme ordre de grandeur
C on prend un carre
      XMA=MAX(XMA,YMA-YMI+XMI)
      YMI=MIN(YMI,-XMA+XMI+YMA)
      endif
C
      X1=XMI
      X2=XMA
      Y1=YMI
      Y2=YMA
C..... redefinition de la vue
C****      CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
      PGRAP=MIN(PGRX/RX,PGRY/RY)
      IF (PGRX .LE. PGRY) THEN
        VXMIN = .5*(PGRX-PGRAP*RX)
        VXMAX = .5*(PGRX+PGRAP*RX)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ELSE
        VXMIN = .5*(PGRX-PGRAP*RY)
        VXMAX = .5*(PGRX+PGRAP*RY)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ENDIF
C.... redefinition de la vue 2
      VWWNLM(1) = XMI
      VWWNLM(2) = XMA
      VWWNLM(3) = YMI
      VWWNLM(4) = YMA
      PJVPLM(1) = 0.
      PJVPLM(3) = (WRATIO)*0.1
      VWORMT(1,1) = 1.
      VWORMT(2,2) = 1.
      VWORMT(3,3) = 1.
      VWORMT(1,2) = 0.
      VWORMT(1,3) = 0.
      VWORMT(2,1) = 0.
      VWORMT(2,3) = 0.
      VWORMT(3,1) = 0.
      VWORMT(3,2) = 0.
      XYCLIPI = 1
      IF (VALEUR) THEN
C        CALL OSVMP(WKID,2,XMI,XMA,YMI,YMA,0.,0.8,(WRATIO)*0.1,
C     &             (WRATIO)*0.9)
        PJVPLM(2) = 0.8
 
        PJVPLM(4) = (WRATIO)*0.9
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ELSE
C        CALL OSVMP(WKID,2,XMI,XMA,YMI,YMA,0.,0.9,(WRATIO)*0.1,
C     &             (WRATIO))
        PJVPLM(2) = 0.9
 
        PJVPLM(4) = WRATIO
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ENDIF
 
C.... mise a jour des variables de sorties
      XMI = SXMIN
      XMA = SXXAX
      YMI = SYMIN
      YMA = SYYAX
      PAS = 1
C   cf gks ou gddm
C      IF (IDEFOR.NE.0) THEN
C           ISORT=0
C      END
C
*1093 IF (IQUALI.EQ.10) IQUALI=0
*1093 IF (INUMNO.EQ.10) INUMNO=0
*1093 IF (INUMEL.EQ.10) INUMEL=0
C   cf gks ou gddm
*1093 ISORT=1
      IRESU=2
C
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
 
      RETURN
C***********************************************************************
 
C
C     subroutine CHANG
C
      ENTRY PCHANG(IRESU,ISORT,ICHANG,JSEG)
C   PCHANG 21
C  debut du bloc phigs de CHANG
C
 2260  CONTINUE
      ISEG=JSEG+(100*(WKID-1))
      IF (ICHANG.EQ.1) THEN
         ICHANG=10
C       la structure ISEG est rundue invisible
          CALL PSVIS(PGIVNB,PGIVIN,ISEG,1)
          CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
         ISORT=0
         RETURN
      ELSEIF (ICHANG.EQ.10) THEN
         ICHANG=1
C       ls structure ISEG est rendue visible
          CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
          CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
         ISORT=0
         RETURN
      ENDIF
      CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
      ISORT=1
      IRESU=JSEG
      ICHANG=1
      RETURN
C***********************************************************************
 
C
C     subroutine INI
C
      ENTRY PINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
C   PINI 22
C  debut du bloc phigs de INI
C
 2460  CONTINUE
      PGSVWI=2
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
      ISEG=1+(100*(WKID-1))
C       les valeurs initiales de la vue 2 sont restaurees
      X1=PGX1
      X2=PGX2
      Y1=PGY1
      Y2=PGY2
      PGCEH = 1
C****      CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
      CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
      PGRAP=MIN (PGRX/RX,PGRY/RY)
      IF (PGRX .LE. PGRY) THEN
        VXMIN = .5*(PGRX-PGRAP*RX)
        VXMAX = .5*(PGRX+PGRAP*RX)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ELSE
        VXMIN = .5*(PGRX-PGRAP*RY)
        VXMAX = .5*(PGRX+PGRAP*RY)
        CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
      ENDIF
      VWWNLM(1) = X1
      VWWNLM(2) = X2
      VWWNLM(3) = Y1
      VWWNLM(4) = Y2
      VWORMT(1,1) = 1.
      VWORMT(2,2) = 1.
      VWORMT(3,3) = 1.
      VWORMT(1,2) = 0.
      VWORMT(1,3) = 0.
      VWORMT(2,1) = 0.
      VWORMT(2,3) = 0.
      VWORMT(3,1) = 0.
      VWORMT(3,2) = 0.
      XYCLIPI = 1
      PJVPLM(1) = 0.
      PJVPLM(3) = (WRATIO)*0.1
      IF (VALEUR) THEN
C       redefinition de la vue 2
C        CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.8,
C     &             (WRATIO)*0.1,(WRATIO)*0.9)
        PJVPLM(2) = 0.8
 
        PJVPLM(4) = (WRATIO)*0.9
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ELSE
C       redefinition de la vue 2
C        CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.9,
C     &             (WRATIO)*0.1,(WRATIO))
        PJVPLM(2) = 0.9
 
        PJVPLM(4) = WRATIO
 
        CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
        CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
      ENDIF
C      CALL PUWK(WKID,1)
      IF (IDEFOR.NE.0) THEN
        ISORT=0
        RETURN
      ENDIF
C       les valeurs de la vue sont restituees
      XMI = SXMIN
      XMA = SXXAX
      YMI = SYMIN
      YMA = SYYAX
      PAS = 1
      IDEL1=0
      IDEL2=0
      IDEL3=0
      IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
      IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
      IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
C       les structures contenant les noeuds ,les elements et les quals
C  sont videes
      IF (IDEL1.NE.0) CALL PEMST(IDEL1)
      IF (IDEL2.NE.0) CALL PEMST(IDEL2)
      IF (IDEL3.NE.0) CALL PEMST(IDEL3)
      IF (IQUALI.EQ.10) IQUALI=0
      IF (INUMNO.EQ.10) INUMNO=0
      IF (INUMEL.EQ.10) INUMEL=0
      XMI=SXMIN
      XMA=SXXAX
      YMI=SYMIN
      YMA=SYYAX
      ISORT=1
      IRESU=2
C
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
 
      RETURN
C***********************************************************************
 
C
C     subroutine FLGI
C
      ENTRY PFLGJ
C
C  PFLGI 23
C  debut du bloc phigs de FLGI
C
2860  CONTINUE
      IANIM=0
      IF(IANIM.EQ.0) RETURN
      NGG=100.
C     DO 2861 IFOO=1,20
      DO2861IFOO=1,20
C     DO 2862 ICOL=1,7
      DO2862ICOL=1,7
      DO2863JCOL=1,7
        JXCOL=JCOL
        CALL PSCR(WKID,JXCOL,3,0.0,0.0,0.0)
2863    CONTINUE
        IXCOL=ICOL
        CALL PSCR(WKID,IXCOL,3,1.0,1.0,1.0)
        IKKK=0
      DO2864IKKL=1,100000
C      DO2864IKKL=1,30000
        IKKK=IKKK+1
2864    CONTINUE
2862  CONTINUE
C     DO 2865 ICOL=6,2,-1
      DO2865ICOL=7,1,-1
      DO2866JCOL=1,7
        JXCOL=JCOL
        CALL PSCR(WKID,JXCOL,3,0.0,0.0,0.0)
2866    CONTINUE
        IXCOL=ICOL
        CALL PSCR(WKID,IXCOL,3,1.0,1.0,1.0)
C       DO 2867 IKKL=1,30000
      DO2867IKKL=1,1250000
        IKKK=IKKK+1
2867    CONTINUE
2865  CONTINUE
2861  CONTINUE
C  restitution exacte de la table de couleur
      CALL PSCR(WKID,0,3,0.0,0.0,0.0)
      CALL PSCR(WKID,4,3,0.0,0.0,1.0)
      CALL PSCR(WKID,2,3,1.0,0.0,0.0)
      CALL PSCR(WKID,6,3,1.0,0.0,1.0)
      CALL PSCR(WKID,3,3,0.0,1.0,0.0)
      CALL PSCR(WKID,5,3,0.0,1.0,1.0)
      CALL PSCR(WKID,7,3,1.0,1.0,0.0)
      CALL PSCR(WKID,1,3,1.0,1.0,1.0)
      ICCOUN=ICCOUN+1
      IF (ICCOUN.LE.9) WRITE(NAME,FMT='(''GIBI'',I1)') ICCOUN
      IF (ICCOUN.GE.10) WRITE(NAME,FMT='(''GIBI'',I2)') ICCOUN
      IF (ICCOUN.GE.100) WRITE(NAME,FMT='(''GIBI'',I3)') ICCOUN
      RETURN
C***********************************************************************
 
C
C     subroutine IMPR
C
      ENTRY PFLGI
      ENTRY PIMPR
C
C  PIMPR 24
C  debut du bloc phigs de IMPR
C
3260  CONTINUE
      KMETA=KMETA+1
      IF (KMETA.GT.99) THEN
        CALL PATR(25.,6.,0.,0.,'COMPTEUR DE MATAFILE SUPERIEUR A 99')
        CALL PATR(25.,4.,0.,0.,'SAUVEGARDE IMPOSSIBLE')
        RETURN
      ENDIF
      I10=KMETA/10
      IREST=KMETA-10*I10
      I10=10+1
      IREST=IREST+1
      STR=STR1//CARELE(I10)//CARELE(IREST)
      KCON=1
      METAID=1
C       ouverture du fichier d'archive
      CALL POPARF(METAID,STR)
C      CALL PSWKW(METAID,0.,1.,0.,1.)
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PCLST
C       creation de la liste des structures a archiver
      LIST(1)=0
      ISEG=6+(100*(WKID-1))
      LIST(2)=ISEG
      ISEG=1+(100*(WKID-1))
      LIST(3)=ISEG
      IF (VALEUR) THEN
        ISEG=7+(100*(WKID-1))
        LIST(4)=ISEG
        I=4
      ELSE
        ISEG=3+(100*(WKID-1))
        IF (IQUALI.EQ.1) LIST(4)=ISEG
        ISEG=4+(100*(WKID-1))
        IF (INUMNO.EQ.1) LIST(5)=ISEG
        ISEG=5+(100*(WKID-1))
        IF (INUMEL.EQ.1) LIST(6)=ISEG
        I=6
      ENDIF
C       archivage des structures contenues dans LIST
      CALL PARST(METAID,I,LIST)
C       fermeture du fichier d'archive
*     CALL PCLRAF(METAID)
      RETURN
C***********************************************************************
 
C
C     subroutine VAL
C
      ENTRY PVAL(IRESU,ISORT,NISO)
C
C  PVAL 25
C  debut du bloc phigs de VAL
C
3560  CONTINUE
      IF (IPPP.EQ.1) THEN
      CALL PQOPST(IERR,ISTYPE,ID)
C      CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
      ENDIF
      IF (NISO.NE.0.AND.IDEFOR.EQ.0) THEN
        IXSEG=0
        IRESU=10
        ISORT=1
      ENDIF
      RETURN
C***********************************************************************
 
C
C     subroutine MAJSEG
C
      ENTRY PMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
C
C  debut du bloc phigs de MAJSEG
C
4060  CONTINUE
C       fermeture de la structure courante et update de la Work station
      IF (IMAJ.EQ.1) THEN
      IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0)
     & CALL PCLST
      ELSE
      IF (IQUALI.EQ.10) IQUALI=0
      IF (INUMNO.EQ.10) INUMNO=0
      IF (INUMEL.EQ.10) INUMEL=0
      IF (IRESU.LT.2.OR.IRESU.GT.5) THEN
      ENDIF
C*      IF (WKID.EQ.IWKIDLI) THEN
C*        CALL PCLWK(WKID)
C*      ELSE
C*         WKID=WKID+1
C*      ENDIF
 
      ENDIF
C definition  concernant le texte
       IF (IRESU.EQ.10.AND.IFF.EQ.0) THEN
           IFF=1
       ENDIF
 
C effacement des structures associees a du textes
C       IF (IRESU.NE.10.AND.IFF.EQ.1) THEN
       IF (IRESU.NE.10) THEN
           IFF=0
           IFV=0
C          effacement de toutes les structures associees a du texte
 1619      IF(INUSEG.GT.(50+100*(WKID-1))) THEN
C              INUSEG=INUSEG-1
              CALL PEMST(INUSEG)
              CALL PDST(INUSEG)
              INUSEG=INUSEG-1
              GOTO 1619
           ENDIF
       ENDIF
 
C-------------------------------------
C*     CALL PQOPST(IERR,ISTYPE,ID)
C*     CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
 
      RETURN
C***********************************************************************
C
C     entry TRMESS
C
C  ---------------------------------
C  Affichage d'un message informatif
C  ---------------------------------
      ENTRY PTRMES(TITRE)
      NCART=LONG(TITRE)
      CALL PQOPST(IIERR,PGTYPE,INUM)
      IF (PGTYPE.EQ.POPNST) CALL PCLST
C  effacer le titre puisqu'on ecrit au meme endroit  PV
      ISEG=6+(100*(WKID-1))
      CALL PEMST(ISEG)
      CALL POPST(3)
      CALL PEMST(3)
      CALL PSVWI(1)
         CALL PSTXPR(2)
         CALL PSTXFN(-5)
         CALL PSCHSP(0.1)
         CALL PSATCH(0.015)
         CALL PSTXCI(6)
      CALL PATR(.6,1.3,0.,0.,TITRE(1:NCART))
      CALL PCLST
      IF (PGTYPE.EQ.POPNST) CALL POPST(INUM)
      RETURN
C***********************************************************************
C
C     subroutine TRGET
C
C  -----------------------------------------
C  Sous-programme uniquement appele par MODI
C  -----------------------------------------
      ENTRY PTRGET(LLIG,LCOL,CARACT)
      NCART=LEN(CARACT)
C   PTRGET 18
C  debut du bloc phigs de TRGET
C
 1760 CONTINUE
      CALL PQOPST(IIERRI,PGTYPE,INUM)
      ISGNEW=9+(100*(WKID-1))
      IF(PGTYPE.EQ.POPNST)  CALL PCLST
       CALL POPST(ISGNEW)
      ILLIG=33.-LLIG
C     DO 1761 IND=1,INCOOR
      DO1761IND=1,INCOOR
       IF((TEXTX(IND).EQ.LCOL).AND.(TEXTY(IND).EQ.ILLIG)) THEN
        CARACT(1:15)=TEXTE(IND)(1:15)
       ENDIF
 1761  CONTINUE
      CALL PSVWI(PGSVWI)
      CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
      CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
      RMAT(1)=1.
      RMAT(2)=0.
      RMAT(3)=0.
      RMAT(4)=1.
      RMAT(5)=0.
      RMAT(6)=0.
      CALL PCELST(ISGNEW)
      CALL PEMST(ISGNEW)
      RETURN
C  ------------
C  fin de TRGET
C  ------------
      END
C***********************************************************************
C
C     subroutine PSVIS
C
      SUBROUTINE PSVIS(PGIVNB,PGIVIN,ISUBSEG,FLAG)
C       subroutine permettant de gerer la liste des structures visibles
C  la liste des structures detectables
      IMPLICIT INTEGER(I-N)
      INTEGER PGIVNB,ISUBSEG,FLAG
      INTEGER PGIVIN(4096)
C       si la liste n'est pas vide
      IF (PGIVNB.NE.0) THEN
C       DO 5000 I=1,PGIVNB
      DO5000I=1,PGIVNB
C       si le numero de structure existe dans la liste et qu'il doit etr
C  ajoute on ne fait rien
          IF (PGIVIN(I).EQ.ISUBSEG.AND.FLAG.EQ.1) GOTO 5010
C       si il existe dans la liste et doit etre supprime
          IF (PGIVIN(I).EQ.ISUBSEG) GOTO 5020
 5000   CONTINUE
C       dans le cas ou le numro de structure n'existe pas dans la liste
        IF (FLAG.EQ.1) THEN
          PGIVNB=PGIVNB+1
          PGIVIN(PGIVNB)=ISUBSEG
        ENDIF
        GOTO 5010
 5020   PGIVNB=PGIVNB-1
C       le dernier element de la liste a ete supprime
        IF (I.EQ.PGIVNB+1) GOTO 5010
C       DO 5030 J=I,PGIVNB
C       un element dans la liste a ete supprime ,celle ci est restructur
      DO5030J=I,PGIVNB
          PGIVIN(J)=PGIVIN(J+1)
 5030   CONTINUE
        GOTO 5010
      ELSE IF (FLAG.EQ.1) THEN
C       si la structure doit etre dectectable ou invisible son numero es
C  ajoute a la liste
             PGIVNB=PGIVNB+1
             PGIVIN(PGIVNB)=ISUBSEG
      ENDIF
 5010 CONTINUE
      RETURN
      END