Télécharger prcont.eso

Retour à la liste

Numérotation des lignes :

prcont
  1. C PRCONT SOURCE GOUNAND 21/04/07 21:15:06 10943
  2. ************************************************************************
  3. * NOM : PRCONT
  4. * DESCRIPTION : Construit le contour d'un objet maillage
  5. * (fonctionne suivant un principe inspire de TRAC)
  6. ************************************************************************
  7. * APPELE PAR : pilot.eso
  8. ************************************************************************
  9. * ENTREES :: aucune
  10. * SORTIES :: aucune
  11. ************************************************************************
  12. * SYNTAXE (GIBIANE) :
  13. *
  14. * GEO1 = CONTOUR ('NOID') (|'EXTE'|) GEO2 ;
  15. * |'INTE'|
  16. * |'TOUT'|
  17. *
  18. ************************************************************************
  19. SUBROUTINE PRCONT
  20.  
  21. IMPLICIT INTEGER(I-N)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCGEOME
  26. -INC SMELEME
  27. -INC SMCOORD
  28. -INC CCASSIS
  29.  
  30. SEGMENT ICPR(nbpts)
  31. SEGMENT IDCP(ITE)
  32. SEGMENT KON(NBCON,NMAX,3)
  33.  
  34. CHARACTER*8 CHAIN1
  35.  
  36. PARAMETER(NMOT1=3,NMOT2=1)
  37. CHARACTER*4 LMOT1(NMOT1),LMOT2(NMOT2)
  38. DATA LMOT1/'EXTE','INTE','TOUT'/
  39. DATA LMOT2/'NOID'/
  40.  
  41.  
  42. * +---------------------------------------------------------------+
  43. * | L E C T U R E D E S A R G U M E N T S |
  44. * +---------------------------------------------------------------+
  45.  
  46. * LECTURE DES MOTS-CLES FACULTATIFS
  47. CALL LIRMOT(LMOT1,NMOT1,IMOT1,0)
  48. IF (IMOT1.EQ.0) IMOT1=1
  49. CALL LIRMOT(LMOT2,NMOT2,IMOT2,0)
  50.  
  51. * LECTURE DU MAILLAGE
  52. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  53. CALL ACTOBJ('MAILLAGE',MELEME,1)
  54. IF (IERR.NE.0) RETURN
  55. IPT8=MELEME
  56.  
  57. * ON VA VERIFIER QUE LE CONTOUR DEMANDE N'A PAS DEJA ETE CONSTRUIT
  58. IF (LISREF(/1).EQ.1.AND.IMOT1.EQ.1) THEN
  59. IPT1=LISREF(1)
  60. CALL ECROBJ('MAILLAGE',IPT1)
  61. RETURN
  62. ENDIF
  63.  
  64. * +---------------------------------------------------------------+
  65. * | C O N N E C T I V I T E D U M A I L L A G E |
  66. * +---------------------------------------------------------------+
  67. *
  68. * REMPLISSAGE DES TABLEAUX DE CORRESPONDANCE LOCALE/GLOBALE AVEC
  69. * SEULEMENT LES NOEUDS SOMMETS (i.e. PAS DE NOEUDS MILIEUX)
  70. * **************************************************************
  71.  
  72. igr=nbpts+1
  73. SEGINI,ICPR
  74. ITE=0
  75. IPT1=MELEME
  76. DO 3 I=1,MAX(1,LISOUS(/1))
  77. IF (LISOUS(/1).NE.0) THEN
  78. IPT1=LISOUS(I)
  79. ENDIF
  80. K=IPT1.ITYPEL
  81.  
  82. * Le test ci-dessous filtre les elements non surfaciques
  83. IF (K.NE.KSURF(K)) GOTO 8
  84.  
  85. * Parcours des noeuds situes aux sommets de tous les elements
  86. IDEP=NSPOS(K)
  87. IF (NBSOM(K).GT.0) THEN
  88. IFEP=IDEP+NBSOM(K)-1
  89. ELSE
  90. * Cas particulier de l'element POLYgone
  91. IFEP=IDEP+IPT1.NUM(/1)-1
  92. ENDIF
  93. IF (IFEP.LT.IDEP) GOTO 8
  94. DO 4 JJ=IDEP,IFEP
  95. J=IBSOM(JJ)
  96. DO 401 K=1,IPT1.NUM(/2)
  97. IPOIT=IPT1.NUM(J,K)
  98. IF (ICPR(IPOIT).NE.0) GOTO 7
  99. ITE=ITE+1
  100. ICPR(IPOIT)=ITE
  101. 7 CONTINUE
  102. 401 CONTINUE
  103. 4 CONTINUE
  104. 8 CONTINUE
  105. 3 CONTINUE
  106. *
  107. IF (ITE.EQ.0) THEN
  108. SEGSUP,ICPR
  109. CALL ERREUR(16)
  110. RETURN
  111. ENDIF
  112. *
  113. SEGINI,IDCP
  114. DO 40 I=1,ICPR(/1)
  115. IF (ICPR(I).EQ.0) GOTO 40
  116. IDCP(ICPR(I))=I
  117. 40 CONTINUE
  118.  
  119. CALL CONTOU(MELEME,0,0,ICPR,IDCP,ITE,IMOT1,IMOT2,MELCON)
  120.  
  121. SEGSUP,IDCP
  122. SEGSUP,ICPR
  123. IF (IERR.NE.0) RETURN
  124.  
  125. MELEME=MELCON
  126. CALL ACTOBJ('MAILLAGE',MELEME,1)
  127. CALL ECROBJ('MAILLAGE',MELEME)
  128.  
  129. * ON INSCRIT SEULEMENT LE CONTOUR EXTERIEUR DANS LES
  130. * REFERENCES DU MAILLAGE INITIAL
  131. IF (IPT8.LISREF(/1).EQ.0.AND.IMOT1.EQ.1) THEN
  132. NBREF=1
  133. NBNN=IPT8.NUM(/1)
  134. NBELEM=IPT8.NUM(/2)
  135. NBSOUS=IPT8.LISOUS(/1)
  136. SEGADJ,IPT8
  137. IPT8.LISREF(1)=MELEME
  138. ENDIF
  139. SEGACT,IPT8*NOMOD
  140. RETURN
  141. END
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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