Télécharger prorie.eso

Retour à la liste

Numérotation des lignes :

  1. C PRORIE SOURCE GOUNAND 16/05/25 21:15:07 8924
  2. C
  3. C INTERFACE AVEC ORIENT LIT LES DONNEES ET RECUPERE LE RESULTAT
  4. C ATTENTION POUR QUE PRESSION MARCHE IL EST IMPERATIF QUE
  5. C LISOUS GARDE LE MEME ORDRE SE SOUS ZONES APRES REORIENTATION
  6. C
  7. C
  8. C SG : 2016/05/17 ajout orientation elements massifs
  9. C
  10.  
  11. SUBROUTINE PRORIE
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT real*8 (a-h,o-z)
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCOORD
  17. CHARACTER*4 MCLE(2)
  18. DIMENSION XP(3)
  19. DATA MCLE/'DIRE','POIN'/
  20. XP(1)=0.D0
  21. XP(2)=0.D0
  22. XP(3)=1.D0
  23. ICLE=0
  24. IF (IDIM.EQ.3) THEN
  25. CALL LIRMOT(MCLE,2,ICLE,0)
  26. CALL LIROBJ('POINT ',IP,0,IRETOU)
  27. IF (IERR.NE.0) RETURN
  28. IF (IRETOU.EQ.1) THEN
  29. * Option par défaut si on donne un point : DIRE
  30. IF (ICLE.EQ.0) ICLE=1
  31. SEGACT MCOORD
  32. IREF=(IP-1)*(IDIM+1)
  33. XP(1)=XCOOR(IREF+1)
  34. XP(2)=XCOOR(IREF+2)
  35. XP(3)=XCOOR(IREF+3)
  36. ENDIF
  37. ENDIF
  38. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  39. IF (IERR.NE.0) RETURN
  40. SEGACT MELEME
  41. IPT1=MELEME
  42. IF (LISOUS(/1).NE.0) THEN
  43. NBREF=0
  44. NBSOUS=LISOUS(/1)
  45. NBNN=0
  46. NBELEM=0
  47. SEGINI IPT5
  48. ENDIF
  49. DO 2 IO=1,MAX(1,LISOUS(/1))
  50. IF (LISOUS(/1).NE.0) THEN
  51. IPT1=LISOUS(IO)
  52. SEGACT IPT1
  53. ENDIF
  54. CALL ORIENT(IPT1,IPT2,XP,ICLE)
  55. IF (IERR.NE.0) RETURN
  56. IF (LISOUS(/1).NE.0) THEN
  57. SEGDES IPT1,IPT2
  58. IPT5.LISOUS(IO)=IPT2
  59. ENDIF
  60. 2 CONTINUE
  61. IF (LISOUS(/1).EQ.0) GOTO 3
  62. SEGDES MELEME
  63. IPT2=IPT5
  64. 3 CONTINUE
  65. CALL ECROBJ('MAILLAGE',IPT2)
  66. C VERIFICATION QUE PAS DEUX ELEMENTS TOURNENT SENS INVERSE
  67. CALL VERSEN
  68. RETURN
  69. END
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  

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