Sources Esope | Cast3M

moct
C MOCT      SOURCE    PV        05/09/22    21:20:12     5181
C  MODI TRACE DU CONTOUR
C
      SUBROUTINE MOCT(XPROJ,ICPR,IVU,IPT1)
      IMPLICIT INTEGER(I-N)
      SEGMENT ICPR(0)
      SEGMENT IVU(0)
      SEGMENT XPROJ(3,0)
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
      DIMENSION XTR(40),YTR(40),ztr(40)
      do i=1,40
         ztr(i)=0
      enddo
      CALL ECROBJ('MAILLAGE',IPT1)
      CALL PRCONT
      CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
      IF (IERR.NE.0) RETURN
*  REACTIVONS LE  MAILLAGE A TOUT HASARD
      SEGACT IPT1
      DO 100 I=1,IPT1.LISOUS(/1)
       IPT2=IPT1.LISOUS(I)
       SEGACT IPT2
 100  CONTINUE
      SEGACT MELEME
      NBELEM=NUM(/2)
      NBNN=NUM(/1)
      CALL CHCOUL(1)
      ICOUR=0
      ITR=1
      DO 10 J=1,NBELEM
      DO 20 I=1,NBNN-1
      IP=ICPR(NUM(I,J))
      IP1=ICPR(NUM(I+1,J))
      IF (IVU(IP).NE.1) GOTO 20
      IF (IVU(IP1).NE.1) GOTO 20
      IF (ICOUR.NE.IP) THEN
        IF (ITR.GE.2) CALL POLRL(ITR,XTR,YTR,ZTR)
        ITR=1
        XTR(1)=XPROJ(1,IP)
        YTR(1)=XPROJ(2,IP)
      ENDIF
      ITR=ITR+1
      XTR(ITR)=XPROJ(1,IP1)
      YTR(ITR)=XPROJ(2,IP1)
      IF (ITR.EQ.40) THEN
         CALL POLRL(ITR,XTR,YTR,ZTR)
         XTR(1)=XTR(ITR)
         YTR(1)=YTR(ITR)
         ITR=1
      ENDIF
      ICOUR=IP1
  20  CONTINUE
  10  CONTINUE
       IF (ITR.GT.1)   CALL POLRL(ITR,XTR,YTR,ZTR)
      SEGDES MELEME
      END