1 : C RESI1 SOURCE CHAT 11/03/16 21:30:36 6902 2 : SUBROUTINE RESI1(IPMODE,IPCHEL,IPRIGI) 3 : ************************************************************************ 4 : * 5 : * R E S I 1 6 : * --------- 7 : * 8 : * 9 : * FONCTION: 10 : * --------- 11 : * CREATION DE LA MATRICE DE RESISTANCE 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 : * IPRIGI (S) POINTEUR SUR LE SEGMENT MRIGID 20 : * +IFOMOD (E) VOIR CCOPTIO 21 : * 22 : * MODULES UTILISES: 23 : * ----------------- 24 : * 25 : IMPLICIT INTEGER(I-N) 26 : -INC CCOPTIO 27 : -INC CCHAMP 28 : -INC SMRIGID 29 : -INC SMCHAML 30 : -INC SMELEME 31 : -INC SMMODEL 32 : * 33 : * 34 : * VARIABLES: 35 : * ---------- 36 : * 37 : * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE 38 : * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP 39 : * NBMAIL NOMBRE DE MAILLAGES ELEMENTAIRES 40 : * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE 41 : * 42 : LOGICAL OK 43 : * 44 : * AUTEUR, DATE DE CREATION: 45 : * ------------------------- 46 : * 47 : * YANN STEPHAN, LE 28 JANVIER 1997 (COPIE DE TCOND1). 48 : * 49 : * LANGAGE: 50 : * -------- 51 : * 52 : * ESOPE + FORTRAN77 53 : * 54 : ************************************************************************ 55 : * 56 : * 57 : * VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES 58 : * 58 : CALL QUESUP(IPMODE,IPCHEL,2,0,ISUP,IRETCA) 59 : IF(ISUP.GT.1)RETURN 60 : * 61 : * SI LE CHAMELEM EST APPUYE AUX NOEUDS ,ON CHANGE LE SUPPORT 62 : * POUR LES CENTRES DE GRAVITE 63 : * 64 : IF(ISUP.EQ.1)THEN 64 : CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,2) 65 : IF(IRET.NE.0)THEN 65 : CALL ERREUR(IRET) 66 : RETURN 67 : ENDIF 68 : ELSE 69 : IPCHE1=IPCHEL 70 : ENDIF 71 : * 72 : * ACTIVATION DES SEGMENTS MCHELM ET MMODEL 73 : * 74 : MCHELM=IPCHE1 75 : SEGACT,MCHELM 76 : NBMAIC=IMACHE(/1) 77 : SEGDES MCHELM 78 : * 79 : MMODEL=IPMODE 80 : SEGACT,MMODEL 81 : NBMAIM=KMODEL(/1) 82 : IF (NBMAIM.GT.NBMAIC) THEN 83 : * 84 : * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES 85 : * DU MODELE 86 : * 86 : CALL ERREUR(404) 87 : SEGDES,MMODEL 88 : IF(ISUP.EQ.1)SEGSUP MCHELM 89 : RETURN 90 : ENDIF 91 : * 92 : NBMAIL=NBMAIM 93 : * 94 : * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 95 : * 96 : NRIGE=6 97 : NRIGEL=NBMAIL 98 : SEGINI,MRIGID 99 : IPRIGI=MRIGID 100 : ICHOLE=0 101 : IMGEO1=0 102 : IMGEO2=0 103 : IFORIG=IFOMOD 104 : ISUPEQ=0 105 : MTYMAT='RIGIDITE' 106 : NBGEOR=0 107 : * 108 : DO 40 IA=1,NBMAIL 109 : IRIGEL(4,IA)=0 110 : COERIG(IA)=1.D0 111 : 40 CONTINUE 112 : * END DO 113 : IFOI=0 114 : * 115 : * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL 116 : * 117 : DO 50 IMAIL=1,NBMAIL 118 : * 119 : IFOI=IFOI+1 120 : IMODEL=KMODEL(IMAIL) 121 : SEGACT,IMODEL 122 : ICOQ = 0 123 : NEF=NEFMOD 124 : MELEME=IMAMOD 125 : SEGACT,MELEME 126 : NBNN=NUM(/1) 127 : NBELEM=NUM(/2) 128 : * 129 : * REMPLIR LE SEGMENT DESCRIPTEUR DE L'OBJET RIGIDITE 130 : ** 130 : CALL RESI2(NEF,NBNN,IDESCR) 131 : * 132 : IF(IMAIL.GT.1)THEN 133 : MRIGID=IPRIGI 134 : SEGACT,MRIGID*MOD 135 : ENDIF 136 : * 137 : NLIGRE=NBNN 138 : descr=idescr 139 : segact descr 140 : nligrp=noelep(/1) 141 : nligrd=noeled(/1) 142 : segdes descr 143 : LVAL=(NBNN*(NBNN+1))/2 144 : * 145 : NELRIG=NBELEM 146 : SEGINI,xMATRI 147 : IRIGEL(1,IMAIL)=IMAMOD 148 : IRIGEL(2,IMAIL)=0 149 : IRIGEL(3,IMAIL)=IDESCR 150 : IRIGEL(4,IMAIL)=xMATRI 151 : IRIGEL(5,IMAIL)=0 152 : IRIGEL(6,IMAIL)=0 153 : * 154 : SEGDES,xMATRI,MRIGID 155 : SEGDES,MELEME 156 : * 156 : CALL RESI3(NEF,IMAIL,IMODEL,IPCHE1,IPRIGI) 157 : IF (IERR.NE.0)GOTO 99 158 : 50 CONTINUE 159 : 99 CONTINUE 160 : DO 60 I=1,IFOI 161 : IMODEL=KMODEL(I) 162 : SEGDES,IMODEL 163 : 60 CONTINUE 164 : * END DO 165 : SEGDES,MMODEL 166 : IF(ISUP.EQ.1)SEGSUP MCHELM 167 : * 168 : RETURN 169 : END 170 : 171 : 172 :
© Cast3M 2003 - All rights reserved.
Disclaimer