1 : C INOMID SOURCE FANDEUR 12/07/18 21:15:47 7435 2 : SUBROUTINE INOMID(iqmod,ityp,iret,luvari,lumato,lumatf,lupaex) 3 : * 4 : * iqmod est un pointeur sur un segment imodel de l'objet modele, il est 5 : * supposé actif 6 : * 7 : * A) ITYP= ' ' 8 : * creation des segments de noms de composantes des MCHAML 9 : * CREES PAR LE MODELE ELEMENTAIRE 10 : * en entree luvari ,lumate et lupaex sont des listmots pour les : 11 : * variables internes , materiaux ,parametre externes s'ils ont été définis 12 : * attention : une modele de mecanique ne peut creer de composantes thermiques 13 : * ou phases metallurgiques ! 14 : * fortement inspire de comou2 15 : * 16 : * B) ITYP different de ' ' on renvoie dans iret le nomid associé. 17 : * 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT REAL*8(A-H,O-Z) 20 : 21 : -INC CCOPTIO 22 : -INC SMMODEL 23 : -INC SMLMOTS 24 : 25 : parameter(ninc=13) 26 : pointeur nomid1.nomid 27 : logical dcmate 28 : character*8 nomtyp(14),ityp 29 : CHARACTER*4 lesinc(ninc),lesdua(ninc) 30 : DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT','RT', 31 : 1'LX','P','ALFA','BETA'/ 32 : DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT','MT', 33 : 1'FLX','FP','FALF','FBET'/ 34 : data nomtyp/ 'DEPLACEM', 'FORCES ', 'GRADIENT', 'CONTRAIN', 35 : 1 'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT', 36 : 1 'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL', 37 : 1 'DEFINELA', 'PARAMEXT' / 38 : 39 : dcmate = .false. 40 : nimcom = 0 41 : * 42 : * on suppose le sous-modele (imodel) est actif 43 : imodel = iqmod 44 : segact imodel*mod 45 : do im = 1,matmod(/2) 46 : if (matmod(im).eq.'IMPEDANCE') then 47 : dcmate = .true. 48 : if (luvari.gt.0) then 49 : mlmot5 = luvari 50 : luvari = 0 51 : mlmot6 = lumato 52 : lumato = 0 53 : segact mlmot5,mlmot6 54 : nimcom = mlmot5.mots(/2) 55 : nbrobl = nimcom*2 56 : nbrfac = 0 57 : segini nomid,nomid1 58 : do inim = 1,nimcom 58 : CALL PLACE(lesinc,ninc,IMOT,mlmot5.mots(inim)) 58 : if (imot.eq.0) call erreur(26) 59 : lesobl(inim) = mlmot5.mots(inim) 60 : nomid1.lesobl(inim) = lesdua(imot) 60 : CALL PLACE(lesinc,ninc,IMOT,mlmot6.mots(inim)) 60 : if (imot.eq.0) call erreur(26) 61 : lesobl(nimcom+inim) = mlmot6.mots(inim) 62 : nomid1.lesobl(nimcom+inim) = lesdua(imot) 63 : enddo 64 : segdes nomid,nomid1 65 : endif 66 : endif 67 : enddo 68 : 69 : if (ityp.eq.' ') then 70 : ideb=1 71 : ifin=14 72 : else 73 : do ideb=1,14 74 : if(ityp.eq.nomtyp(ideb))go to 100 75 : enddo 76 : * write(ioimp,*) ' INOMID demande incompatible' 77 : stop 78 : 100 iret = lnomid (IDEB) 79 : nomid=iret 80 : segact nomid 81 : return 82 : endif 83 : 84 : NFOR=formod(/2) 84 : CALL PLACE(formod,NFOR,ITHEHY,'THERMOHYDRIQUE') 84 : CALL PLACE(formod,NFOR,ITHER,'THERMIQUE') 84 : CALL PLACE(formod,NFOR,IMAGN,'MAGNETODYNAMIQUE') 84 : CALL PLACE(formod,NFOR,IELEC,'ELECTROSTATIQUE') 84 : CALL PLACE(formod,NFOR,IDIFF,'DIFFUSION') 84 : CALL PLACE(formod,NFOR,ILIAIS,'LIAISON') 84 : CALL PLACE(formod,nfor,iconta,'CONTACT') 85 : * MELEME=IMAMOD 86 : MELE=nefmod 87 : MFR2=nummfr(mele) 88 : do jn=1,matmod(/2) 89 : if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE') 90 : & MFR2= infele(13) 91 : enddo 92 : IF (ITHEHY.EQ.1) MFR2=65 93 : IF (IELEC.EQ.1) MFR2=71 94 : IF (IDIFF.EQ.1) MFR2=73 95 : npint3=0 96 : if(infmod(/1).ne.0) npint3=infmod(1) 97 : * write(6,*) ' inomid formod', (formod(iou),iou=1,nfor) 98 : * write(6,*) ' mele MFR2 ',mele,mfr2 99 : 100 : DO 200 ino = ideb,ifin 101 : mocomp=0 102 : * 103 : * AIGUILLAGE SUIVANT MOT CLE 104 : GOTO ( 1, 2,3,4,5,6,7,8,9, 10,11,12,13,14) ino 105 : * 106 : 1 if (dcmate.and.nimcom.gt.0) then 107 : nobl = nimcom*2 108 : nfac = 0 109 : mocomp=nomid 110 : else 111 : if(ITHER.NE.0) THEN 111 : CALL IDTEMP(MFR2,IFOUR,npint3,MOCOMP,NOBL,NFAC) 112 : elseif(iconta.eq.0) then 112 : CALL IDDEPL(MFR2,IFOUR,MOCOMP,NOBL,NFAC) 113 : endif 114 : modepz=mocomp 115 : endif 116 : IF (IDIFF.EQ.1) THEN 117 : nomid = mocomp 118 : segact,nomid*MOD 119 : lesobl(1) = TYMODE(1) 120 : ENDIF 121 : * write(6,*) ' modepl MFR2 ' , mocomp,MFR2 122 : GOTO 120 123 : * 124 : 2 if (dcmate.and.nimcom.gt.0) then 125 : nobl = nimcom*2 126 : nfac = 0 127 : mocomp=nomid1 128 : elseif(iconta.eq.0) then 129 : if( ither.eq.0) then 129 : CALL IDFORC(MFR2,IFOUR,MOCOMP,NOBL,NFAC) 130 : else 131 : nomid1=modepz 132 : C* segact nomid1 133 : segini,nomid=nomid1 134 : mocomp=nomid 135 : do iou=1,lesobl(/2) 136 : if(lesobl(iou).EQ.'T' ) LESOBL(iou)='Q' 137 : if( lesobl(iou).EQ.'TSUP' ) LESOBL(iou)='QSUP' 138 : if( lesobl(iou).EQ.'TINF' ) LESOBL(iou)='QINF' 139 : enddo 140 : C* segdes nomid1 141 : endif 142 : endif 143 : IF (IDIFF.EQ.1) THEN 144 : nomid = mocomp 145 : segact,nomid*MOD 146 : lesobl(1) = TYMODE(2) 147 : ENDIF 148 : * write(6,*) ' moforc MFR2 ' , mocomp,MFR2 149 : GOTO 120 150 : * 151 : 3 if(ither.ne.0) then 152 : IF (MFR2.EQ.1) THEN 153 : MDM=29 154 : ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN 155 : MDM=39 156 : ENDIF 157 : ELSEIF(IMAGN.NE.0)then 158 : MDM=69 159 : ELSE 160 : MDM=MFR2 161 : ENDIF 161 : IF( iconta.eq.0)CALL IDGRAD(MDM,IFOUR,MOCOMP,NOBL,NFAC) 162 : IF (IDIFF.EQ.1) THEN 163 : nomid = mocomp 164 : segact,nomid*MOD 165 : DO i = 1,lesobl(/2) 166 : C*8 lesobl(i)(1:6) = TYMODE(1)(1:6) 167 : lesobl(i)(1:2) = TYMODE(1)(1:2) 168 : ENDDO 169 : ENDIF 170 : * write(6,*) ' mograd mfr ' , mocomp,mdm 171 : GOTO 120 172 : * 172 : 4 if(iconta.eq.0)CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 173 : * write(6,*) ' mocont ' , mocomp 174 : if (dcmate.and.nimcom.gt.0) then 175 : nbrobl = nimcom 176 : nbrfac = nfac 177 : nomid = mocomp 178 : segadj nomid 179 : endif 180 : GOTO 120 181 : * 181 : 5 if(iconta.eq.0)CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 182 : * write(6,*) ' modefo ',mocomp 183 : if (dcmate.and.nimcom.gt.0) then 184 : nbrobl = nimcom 185 : nbrfac = nfac 186 : nomid = mocomp 187 : segadj nomid 188 : endif 189 : GOTO 120 190 : * 191 : 6 IF(lumato.EQ.0) THEN 191 : CALL IDMATR(MFR2,IMODEL,MOCOMP,NOBL,NFAC) 192 : ELSE 193 : mlmots=lumato 194 : segact MLMOTS 195 : nbrobl=mots(/2) 196 : nbrfac=0 197 : IF (lumatf.NE.0) THEN 198 : mlmot1=lumatf 199 : segact mlmot1 200 : nbrfac=mlmot1.mots(/2) 201 : ENDIF 202 : SEGINI,nomid 203 : DO io=1,nbrobl 204 : lesobl(io)=mots(io) 205 : enddo 206 : segdes,mlmots 207 : if(lumatf.ne.0) then 208 : do io=1,nbrfac 209 : lesfac(io)=mlmot1.mots(io) 210 : enddo 211 : segdes,mlmot1 212 : endif 213 : mocomp=nomid 214 : ENDIF 215 : * write(6,*) ' momatr ',mocomp 216 : GOTO 120 217 : * 218 : 7 CONTINUE 219 : * attention pas de caracteristiques pour materiaux modal,statique,impedance 220 : * et pour formulation liaison on bidonne en appelant avec mele = 14 (cub8) 221 : melee=mele 222 : do jn=1,matmod(/2) 223 : if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE'.or. 224 : & matmod(jn).eq.'IMPEDANCE') Melee=14 225 : enddo 226 : if(iliais.ne.0) melee=14 226 : if(iconta.eq.0)CALL IDCARB(MELEe,IFOUR,MOCOMP,NOBL,NFAC) 227 : * write(6,*) ' mocara ',mocomp 228 : GOTO 120 229 : * 230 : 8 mocomp=0 231 : if(ither.eq.0.and.iconta.eq.0) 231 : $ CALL IDTEMP(MFR2,IFOUR,npint3,MOCOMP,NOBL,NFAC) 232 : * write(6,*) ' motemp ',mocomp 233 : GOTO 120 234 : * 234 : 9 if(iconta.eq.0)CALL IDPRIN(MFR2,IFOUR,MOCOMP,NOBL,NFAC) 235 : * write(6,*) ' moprin ',mocomp 236 : GOTO 120 237 : * 238 : 10 CONTINUE 239 : * if(LUVARI.EQ.0) then 239 : if(iconta.eq.0) CALL IDVARI(MFR2,IMODEL,MOCOMP,NOBL,NFAC) 240 : * else 241 : if(luvari.ne.0) then 242 : mlmots=luvari 243 : segact MLMOTS 244 : nomid= mocomp 245 : if (nomid.ne.0) then 246 : segact nomid*mod 247 : ndej=lesobl(/2) 248 : if(ndej.eq.1) ndej=0 249 : nbrobl=mots(/2)+ndej 250 : nbrfac=0 251 : ista=ndej+1 252 : segadj nomid 253 : iau=1 254 : do io=ista,nbrobl 255 : lesobl(io)=mots(iau) 256 : iau=iau+1 257 : enddo 258 : else 259 : nbrobl=mots(/2) 260 : nbrfac=0 261 : segini nomid 262 : do io=1,nbrobl 263 : lesobl(io)=mots(io) 264 : enddo 265 : endif 266 : segdes mlmots 267 : mocomp=nomid 268 : endif 269 : * endif 270 : * write(6,*) ' movari ', mocomp 271 : GOTO 120 272 : * 272 : 11 if(iconta.eq.0)CALL IDGRAF(MFR2,IFOUR,MOCOMP,NOBL,NFAC) 273 : * write(6,*) ' movari ', mocomp 274 : GOTO 120 275 : * 275 : 12 if(iconta.eq.0)CALL IDPHAS(MFR2,IMODEL,MOCOMP,NOBL,NFAC) 276 : * write(6,*) ' mophas ', mocomp 277 : GOTO 120 278 : * 278 : 13 if(iconta.eq.0)CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC) 279 : * write(6,*) ' modein ', mocomp 280 : GOTO 120 281 : 282 : * le parametre externe est deja sous forme de listmots 283 : 14 MOCOMP=LUPAEX 284 : if (LUPAEX.NE.0) THEN 285 : mlmots=lupaex 286 : segact MLMOTS 287 : nbrobl=mots(/2) 288 : nbrfac=0 289 : segini nomid 290 : do io=1,nbrobl 291 : lesobl(io)=mots(io) 292 : enddo 293 : mocomp=nomid 294 : * write(6,*)' mopaex ',nomid 295 : ENDIF 296 : GOTO 120 297 : * 298 : 120 CONTINUE 299 : nomid = mocomp 300 : lnomid(ino)=mocomp 301 : IF (nomid.NE.0) SEGDES,nomid 302 : 303 : * if (nomid.NE.0) THEN 304 : * segact nomid 305 : * write(6,*) ' type ' , nomtyp(ino) 306 : * write(6,*) ' lesobl(/2) ', lesobl(/2) 307 : * write(6,*) (lesobl(iou),iou=1,lesobl(/2)) 308 : * write(6,*) ' lesfac ' , (lesfac(iou),iou=1,lesfac(/2)) 309 : * segdes,nomid 310 : * endif 311 : 312 : 200 CONTINUE 313 : 314 : RETURN 315 : END 316 : 317 :
© Cast3M 2003 - All rights reserved.
Disclaimer