1 : C MOCT SOURCE PV 05/09/22 21:20:12 5181 2 : C MODI TRACE DU CONTOUR 3 : C 4 : SUBROUTINE MOCT(XPROJ,ICPR,IVU,IPT1) 5 : IMPLICIT INTEGER(I-N) 6 : SEGMENT ICPR(0) 7 : SEGMENT IVU(0) 8 : SEGMENT XPROJ(3,0) 9 : -INC SMELEME 10 : -INC CCOPTIO 11 : DIMENSION XTR(40),YTR(40),ztr(40) 12 : do i=1,40 13 : ztr(i)=0 14 : enddo 14 : CALL ECROBJ('MAILLAGE',IPT1) 14 : CALL PRCONT 14 : CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU) 15 : IF (IERR.NE.0) RETURN 16 : * REACTIVONS LE MAILLAGE A TOUT HASARD 17 : SEGACT IPT1 18 : DO 100 I=1,IPT1.LISOUS(/1) 19 : IPT2=IPT1.LISOUS(I) 20 : SEGACT IPT2 21 : 100 CONTINUE 22 : SEGACT MELEME 23 : NBELEM=NUM(/2) 24 : NBNN=NUM(/1) 24 : CALL CHCOUL(1) 25 : ICOUR=0 26 : ITR=1 27 : DO 10 J=1,NBELEM 28 : DO 20 I=1,NBNN-1 29 : IP=ICPR(NUM(I,J)) 30 : IP1=ICPR(NUM(I+1,J)) 31 : IF (IVU(IP).NE.1) GOTO 20 32 : IF (IVU(IP1).NE.1) GOTO 20 33 : IF (ICOUR.NE.IP) THEN 33 : IF (ITR.GE.2) CALL POLRL(ITR,XTR,YTR,ZTR) 34 : ITR=1 35 : XTR(1)=XPROJ(1,IP) 36 : YTR(1)=XPROJ(2,IP) 37 : ENDIF 38 : ITR=ITR+1 39 : XTR(ITR)=XPROJ(1,IP1) 40 : YTR(ITR)=XPROJ(2,IP1) 41 : IF (ITR.EQ.40) THEN 41 : CALL POLRL(ITR,XTR,YTR,ZTR) 42 : XTR(1)=XTR(ITR) 43 : YTR(1)=YTR(ITR) 44 : ITR=1 45 : ENDIF 46 : ICOUR=IP1 47 : 20 CONTINUE 48 : 10 CONTINUE 48 : IF (ITR.GT.1) CALL POLRL(ITR,XTR,YTR,ZTR) 49 : SEGDES MELEME 50 : END 51 : 52 :
© Cast3M 2003 - All rights reserved.
Disclaimer