Télécharger moct.eso

Retour à la liste

Numérotation des lignes :

  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
  15. CALL ECROBJ('MAILLAGE',IPT1)
  16. CALL PRCONT
  17. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  18. IF (IERR.NE.0) RETURN
  19. * REACTIVONS LE MAILLAGE A TOUT HASARD
  20. SEGACT IPT1
  21. DO 100 I=1,IPT1.LISOUS(/1)
  22. IPT2=IPT1.LISOUS(I)
  23. SEGACT IPT2
  24. 100 CONTINUE
  25. SEGACT MELEME
  26. NBELEM=NUM(/2)
  27. NBNN=NUM(/1)
  28. CALL CHCOUL(1)
  29. ICOUR=0
  30. ITR=1
  31. DO 10 J=1,NBELEM
  32. DO 20 I=1,NBNN-1
  33. IP=ICPR(NUM(I,J))
  34. IP1=ICPR(NUM(I+1,J))
  35. IF (IVU(IP).NE.1) GOTO 20
  36. IF (IVU(IP1).NE.1) GOTO 20
  37. IF (ICOUR.NE.IP) THEN
  38. IF (ITR.GE.2) CALL POLRL(ITR,XTR,YTR,ZTR)
  39. ITR=1
  40. XTR(1)=XPROJ(1,IP)
  41. YTR(1)=XPROJ(2,IP)
  42. ENDIF
  43. ITR=ITR+1
  44. XTR(ITR)=XPROJ(1,IP1)
  45. YTR(ITR)=XPROJ(2,IP1)
  46. IF (ITR.EQ.40) THEN
  47. CALL POLRL(ITR,XTR,YTR,ZTR)
  48. XTR(1)=XTR(ITR)
  49. YTR(1)=YTR(ITR)
  50. ITR=1
  51. ENDIF
  52. ICOUR=IP1
  53. 20 CONTINUE
  54. 10 CONTINUE
  55. IF (ITR.GT.1) CALL POLRL(ITR,XTR,YTR,ZTR)
  56. SEGDES MELEME
  57. END
  58.  
  59.  
  60.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales