Télécharger la plaquette Cast3M


fr en

Télécharger vconmo.eso

Retour à la liste

Numérotation des lignes : 

vconmo

  1. C VCONMO    SOURCE    CB215821  24/04/12    21:17:25     11897          
  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.  
  116.  

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