C COML9 SOURCE JK148537 23/08/21 21:15:09 11723 SUBROUTINE COML9(iqmod,ipcon,iwrk53,ipinf,indeso,IRETOU,insupp) *----------------------------------------------------------------------- * coml9 : * traitement non-local * pour une loi de melange, etablir la contraite moyenne * nota : le modele 'PARALLELE' ne calcule pas par lui-meme les coef * de phase *----------------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMCHAML -INC SMELEME -INC SMMODEL -INC DECHE SEGMENT INFO INTEGER INFELL(16) ENDSEGMENT LOGICAL lsupco CHARACTER*8 lcon * Obligation d'initialiser ce segment WRK53 (DECHE) compte tenu du * fait que les variables de dimensionnement des melval ont le meme * nom que des variables contenues dans ce segment. * Si on ne le fait pas, plantage GEMAT !!!i * A revoir par la suite pour supprimer l'utilisation du segment wrk53. c segini,wrk53 wrk53 = iwrk53 lilcon = ipcon IMODEL = IQMOD meleme = IMAMOD SEGACT,meleme*nomod wrk53.nel = num(/2) SEGDES,meleme c information sur l'element fini c____________________________________________________________________ if (ipinf.ne.0) then INFO=IPINF MINTE = INFELL(11) wrk53.nbptel = INFELL(4) else MINTE = INFMOD(2+insupp) wrk53.nbptel = INFELE(4) endif c c modele de melange mecanique : nom des composantes c lsupco=.false. do iv = 1 , ivamod(/1) if (tymode(iv).eq.'IMODEL ') then imode1 = ivamod(iv) segact,imode1 if (imode1.formod(1).eq.'MECANIQUE ') then if (imode1.lnomid(4).ne.0) then mocomp = imode1.lnomid(4) else lsupco=.true. CALL IDCONT(IMODE1,IFOUR,MOCOMP,NOBL,NFAC) endif goto 11 endif endif enddo 11 CONTINUE lesupp = 5 nomid = mocomp segact nomid*nomod nobl = lesobl(/2) nfac = lesfac(/2) ijlcon = lilcon(/1) iilcon = ijlcon + nobl + nfac segadj lilcon do icom = 1,nobl * cree deche N3 = 6 segini deche lilcon(ijlcon + icom) = deche indec = indeso nomdec = lesobl(icom) condec = CONMOD typdec = 'REAL*8' typree = .true. imadec = IMAMOD ifodec = IFOUR infdec(1) = 0 infdec(2) = 0 infdec(3) = NIFOUR infdec(4) = MINTE infdec(5) = 0 infdec(6) = lesupp * cree melval c* Attention n2ptel <=> wrk53.n2ptel & n2el <=> wrk53.n2el n1ptel = wrk53.nbptel n1el = wrk53.nel n2ptel = 0 n2el = 0 segini,melval ieldec = melval * boucle sur les modeles do 31 iv = 1,ivamod(/1) if (tymode(iv).eq.'IMODEL ') then imode1 = ivamod(iv) segact,imode1 else goto 31 endif * somme les contributions do idcon = 1, lilcon(/1) dec1 = lilcon(idcon) if (dec1.gt.0) then if (dec1.nomdec .eq.nomdec.and. & dec1.condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)) & then * write(6,*) 'c9',nomdec,dec1,dec1.indec,iv,idcon melva1 = ABS(dec1.ieldec) im1 = melva1.velche(/1) jm1 = melva1.velche(/2) do idco2 = 1,lilcon(/1) dec2 = lilcon(idco2) if (dec2.gt.0) then C-??-??- if (dec2.nomdec(1:8).eq.imode1.conmod(17:24)) then if (dec2.nomdec(1:4).eq.imode1.conmod(17:20)) then * write(6,*) 'c92',dec2,dec2.nomdec,dec2.indec,iv,idcon,idco2 melva2 = ABS(dec2.ieldec) im2 = melva2.velche(/1) jm2 = melva2.velche(/2) * do jel = 1,n1el j1 = min(jel,jm1) j2 = min(jel,jm2) do jptel = 1,n1ptel i1 = min(jptel,im1) i2 = min(jptel,im2) velche(jptel,jel) = ( melva1.velche(i1,j1)*melva2.velche(i2,j2)) & + velche(jptel,jel) enddo enddo goto 31 endif endif enddo endif endif enddo 31 continue enddo segdes,nomid if (lsupco) segsup,nomid c segsup,wrk53 RETURN END