1 : C PRORIE SOURCE PV 07/11/23 21:18:48 5978 2 : C INTERFACE AVEC ORIENT LIT LES DONNEES ET RECUPERE LE RESULTAT 3 : C ATTENTION POUR QUE PRESSION MARCHE IL EST IMPERATIF QUE 4 : C LISOUS GARDE LE MEME ORDRE SE SOUS ZONES APRES REORIENTATION 5 : C 6 : 7 : SUBROUTINE PRORIE 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT real*8 (a-h,o-z) 10 : -INC CCOPTIO 11 : -INC SMELEME 12 : -INC SMCOORD 13 : CHARACTER*4 MCLE(2) 14 : DIMENSION XP(3) 15 : DATA MCLE/'DIRE','POIN'/ 16 : XP(1)=0. 17 : XP(2)=0. 18 : XP(3)=1. 19 : ICLE=1 20 : IF (IDIM.EQ.2) GOTO 10 20 : CALL LIRMOT(MCLE,2,ICLE,0) 21 : IF (ICLE.EQ.0) ICLE=1 21 : CALL LIROBJ('POINT ',IP,1,IRETOU) 22 : IF (IERR.NE.0) RETURN 23 : SEGACT MCOORD 24 : IREF=(IP-1)*(IDIM+1) 25 : XP(1)=XCOOR(IREF+1) 26 : XP(2)=XCOOR(IREF+2) 27 : XP(3)=XCOOR(IREF+3) 28 : 10 CONTINUE 28 : CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU) 29 : IF (IERR.NE.0) RETURN 30 : SEGACT MELEME 31 : IPT1=MELEME 32 : IF (LISOUS(/1).NE.0) THEN 33 : NBREF=0 34 : NBSOUS=LISOUS(/1) 35 : NBNN=0 36 : NBELEM=0 37 : SEGINI IPT5 38 : ENDIF 39 : DO 2 IO=1,MAX(1,LISOUS(/1)) 40 : IF (LISOUS(/1).NE.0) THEN 41 : IPT1=LISOUS(IO) 42 : SEGACT IPT1 43 : ENDIF 43 : CALL ORIENT(IPT1,IPT2,XP,ICLE) 44 : IF (LISOUS(/1).NE.0) THEN 45 : SEGDES IPT1,IPT2 46 : IPT5.LISOUS(IO)=IPT2 47 : ENDIF 48 : 2 CONTINUE 49 : IF (LISOUS(/1).EQ.0) GOTO 3 50 : SEGDES MELEME 51 : IPT2=IPT5 52 : 3 CONTINUE 52 : CALL ECROBJ('MAILLAGE',IPT2) 53 : C VERIFICATION QUE PAS DEUX ELEMENTS TOURNENT SENS INVERSE 53 : CALL VERSEN 54 : RETURN 55 : END 56 : 57 :
© Cast3M 2003 - All rights reserved.
Disclaimer