Sources Esope | Cast3M

prorie
C PRORIE    SOURCE    GOUNAND   16/05/25    21:15:07     8924           
C     
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
C 
C SG : 2016/05/17 ajout orientation elements massifs
C     
 
      SUBROUTINE PRORIE
      IMPLICIT INTEGER(I-N)
      IMPLICIT real*8 (a-h,o-z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      CHARACTER*4 MCLE(2)
      DIMENSION XP(3)
      DATA MCLE/'DIRE','POIN'/
      XP(1)=0.D0
      XP(2)=0.D0
      XP(3)=1.D0
      ICLE=0
      IF (IDIM.EQ.3) THEN
         CALL LIRMOT(MCLE,2,ICLE,0)
         CALL LIROBJ('POINT ',IP,0,IRETOU)
         IF (IERR.NE.0) RETURN
         IF (IRETOU.EQ.1) THEN
* Option par défaut si on donne un point : DIRE
            IF (ICLE.EQ.0) ICLE=1
            SEGACT MCOORD
            IREF=(IP-1)*(IDIM+1)
            XP(1)=XCOOR(IREF+1)
            XP(2)=XCOOR(IREF+2)
            XP(3)=XCOOR(IREF+3)
         ENDIF
      ENDIF
      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 (IERR.NE.0) RETURN
         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