C PRORIE    SOURCE    PV        07/11/23    21:18:48     5978           
C   INTERFACE AVEC  ORIENT   LIT LES DONNEES  ET RECUPERE LE RESULTAT           
C   ATTENTION POUR QUE PRESSION MARCHE IL EST IMPERATIF QUE                     
C   LISOUS GARDE LE MEME ORDRE SE SOUS ZONES APRES REORIENTATION                
C                                                                               
                                                                                
      SUBROUTINE PRORIE                                                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT real*8 (a-h,o-z)
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
      CHARACTER*4 MCLE(2)                                                       
      DIMENSION XP(3)                                                           
      DATA MCLE/'DIRE','POIN'/                                                  
      XP(1)=0.                                                                  
      XP(2)=0.                                                                  
      XP(3)=1.                                                                  
      ICLE=1                                                                    
      IF (IDIM.EQ.2) GOTO 10                                                    
      CALL LIRMOT(MCLE,2,ICLE,0)                                                
      IF (ICLE.EQ.0) ICLE=1                                                     
      CALL LIROBJ('POINT ',IP,1,IRETOU)                                         
      IF (IERR.NE.0) RETURN                                                     
      SEGACT MCOORD                                                             
      IREF=(IP-1)*(IDIM+1)                                                      
      XP(1)=XCOOR(IREF+1)                                                       
      XP(2)=XCOOR(IREF+2)                                                       
      XP(3)=XCOOR(IREF+3)                                                       
  10  CONTINUE                                                                  
      CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)                                   
      IF (IERR.NE.0) RETURN                                                     
      SEGACT MELEME                                                             
      IPT1=MELEME                                                               
      IF (LISOUS(/1).NE.0) THEN                                                 
       NBREF=0                                                                  
       NBSOUS=LISOUS(/1)                                                        
       NBNN=0                                                                   
       NBELEM=0                                                                 
       SEGINI IPT5                                                              
      ENDIF                                                                     
      DO 2 IO=1,MAX(1,LISOUS(/1))                                               
      IF (LISOUS(/1).NE.0) THEN                                                 
       IPT1=LISOUS(IO)                                                          
       SEGACT IPT1                                                              
      ENDIF                                                                     
      CALL ORIENT(IPT1,IPT2,XP,ICLE)                                            
      IF (LISOUS(/1).NE.0) THEN                                                 
       SEGDES IPT1,IPT2                                                         
       IPT5.LISOUS(IO)=IPT2                                                     
      ENDIF                                                                     
   2  CONTINUE                                                                  
      IF (LISOUS(/1).EQ.0) GOTO 3                                               
      SEGDES MELEME                                                             
      IPT2=IPT5                                                                 
   3  CONTINUE                                                                  
      CALL ECROBJ('MAILLAGE',IPT2)                                              
C   VERIFICATION QUE PAS DEUX ELEMENTS TOURNENT SENS INVERSE                    
      CALL VERSEN                                                               
      RETURN                                                                    
      END