Download vconmo.eso

Back to the list

   1 : C VCONMO    SOURCE    CHAT      11/03/16    21:33:25     6902           
   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 : -INC CCOPTIO
  35 : -INC SMELEME
  36 : -INC SMLENTI
  37 : -INC SMCOORD
  38 :       CHARACTER*(LCONMO) CONSTI
  39 : C
  40 : C     ACTIVATION DU MODELE
  41 : C
  42 :       MMODEL=IPMODL
  43 :       SEGACT,MMODEL
  44 :       NSOUS=KMODEL(/1)
  45 : C
  46 : C     SI NSOUS=1 TOUT EST PARFAIT ET ON SORT
  47 : C
  48 :       IRET=1
  49 :       IF(NSOUS.EQ.1)GOTO 11
  50 : C
  51 : C     SINON ....
  52 : C     ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE
  53 : C
  54 :       DO 1 ISOUS=1,NSOUS
  55 :         IMODEL=KMODEL(ISOUS)
  56 :         SEGACT,IMODEL
  57 :         MELEME=IMAMOD
  58 :         SEGACT,MELEME
  59 :  1    CONTINUE
  60 : C
  61 : C     VOYONS LE CONSTITUANT
  62 : C
  63 :       IMODEL=KMODEL(1)
  64 :       CONSTI=CONMOD
  65 :       DO 2 ISOUS=2,NSOUS
  66 :         IMODEL=KMODEL(ISOUS)
  67 :         IF(CONMOD.NE.CONSTI)THEN
  68 :           IRET=0
  68 :           CALL ERREUR(732)
  69 :           GOTO 9
  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 :           DO 4 KSOUS=1,ISOUS-1
  89 : C
  90 : C            WARNING !!!! ON NE PEUT PAS ECRIRE
  90 : C            CALL MADJAC(LECT(JSOUS),LECT(KSOUS),LOG1)
  91 : C            CAR MADJAC RESTE UNE ROUTINE ESOPE
  92 : C
  93 :             MEL1=LECT(JSOUS)
  94 :             MEL2=LECT(KSOUS)
  94 :             CALL MADJAC(MEL1,MEL2,LOG1)
  95 :             IF (LOG1) GOTO 6
  96 :  4        CONTINUE
  97 :  5      CONTINUE
  98 :         IRET=0
  98 :         CALL ERREUR(733)
  99 :         GOTO 8
 100 :  6      IDUM=LECT(ISOUS)
 101 :         LECT(ISOUS)=LECT(JSOUS)
 102 :         LECT(JSOUS)=IDUM
 103 :  7    CONTINUE
 104 : C
 105 : C     ON FERME
 106 : C
 107 :  8    SEGSUP,MLENTI
 108 :  9    DO 10 ISOUS=1,NSOUS
 109 :         IMODEL=KMODEL(ISOUS)
 110 :         MELEME=IMAMOD
 111 :         SEGDES,MELEME,IMODEL
 112 :  10   CONTINUE
 113 :  11   SEGDES MMODEL
 114 : C
 115 :       RETURN
 116 :       END
 117 :  
 118 :  
 119 :  
 120 :  
 121 :  
 122 :  
 123 :  
 124 :  
 125 :  
 126 :  
 127 :  

© Cast3M 2003 - All rights reserved.
Disclaimer