1 : C TAILPO SOURCE CHAT 11/07/12 21:15:16 7028 2 : C responsable : Mr MILLARD 3 : C======================================================================= 4 : C 5 : SUBROUTINE TAILPO(IPMODL,IPCHE,IUNIF,IRET) 6 : C 7 : C======================================================================= 8 : C ENTREES : 9 : C --------- 10 : C IPMODL= pointeur sur un MMODEL 11 : C 12 : C SORTIES : 13 : C -------- 14 : C IPCHE = CHAMELEM contenant les parametres de tailles aux 15 : C point de GAUSS necessaire a modele beton OTTOSEN 16 : C IRET = 1 si succes 0 sinon 17 : C======================================================================= 18 : 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8(A-H,O-Z) 21 : 22 : PARAMETER(XUN=1.D0,XZER=0.D0) 23 : EXTERNAL SHAPE 24 : 25 : -INC CCOPTIO 26 : -INC CCHAMP 27 : -INC SMCHAML 28 : -INC SMMODEL 29 : -INC SMELEME 30 : -INC SMCOORD 31 : -INC SMINTE 32 : 33 : SEGMENT MTRA1 34 : REAL*8 XEL(3,NBNN) 35 : REAL*8 VCOMP(NCOMP) 36 : REAL*8 SHP(6,NBNN),SHPZER(6,NBNN) 37 : REAL*8 SHPQSI(6,NBNN),SHPETA(6,NBNN),SHPDZE(6,NBNN) 38 : C* REAL*8 SHPGAU(6,NBNN) 39 : ENDSEGMENT 40 : 41 : SEGMENT MTRA2 42 : REAL*8 BPSS(3,3),YEL(3,NBNN) 43 : ENDSEGMENT 44 : 45 : * SEGMENT INFO 46 : * INTEGER INFELE(JG) 47 : * ENDSEGMENT 48 : C 49 : C ACTIVATION DU MODELE 50 : C 51 : MMODEL= IPMODL 52 : SEGACT MMODEL 53 : NSOUS=KMODEL(/1) 54 : C 55 : C CREATION DU MCHELM 56 : C 57 : N1=NSOUS 58 : L1=16 59 : N3=6 60 : SEGINI,MCHELM 61 : TITCHE='CARACTERISTIQUES' 62 : IFOCHE=IFOUR 63 : NHRM=NIFOUR 64 : 65 : C======================================================================= 66 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES 67 : C======================================================================= 68 : C 69 : DO 500 ISOUS=1,NSOUS 70 : C 71 : C----------------------------------------------------------------------- 72 : C Traitement du modele de la sous-zone ISOUS 73 : C----------------------------------------------------------------------- 74 : IMODEL=KMODEL(ISOUS) 75 : SEGACT,IMODEL 76 : IPMAIL=IMAMOD 77 : C Numero de l element fini dans nomtp de CCHAMP.INC 78 : MELE=NEFMOD 79 : C----------------------------------------------------------------------- 80 : C INFORMATION SUR L'ELEMENT FINI 81 : C----------------------------------------------------------------------- 81 : * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 82 : * IF (IERR.NE.0) THEN 82 : * CALL ERREUR(660) 83 : * GOTO 590 84 : * ENDIF 85 : * INFO=IPINF 86 : MELE=INFELE(1) 87 : IELE=NUMGEO(MELE) 88 : C Numero de la formulation de l element fini (massif ...) 89 : MFR =INFELE(13) 90 : C Pointeur sur un segment d integration 91 : MINTE=INFMOD(5) 92 : * MINTE=INFELE(11) 93 : * SEGSUP INFO 94 : C----------------------------------------------------------------------- 95 : C- CREATION DU MCHAML DE LA SOUS ZONE--------------------- 96 : C----------------------------------------------------------------------- 97 : C Remplissage de l'entete dans le MCHELM 98 : C pointeur sur le maillage de la sous zone (maillage elementaire) 99 : IMACHE(ISOUS)=IPMAIL 100 : C Nom du constituant 101 : CONCHE(ISOUS)=CONMOD 102 : C =0 pour des valeurs independantes du repere 103 : C en fait, ces valeurs dependent du repere global mais 104 : C nous voulons un champ de caracteristiques (donc idpt du repere) 105 : INFCHE(ISOUS,1)=0 106 : INFCHE(ISOUS,2)=0 107 : C numero de l harmonique de Fourier 108 : INFCHE(ISOUS,3)=NHRM 109 : C pointeur sur un SMINTE 110 : INFCHE(ISOUS,4)=MINTE 111 : C =0 pour des champs de defomations et contraintes usuels 112 : INFCHE(ISOUS,5)=0 113 : C =3 SMINTE pointe sur un segment d integration aux pts de GAUSS 114 : C pour la rigidite 115 : INFCHE(ISOUS,6)=3 116 : C NOMBRE DES COMPOSANTES SELON LA DIMENSION 117 : N2 = 0 118 : IF (IDIM.EQ.2) N2=7 119 : IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9)) N2=7 120 : IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.31)) N2=12 121 : C ERREUR FORMULATION INDISPONIBLE 122 : IF (N2 .EQ. 0) THEN 123 : MOTERR(1:8)=NOMFR(MFR) 123 : CALL ERREUR(193) 124 : GOTO 590 125 : ENDIF 126 : C----------------------------------------------------------------------- 127 : C CREATION DU MCHAML 128 : C----------------------------------------------------------------------- 129 : SEGINI MCHAML 130 : ICHAML(ISOUS)=MCHAML 131 : C----------------------------------------------------------------------- 132 : C Remplissage du MCHAML 133 : C----------------------------------------------------------------------- 134 : NCOMP = N2 135 : DO i=1,NCOMP 136 : TYPCHE(i)='REAL*8' 137 : ENDDO 138 : * 139 : C NOM DES COMPOSANTES SELON LA DIMENSION 140 : C Si l option de calcul est PLAN 141 : IF (IFOMOD.EQ.-1) THEN 142 : NOMCHE(1)='LXX ' 143 : NOMCHE(2)='LYY ' 144 : NOMCHE(3)='LZZ ' 145 : NOMCHE(4)='LXY ' 146 : NOMCHE(5)='PXX ' 147 : NOMCHE(6)='PYY ' 148 : NOMCHE(7)='PXY ' 149 : C Si l option de calcul est AXIS ou FOUR 150 : ELSE IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN 151 : NOMCHE(1)='LRR ' 152 : NOMCHE(2)='LZZ ' 153 : NOMCHE(3)='LOO ' 154 : NOMCHE(4)='LRZ ' 155 : NOMCHE(5)='PRR ' 156 : NOMCHE(6)='PZZ ' 157 : NOMCHE(7)='PRZ ' 158 : C Si l option de calcul est TRID CAS MASSIF 159 : ELSE IF (IFOMOD.EQ.2.AND.(MFR.EQ.1.OR.MFR.EQ.31)) THEN 160 : NOMCHE( 1)='LXX ' 161 : NOMCHE( 2)='LYY ' 162 : NOMCHE( 3)='LZZ ' 163 : NOMCHE( 4)='LXY ' 164 : NOMCHE( 5)='LXZ ' 165 : NOMCHE( 6)='LYZ ' 166 : NOMCHE( 7)='PXX ' 167 : NOMCHE( 8)='PYY ' 168 : NOMCHE( 9)='PZZ ' 169 : NOMCHE(10)='PXY ' 170 : NOMCHE(11)='PXZ ' 171 : NOMCHE(12)='PYZ ' 172 : C Si l option de calcul est TRID CAS COQUES 173 : ELSE IF (IFOMOD.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN 174 : NOMCHE(1)='LSS ' 175 : NOMCHE(2)='LTT ' 176 : NOMCHE(3)='LNN ' 177 : NOMCHE(4)='LST ' 178 : NOMCHE(5)='PSS ' 179 : NOMCHE(6)='PTT ' 180 : NOMCHE(7)='PST ' 181 : ELSE 181 : CALL ERREUR(5) 182 : GOTO 591 183 : ENDIF 184 : C 185 : C----------------------------------------------------------------------- 186 : C CREATION ET REMPLISSAGE DU MELVAL DE CHAQUE COMPOSANTE 187 : C----------------------------------------------------------------------- 188 : C Nous n avons que des composantes scalaires donc N2*=0---- 189 : N2PTEL=0 190 : N2EL=0 191 : C Cas 1 : Champs UNIFORMEs (valeur nulle) 192 : IF (IUNIF.NE.0) THEN 193 : N1PTEL=1 194 : N1EL=1 195 : DO i=1,NCOMP 196 : SEGINI,MELVAL 197 : IELVAL(i)=MELVAL 198 : VELCHE(1,1)=XZER 199 : SEGDES,MELVAL 200 : ENDDO 201 : C Cas 2 : Calculs des tenseurs en chaque point d'integration ! 202 : ELSE 203 : C---------INFORMATION sur les fonctions de forme ( MINTE )--------- 204 : SEGACT MINTE 205 : NBPGAU=POIGAU(/1) 206 : C----ACTIVATION DU MELEME : Maillage elementaire de la sous zone--- 207 : MELEME=IPMAIL 208 : SEGACT MELEME 209 : NBNN =NUM(/1) 210 : NBELEM=NUM(/2) 211 : N1PTEL=NBPGAU 212 : N1EL =NBELEM 213 : C-Initialisation du segment des valeurs aux points de Gauss 214 : DO i=1,NCOMP 215 : SEGINI,MELVAL 216 : IELVAL(i)=MELVAL 217 : ENDDO 218 : C-- Segments de travail 219 : SEGINI,MTRA1 220 : MTRA2=0 221 : IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9)) SEGINI,MTRA2 222 : C-------------------------------------------------------------------- 223 : C initialisation des fonctions de formes aux points de GAUSS 224 : C pour l element de reference de cette sous zone 225 : C-------------------------------------------------------------------- 226 : C-initialisation des fonctions de forme a l origine et sur les axes- 226 : CALL SHAPE(XZER,XZER,XZER,IELE,SHPZER,IRET) 227 : * IF (IRET.EQ.0) THEN 227 : * CALL ERREUR(662) 228 : * GOTO 592 229 : * ENDIF 229 : CALL SHAPE(XUN,XZER,XZER,IELE,SHPQSI,IRET) 230 : * IF (IRET.EQ.0) THEN 230 : * CALL ERREUR(662) 231 : * GOTO 592 232 : * ENDIF 232 : CALL SHAPE(XZER,XUN,XZER,IELE,SHPETA,IRET) 233 : * IF (IRET.EQ.0) THEN 233 : * CALL ERREUR(662) 234 : * GOTO 592 235 : * ENDIF 235 : CALL SHAPE(XZER,XZER,XUN,IELE,SHPDZE,IRET) 236 : IF (IRET.EQ.0) THEN 236 : CALL ERREUR(662) 237 : GOTO 592 238 : ENDIF 239 : 240 : C BOUCLE SUR CHAQUE ELEMENT 241 : C----------------------------------------------------------------------- 242 : DO 1000 IB=1,NBELEM 243 : C extraction des coordonnees des noeuds de l element IB 244 : C resultat dans XEL 244 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) 245 : C 246 : C CAS DES COQUES 3D - RECHERCHE DES COORDONNEES LOCALES 247 : IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN 248 : C* IF (MTRA2.NE.0) THEN 249 : DO j=1,NBNN 250 : DO i=1,3 251 : YEL(i,j)=XEL(i,j) 252 : ENDDO 253 : ENDDO 253 : CALL VPAST(YEL,BPSS) 253 : CALL VCORL1(YEL,XEL,BPSS,NBNN) 254 : ENDIF 255 : C 256 : C BOUCLE SUR CHAQUE POINT DE GAUSS 257 : C============================================================= 258 : DO 1004 IC=1,NBPGAU 259 : C 260 : DO j=1,NBNN 261 : DO i=1,6 262 : SHP(i,j)=SHPTOT(i,j,IC) 263 : ENDDO 264 : ENDDO 265 : POI=POIGAU(IC) 266 : * QSI=QSIGAU(IC) 267 : * ETA=ETAGAU(IC) 268 : * DZE=DZEGAU(IC) 268 : * CALL SHAPE(QSI,ETA,DZE,IELE,SHPGAU,IRET) 269 : * IF (IRET.EQ.0) THEN 269 : * CALL ERREUR(662) 270 : * GOTO 592 271 : * ENDIF 272 : C 272 : CALL TAILCA(MTRA1,POI,IDIM,IFOUR,NBNN,MELE,IELE,MFR,IRET) 273 : IF (IRET.EQ.0) THEN 273 : CALL ERREUR(663) 274 : GOTO 592 275 : ENDIF 276 : C 277 : DO i=1,NCOMP 278 : MELVAL=IELVAL(i) 279 : VELCHE(IC,IB)=VCOMP(i) 280 : ENDDO 281 : C 282 : 1004 CONTINUE 283 : C 284 : 1000 CONTINUE 285 : 286 : 592 CONTINUE 287 : DO i=1,NCOMP 288 : MELVAL=IELVAL(i) 289 : SEGDES,MELVAL 290 : ENDDO 291 : SEGDES,MINTE,MELEME 292 : SEGSUP,MTRA1 293 : IF (MTRA2.NE.0) SEGSUP,MTRA2 294 : ENDIF 295 : C--------------------------------------------------------------------- 296 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS 297 : C--------------------------------------------------------------------- 298 : 591 CONTINUE 299 : SEGDES,MCHAML 300 : 590 CONTINUE 301 : SEGDES IMODEL 302 : IF (IERR.NE.0) GOTO 9990 303 : C=================================================================== 304 : C------------ET L ON BOUCLE SUR LES SOUS ZONES RESTANTES----------- 305 : C================================================================== 306 : 500 CONTINUE 307 : 308 : C---------------------FIN NORMAL DU CALCUL------------------------- 309 : SEGDES,MMODEL 310 : SEGDES,MCHELM 311 : IPCHE=MCHELM 312 : IRET=1 313 : RETURN 314 : 315 : C------------------------------------------------------------------- 316 : C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR 317 : C------------------------------------------------------------------- 318 : 9990 CONTINUE 319 : SEGDES,MMODEL 320 : SEGSUP,MCHELM 321 : IPCHE=0 322 : IRET=0 323 : 324 : RETURN 325 : END 326 : 327 : 328 : 329 :
© Cast3M 2003 - All rights reserved.
Disclaimer