1 : C MUTU1 SOURCE CHAT 11/03/16 21:28:32 6902 2 : SUBROUTINE MUTU1(IPMODE,IPCHEL,IPMAIL,IPRIGI) 3 : ************************************************************************ 4 : * 5 : * M U T U 1 6 : * --------- 7 : * 8 : * 9 : * FONCTION: 10 : * --------- 11 : * CREATION DE LA MATRICE DE MUTUELLES 12 : * GESTION DES SEGMENTS ET TESTS DE COMPATIBILITE 13 : * 14 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+)=CONTENU DANS UN COMMUN 15 : * ----------- 16 : * 17 : * IPMODE (E) POINTEUR SUR LE SEGMENT MMODEL 18 : * IPCHEL (E) POINTEUR SUR LE SEGMENT MCHELM 19 : * IPMAIL (E) POINTEUR SUR LE SEGMENT MELEME S'il existe 20 : * IPRIGI (S) POINTEUR SUR LE SEGMENT MRIGID 21 : * +IFOMOD (E) VOIR CCOPTIO 22 : * 23 : * MODULES UTILISES: 24 : * ----------------- 25 : * 26 : IMPLICIT INTEGER(I-N) 27 : -INC CCOPTIO 28 : -INC CCHAMP 29 : -INC SMRIGID 30 : -INC SMCHAML 31 : -INC SMELEME 32 : -INC SMMODEL 33 : -INC SMCOORD 34 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 35 : SEGMENT ICPR2(XCOOR(/1)/(IDIM+1)) 36 : * 37 : * 38 : * VARIABLES: 39 : * ---------- 40 : * 41 : * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE 42 : * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP 43 : * NBMAIL NOMBRE DE MAILLAGES ELEMENTAIRES 44 : * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE 45 : * 46 : LOGICAL OK 47 : CHARACTER*4 MOTHER,MOCHAL 48 : PARAMETER ( MOTHER='FC ' ) 49 : PARAMETER ( MOCHAL='ED ' ) 50 : * 51 : * AUTEUR, DATE DE CREATION: 52 : * ------------------------- 53 : * 54 : * YANN STEPHAN, LE 28 FEVRIER 1997 (COPIE DE RESI1). 55 : * 56 : * LANGAGE: 57 : * -------- 58 : * 59 : * ESOPE + FORTRAN77 60 : * 61 : ************************************************************************ 62 : * 63 : * 64 : * VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES 65 : * 65 : CALL QUESUP(IPMODE,IPCHEL,2,0,ISUP,IRETCA) 66 : IF(ISUP.GT.1)RETURN 67 : * 68 : * SI LE CHAMELEM EST APPUYE AUX NOEUDS ,ON CHANGE LE SUPPORT 69 : * POUR LES CENTRES DE GRAVITE 70 : * 71 : IF(ISUP.EQ.1)THEN 71 : CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,2) 72 : IF(IRET.NE.0)THEN 72 : CALL ERREUR(IRET) 73 : RETURN 74 : ENDIF 75 : ELSE 76 : IPCHE1=IPCHEL 77 : ENDIF 78 : * 79 : * ACTIVATION DES SEGMENTS MCHELM ET MMODEL 80 : * 81 : MCHELM=IPCHE1 82 : SEGACT,MCHELM 83 : NBMAIC=IMACHE(/1) 84 : SEGDES MCHELM 85 : * 86 : MMODEL=IPMODE 87 : SEGACT,MMODEL 88 : NBMAIM=KMODEL(/1) 89 : IF (NBMAIM.GT.NBMAIC) THEN 90 : * 91 : * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES 92 : * DU MODELE 93 : * 93 : CALL ERREUR(404) 94 : SEGDES,MMODEL*NOMOD 95 : IF(ISUP.EQ.1)SEGSUP MCHELM 96 : RETURN 97 : ENDIF 98 : * 99 : NBMAIL=NBMAIM 100 : * 101 : * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 102 : * 103 : NRIGE=8 104 : NRIGEL=1 105 : SEGINI,MRIGID 106 : IPRIGI=MRIGID 107 : ICHOLE=0 108 : IMGEO1=0 109 : IMGEO2=0 110 : IFORIG=IFOMOD 111 : ISUPEQ=0 112 : MTYMAT='RIGIDITE' 113 : NBGEOR=0 114 : NELRIG=1 115 : * SEGINI,xMATRI 116 : IRIGEL(2,1)=0 117 : IRIGEL(4,1)=0 118 : IRIGEL(5,1)=0 119 : IRIGEL(6,1)=0 120 : IRIGEL(7,1)=2 121 : COERIG(1)=1.D0 122 : 123 : IFOI=0 124 : * 125 : * creation d'une numerotation locale dans le but de creer un 126 : * element unique support de toute la matrice de mutuelle on prend 127 : * d'abord le maillage issu du modele puis on fait la meme chosepour 128 : * celui issu de IPMAIL 129 : * 130 : SEGINI ICPR,ICPR2 131 : IB=0 132 : DO 41 IMAIL=1,NBMAIL 133 : IMODEL=KMODEL(IMAIL) 134 : SEGACT,IMODEL 135 : MELEME=IMAMOD 136 : SEGACT,MELEME 137 : DO 42 I=1,NUM(/2) 138 : DO 42 J=1,NUM(/1) 139 : IA = NUM(J,I) 140 : IF(ICPR(IA).EQ.0) THEN 141 : IB=IB+1 142 : ICPR(IA)=IB 143 : ENDIF 144 : 42 CONTINUE 145 : 41 CONTINUE 146 : IF( IPMAIL.EQ.0) THEN 147 : * 148 : * on travail sur lui meme 149 : * 150 : * on le cree de tel facon qu'il soit identique en structure a 151 : * celui issu du modele 152 : * 153 : DO 65 KI=1,ICPR(/1) 154 : 65 ICPR2(KI)=ICPR(KI) 155 : NBSOUS = NBMAIL 156 : IF( NBSOUS.EQ.1) THEN 157 : IPMAIL=MELEME 158 : ELSE 159 : NBREF=0 160 : NBNN=0 161 : NBELEM=0 162 : SEGINI IPT5 163 : IPMAIL=IPT5 164 : DO 63 KI=1,NBSOUS 165 : IMODEL=KMODEL(KI) 166 : IPT5.LISOUS(KI)=IMAMOD 167 : 63 CONTINUE 168 : ENDIF 169 : ELSE 170 : * 171 : * on a fournit un deuxieme maillage. il faut verifier qu'il y a 172 : * concordance topologique on boucle sur les zones de ce maillage pour 173 : * construire une numerotation et on verifie qu'eele est compatible 174 : * avec l'autre 175 : * 176 : IPT1=IPMAIL 177 : MELEME=IPT1 178 : SEGACT IPT1 179 : IC=0 180 : IH=MAX(1,IPT1.LISOUS(/1)) 181 : IF(IH.NE.KMODEL(/1)) THEN 181 : CALL ERREUR(910) 182 : RETURN 183 : ENDIF 184 : DO 43 K=1,MAX(1,IPT1.LISOUS(/1)) 185 : IF(IPT1.LISOUS(/1).NE.0) THEN 186 : MELEME= IPT1.LISOUS(K) 187 : SEGACT MELEME 188 : ENDIF 189 : IMODEL=KMODEL(K) 190 : IPT5=IMAMOD 191 : IF( IPT5.NUM(/2).NE.NUM(/2) )THEN 191 : CALL ERREUR(910) 192 : RETURN 193 : ENDIF 194 : IF( IPT5.NUM(/1).NE.NUM(/1) )THEN 194 : CALL ERREUR(910) 195 : RETURN 196 : ENDIF 197 : DO 44 I=1,NUM(/2) 198 : DO 44 J=1,NUM(/1) 199 : IA = NUM(J,I) 200 : IF(ICPR2(IA).EQ.0) THEN 201 : IC=IC+1 202 : ICPR2(IA)=IC 203 : ENDIF 204 : IH=IPT5.NUM(J,I) 205 : IM = ICPR(IH) 206 : IF(IM.NE.ICPR2(IA)) THEN 206 : CALL ERREUR(910) 207 : RETURN 208 : ENDIF 209 : 44 CONTINUE 210 : 43 CONTINUE 211 : ENDIF 212 : * initialisations du maillages support de la mutuelle 213 : NBNN=IB 214 : NBELEM=1 215 : NBSOUS=0 216 : NBREF=0 217 : SEGINI MELEME 218 : ITYPEL=28 219 : DO 49 K=1,ICPR(/1) 220 : IF( ICPR(K).NE.0) THEN 221 : IA = ICPR(K) 222 : NUM(IA,1) = K 223 : ENDIF 224 : 49 CONTINUE 225 : IPRESU=MELEME 226 : IRIGEL(1,1)=MELEME 227 : * 228 : * initialisation du segment descripteur 229 : * 230 : NLIGRP=IB 231 : NLIGRD=IB 232 : SEGINI DESCR 233 : SEGINI XMATRI 234 : * IMATTT(1)=XMATRI 235 : * SEGDES IMATRI 236 : IRIGEL(3,1)=DESCR 237 : irigel(4,1)=xmatri 238 : DO 48 K=1,NLIGRP 239 : LISINC(K)=MOTHER 240 : LISDUA(K)=MOCHAL 241 : NOELEP(K)=K 242 : NOELED(K)=K 243 : 48 CONTINUE 244 : SEGDES DESCR 245 : * Il reste a calculer les matrices (3*3 por les rot3) 246 : * et a les assembler (l'assemblage aura lieu dans rot3M 247 : * 248 : * 249 : * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL 250 : * 251 : DO 50 IMAIL=1,NBMAIL 252 : * 253 : IFOI=IFOI+1 254 : IMODEL=KMODEL(IMAIL) 255 : SEGACT,IMODEL 256 : ICOQ = 0 257 : NEF=NEFMOD 258 : MELEME=IMAMOD 259 : IPT4=IMAMOD 260 : SEGACT,MELEME 261 : NBNNC=NUM(/1) 262 : NBELEC=NUM(/2) 263 : NBELEM=0 264 : IPT1=IPMAIL 265 : SEGACT,IPT1 266 : NBSOUJ=IPT1.LISOUS(/1) 267 : IF(NBSOUJ.EQ.0) NBSOUJ=1 268 : NBNNJ=0 269 : DO 70 ISOUJ=1,NBSOUJ 270 : IF(NBSOUJ.EQ.1) THEN 271 : IPT2=IPT1 272 : ELSE 273 : IPT2=IPT1.LISOUS(ISOUJ) 274 : SEGACT, IPT2 275 : ENDIF 276 : NBELEJ=IPT2.NUM(/2) 277 : NBELEM=NBELEM+NBELEC*NBELEJ 278 : NBNNJ=MAX(NBNNJ,IPT2.NUM(/1)) 279 : 70 CONTINUE 280 : * 281 : * LES 2 MAILLAGES DOIVENT AVOIR LE MEME NOMBRE 282 : * DE MAILLES 283 : * IF(NBELEC.NE.NBELEJ) THEN 284 : * write(6,*) ' cest bien ce message 1' 284 : ** CALL ERREUR(21) 285 : * RETURN 286 : * ENDIF 287 : * 288 : * 288 : CALL MUTU3(NEF,IMAIL,IMODEL,IPCHE1,IPMAIL,XMATRI,ICPR, 289 : $ ICPR2) 290 : SEGDES,MELEME*NOMOD 291 : IF (IERR.NE.0)GOTO 99 292 : 50 CONTINUE 293 : SEGDES,MRIGID,XMATRI 294 : 99 CONTINUE 295 : SEGSUP ICPR,ICPR2 296 : DO 60 I=1,IFOI 297 : IMODEL=KMODEL(I) 298 : SEGDES,IMODEL*NOMOD 299 : 60 CONTINUE 300 : * END DO 301 : SEGDES,MMODEL*NOMOD 302 : IF(ISUP.EQ.1)SEGSUP MCHELM 303 : * 304 : RETURN 305 : END 306 : 307 : 308 :
© Cast3M 2003 - All rights reserved.
Disclaimer