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