1 : C MANUCI SOURCE CHAT 11/03/16 21:27:14 6902 2 : SUBROUTINE MANUCI(IPMODL,MOT1,MOT2,IEN1,IEN2,IEN3,XFLO, IPRES) 3 : *______________________________________________________________________ 4 : * 5 : * Donne une valeur en 1 point pour un MCHAML 6 : * Appele par MANUCE 7 : * 8 : * 9 : * Entrees : 10 : * --------- 11 : * 12 : * IPMODL Pointeur sur un MMODEL 13 : * MOT1 Mot indiquant le type du MCHAML a creer 14 : * MOT2 Nom de la composante concernee 15 : * IEN1 Numero de l'element 16 : * ENT2 Numero du point de gauss 17 : * ENT3 Numero de la sous zone concernee 18 : * (vaut 1 par defaut - cf. MANUCE) 19 : * XFLO Flottant ( Valeur de la composante MOT2 ) 20 : * 21 : * 22 : * Sortie : 23 : * -------- 24 : * 25 : * IPRES Pointeur sur le MCHAML resultat (=0 si erreur) 26 : * 27 : * EBERSOLT JANVIER 86 28 : * 29 : * Passage aux nouveaux MCHAMLs par JM CAMPENON le 06/91 30 : * 31 : *______________________________________________________________________ 32 : * 33 : IMPLICIT INTEGER(I-N) 34 : IMPLICIT REAL*8(A-H,O-Z) 35 : * 36 : -INC SMMODEL 37 : -INC SMCHAML 38 : -INC SMELEME 39 : -INC SMINTE 40 : -INC CCOPTIO 41 : * 42 : CHARACTER*(*) MOT1, MOT2 43 : * 44 : SEGMENT INFO 45 : INTEGER INFELL(JG) 46 : ENDSEGMENT 47 : * 48 : PARAMETER (NMOT=22) 49 : CHARACTER*8 LISMOT(NMOT) 50 : CHARACTER*50 LISTIT(NMOT) 51 : INTEGER MSUPPO(NMOT) 52 : LOGICAL LSUPNO 53 : * 54 : EXTERNAL LONG 55 : * 56 : DATA LISMOT / 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ', 57 : 1 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL', 58 : 1 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT', 59 : 1 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA', 60 : 1 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER', 61 : 1 'GRAFLEXI', 'VONMISES'/ 62 : * 63 : * LES MATERIAU ET CARACTERISTIQUE SONT MIS AUX NOEUDS 64 : * 65 : * 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ', 66 : DATA MSUPPO / 0 , 2 , 3 , 4 , 67 : * 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL', 68 : 1 5 , 0 , 0 , 0 , 69 : * 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT', 70 : 1 3 , 5 , 5 , 5 , 71 : * 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA', 72 : 1 0 , 0 , 5 , 5 , 73 : * 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER', 74 : 1 3 , 5 , 5 , 5 , 75 : * 'GRAFLEXI', 'VONMISES'/ 76 : 1 5 , 5 / 77 : * 78 : DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE', 79 : 1 'STRESSES', 'DEPLACEMENTS', 'FORCES', 80 : 1 'REACTUALISATION', 'FORCES VOLUMIQUES', 81 : 1 'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS', 82 : 1 'CARACTERISTIQUES', 'CARACTERISTIQUES', 83 : 1 'TEMPERATURES', 'CONTRAINTES PRINCIPALES', 84 : 1 'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE', 85 : 1 'DILATATIONS', 'VARIABLES INTERNES', 86 : 1 'GRADIENT DE FLEXION','VON MISES'/ 87 : * 88 : IPRES = 0 89 : * 90 : NHRM=NIFOUR 91 : * 92 : MMODEL=IPMODL 93 : SEGACT MMODEL 94 : NSOUS=KMODEL(/1) 95 : * 96 : IF (IEN3.GT.NSOUS) THEN 96 : CALL ERREUR (279) 97 : GOTO 990 98 : ENDIF 99 : * 100 : * CREATION DU MCHELM 101 : * On ne cree qu'un MCHAML a une sous zone 102 : * 102 : CALL PLACE(LISMOT,NMOT,IPLAC,MOT1) 103 : L1=LONG(LISTIT(IPLAC)) 104 : N1=1 105 : IF (MSUPPO(IPLAC).EQ.0) THEN 106 : N3=3 107 : ELSE 108 : N3=6 109 : ENDIF 110 : SEGINI MCHELM 111 : TITCHE=LISTIT(IPLAC)(1:L1) 112 : IFOCHE=IFOUR 113 : * 114 : * On active la sous zone concernee 115 : * 116 : IMODEL=KMODEL(IEN3) 117 : SEGACT IMODEL 118 : IF(INFMOD(/1).NE.0) THEN 119 : NPINT=INFMOD(1) 120 : ELSE 121 : NPINT = 0 122 : ENDIF 123 : IPMAIL=IMAMOD 124 : MELEME=IMAMOD 125 : MELE =NEFMOD 126 : MFR=NUMMFR(MELE) 127 : * 128 : SEGACT MELEME 129 : NBELEM=NUM(/2) 130 : IF (MSUPPO(IPLAC).EQ.0) THEN 131 : NBPGAU=NUM(/1) 132 : ENDIF 133 : SEGDES MELEME 134 : * 135 : IMACHE(1)=IPMAIL 136 : CONCHE(1)=CONMOD 137 : INFCHE(1,1)=0 138 : INFCHE(1,2)=0 139 : INFCHE(1,3)=NHRM 140 : IF (N3.GT.3) INFCHE(1,5)=0 141 : * 142 : lsupno=.true. 143 : MOCOMP=0 144 : * 145 : IF (MSUPPO(IPLAC).NE.0) THEN 146 : if(infmod(/1).lt.2+msuppo(iplac)) then 146 : CALL ELQUOI(MELE,0,MSUPPO(IPLAC),IPINF,IMODEL) 147 : IF (IERR.NE.0) GOTO 991 148 : INFO=IPINF 149 : MINTE=INFELL(11) 150 : SEGSUP INFO 151 : else 152 : minte=infmod(2+msuppo(iplac)) 153 : endif 154 : * 155 : SEGACT MINTE 156 : NBPGAU=POIGAU(/1) 157 : SEGDES MINTE 158 : ENDIF 159 : * 160 : * Si le numero du point de gauss ou de l'element est trop eleve 161 : * 162 : IF(IEN2.GT.NBPGAU.OR.IEN1.GT.NBELEM) THEN 162 : CALL ERREUR(262) 163 : GOTO 991 164 : ENDIF 165 : * 166 : IF (N3.GT.3) THEN 167 : INFCHE(1,4)=MINTE 168 : INFCHE(1,6)=MSUPPO(IPLAC) 169 : ENDIF 170 : * 171 : * AIGUILLAGE SUIVANT MOT CLE 172 : * 173 : GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2, 174 : 1 99,20,99,99) IPLAC 175 : * 176 : 99 MOTERR(1:8)='MCHAML ' 176 : CALL ERREUR(302) 177 : GOTO 991 178 : * 179 : 1 NBROBL=1 180 : NBRFAC=0 181 : SEGINI NOMID 182 : MOCOMP=NOMID 183 : LESOBL(1)='SCAL' 184 : GOTO 120 185 : * 186 : 2 NBROBL=1 187 : NBRFAC=0 188 : SEGINI NOMID 189 : MOCOMP=NOMID 190 : LESOBL(1)='MAHO' 191 : GOTO 120 192 : * 193 : 6 if(lnomid(1).ne.0) then 194 : mocomp=lnomid(1) 195 : lsupno=.false. 196 : else 196 : CALL IDDEPL(MFR,IFOUR,MOCOMP,NOBL,NFAC) 197 : endif 198 : GOTO 120 199 : * 200 : 7 if(lnomid(2).ne.0) then 201 : mocomp=lnomid(2) 202 : lsupno=.false. 203 : else 203 : CALL IDFORC(MFR,IFOUR,MOCOMP,NOBL,NFAC) 204 : endif 205 : GOTO 120 206 : * 207 : 10 if(lnomid(3).ne.0) then 208 : mocomp=lnomid(3) 209 : lsupno=.false. 210 : else 210 : CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC) 211 : endif 212 : GOTO 120 213 : * 214 : 11 if(lnomid(4).ne.0) then 215 : MOCOMP=lnomid(4) 216 : lsupno=.false. 217 : else 217 : CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 218 : endif 219 : GOTO 120 220 : * 221 : 12 IF(lnomid(5).ne.0) then 222 : mocomp=lnomid(5) 223 : lsupno=.false. 224 : else 224 : CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 225 : endif 226 : GOTO 120 227 : * 228 : 13 if(lnomid(6).ne.0) then 229 : MOCOMP=lnomid(6) 230 : lsupno=.false. 231 : else 231 : CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC) 232 : endif 233 : GOTO 120 234 : * 235 : 14 if(lnomid(7).ne.0) then 236 : MOCOMP=lnomid(7) 237 : lsupno=.false. 238 : else 238 : CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC) 239 : endif 240 : GOTO 120 241 : * 242 : 15 if(lnomid(8).ne.0) then 243 : MOCOMP=lnomid(8) 244 : lsupno=.false. 245 : else 245 : CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC) 246 : endif 247 : GOTO 120 248 : * 249 : 16 if(lnomid(9).ne.0) then 250 : MOCOMP=lnomid(9) 251 : lsupno=.false. 252 : else 252 : CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC) 253 : endif 254 : GOTO 120 255 : * 256 : 20 if(lnomid(10).ne.0) then 257 : MOCOMP=lnomid(10) 258 : lsupno=.false. 259 : else 259 : CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC) 260 : endif 261 : GOTO 120 262 : * 263 : 120 CONTINUE 264 : NOMID=MOCOMP 265 : SEGACT NOMID 266 : nobl=lesobl(/2) 267 : nfac=lesfac(/2) 268 : IF (NOBL.EQ.0.AND.NFAC.EQ.0) THEN 268 : CALL ERREUR(404) 269 : GOTO 992 270 : ENDIF 271 : * 272 : IPLAO=0 273 : IPLAF=0 274 : * 274 : CALL PLACE(LESOBL,NOBL,IPLAO,MOT2) 275 : * 276 : IF (IPLAO.EQ.0) THEN 276 : CALL PLACE(LESFAC,NFAC,IPLAF,MOT2) 277 : IF(IPLAF.EQ.0) THEN 278 : MOTERR(1:4)=MOT1 279 : MOTERR(5:8)=MOT2 279 : CALL ERREUR(260) 280 : GOTO 992 281 : ENDIF 282 : ENDIF 283 : * 284 : * Creation du MCHAML 285 : * 286 : N2=NOBL+NFAC 287 : SEGINI MCHAML 288 : ICHAML(1)=MCHAML 289 : N1PTEL=NBPGAU 290 : N1EL=NBELEM 291 : N2PTEL=0 292 : N2EL=0 293 : DO 130 ICOMP=1,NOBL 294 : NOMCHE(ICOMP)=LESOBL(ICOMP) 295 : TYPCHE(ICOMP)='REAL*8' 296 : SEGINI MELVAL 297 : IELVAL(ICOMP)=MELVAL 298 : DO 230 IGAU=1,N1PTEL 299 : DO 230 IB=1,N1EL 300 : VELCHE(IGAU,IB)=0.D0 301 : 230 CONTINUE 302 : IF (IPLAO.EQ.ICOMP) THEN 303 : VELCHE(IEN2,IEN1)=XFLO 304 : ENDIF 305 : SEGDES MELVAL 306 : 130 CONTINUE 307 : * 308 : * CORRECTIONS PP DEC92 : DECALAGE DE NOBL 309 : * 310 : DO 140 ICOMP=1,NFAC 311 : NOMCHE(ICOMP+NOBL)=LESFAC(ICOMP) 312 : TYPCHE(ICOMP+NOBL)='REAL*8' 313 : SEGINI MELVAL 314 : IELVAL(ICOMP+NOBL)=MELVAL 315 : DO 240 IGAU=1,N1PTEL 316 : DO 240 IB=1,N1EL 317 : VELCHE(IGAU,IB)=0.D0 318 : 240 CONTINUE 319 : IF (IPLAF.EQ.ICOMP) THEN 320 : VELCHE(IEN2,IEN1)=XFLO 321 : ENDIF 322 : SEGDES MELVAL 323 : 140 CONTINUE 324 : * 325 : SEGDES MCHELM 326 : IPRES=MCHELM 327 : 328 : 992 CONTINUE 329 : IF (lsupno) SEGSUP,NOMID 330 : 991 CONTINUE 331 : SEGDES,IMODEL 332 : IF (IERR.NE.0) THEN 333 : SEGSUP,MCHELM 334 : IPRES=0 335 : ENDIF 336 : 990 CONTINUE 337 : SEGDES MMODEL 338 : 339 : RETURN 340 : END 341 : 342 : 343 :
© Cast3M 2003 - All rights reserved.
Disclaimer