Télécharger vconmo.eso

Retour à la liste

Numérotation des lignes :

  1. C VCONMO SOURCE CB215821 19/07/30 21:18:38 10273
  2. SUBROUTINE VCONMO(IPMODL,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C V(ERIFICATION DU MODELE POUR LES) CON(NECTIVITES DU) MO(DEL)
  6. C
  7. C -- LE MODELE A UN SEUL CONSTITUENT
  8. C -- LE MODELE EST GEOMETRIQUEMENT SIMPLE
  9. C
  10. C Entrees:
  11. C ________
  12. C
  13. C IPMODL Pointeur sur un objet MMODEL
  14. C
  15. C Sorties:
  16. C ________
  17. C
  18. C IRET 1 ou 0 suivant OK ou non
  19. C
  20. C Appele par CONNEC
  21. C ----------
  22. C
  23. C Appel a MADJAC test l'adjacence de 2 maillage (CLB)
  24. C --------
  25. C
  26. C P.PEGON 26/10/92
  27. C_______________________________________________________________________
  28. C
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. LOGICAL LOG1
  32. C
  33. -INC SMMODEL
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMELEME
  38. -INC SMLENTI
  39. -INC SMCOORD
  40. CHARACTER*(LCONMO) CONSTI
  41. C
  42. C ACTIVATION DU MODELE
  43. C
  44. MMODEL=IPMODL
  45. NSOUS=KMODEL(/1)
  46. C
  47. C SI NSOUS=1 TOUT EST PARFAIT ET ON SORT
  48. C
  49. IRET=1
  50. IF(NSOUS.EQ.1)RETURN
  51. C
  52. C SINON ....
  53. C ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE
  54. C
  55. DO 1 ISOUS=1,NSOUS
  56. IMODEL=KMODEL(ISOUS)
  57. MELEME=IMAMOD
  58. 1 CONTINUE
  59. C
  60. C VOYONS LE CONSTITUANT
  61. C
  62. IMODEL=KMODEL(1)
  63. CONSTI=CONMOD
  64. DO 2 ISOUS=2,NSOUS
  65. IMODEL=KMODEL(ISOUS)
  66. IF(CONMOD.NE.CONSTI)THEN
  67. IRET=0
  68. CALL ERREUR(732)
  69. RETURN
  70. ENDIF
  71. 2 CONTINUE
  72. C
  73. C VOYONS L'ADJACENCE
  74. C
  75. JG=NSOUS
  76. SEGINI,MLENTI
  77. DO 3 ISOUS=1,NSOUS
  78. IMODEL=KMODEL(ISOUS)
  79. LECT(ISOUS)=IMAMOD
  80. 3 CONTINUE
  81. C
  82. C ON SELECTIONE LA PREMIERE ZONE ET L'ON BOUCLE
  83. C EN VERIFIANT QUE UNE DES ZONES NON ENCORE SELECTIONNEES
  84. C EST ADJACENTE A L'UNE DES ZONES DEJA SELECTIONNEES
  85. C
  86. DO 7 ISOUS=2,NSOUS
  87. DO 5 JSOUS=ISOUS,NSOUS
  88. MEL1=LECT(JSOUS)
  89. DO 4 KSOUS=1,ISOUS-1
  90. C
  91. C WARNING !!!! ON NE PEUT PAS ECRIRE
  92. C CALL MADJAC(LECT(JSOUS),LECT(KSOUS),LOG1)
  93. C CAR MADJAC RESTE UNE ROUTINE ESOPE
  94. C
  95. MEL2=LECT(KSOUS)
  96. CALL MADJAC(MEL1,MEL2,LOG1)
  97. IF (LOG1) GOTO 6
  98. 4 CONTINUE
  99. 5 CONTINUE
  100. IRET=0
  101. CALL ERREUR(733)
  102. GOTO 8
  103. 6 IDUM=LECT(ISOUS)
  104. LECT(ISOUS)=LECT(JSOUS)
  105. LECT(JSOUS)=IDUM
  106. 7 CONTINUE
  107. C
  108. C ON FERME
  109. C
  110. 8 SEGSUP,MLENTI
  111.  
  112. END
  113.  
  114.  
  115.  

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