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