Télécharger la plaquette Cast3M


fr en

Télécharger coml9.eso

Retour à la liste

Numérotation des lignes : 

coml9

  1. C COML9     SOURCE    MB234859  25/09/08    21:15:17     12358          
  2.  
  3.       SUBROUTINE COML9(iqmod,ipcon,iwrk53,indeso,IRETOU,insupp)
  4.  
  5. *-----------------------------------------------------------------------
  6. * coml9 :
  7. *      traitement non-local
  8. *          pour une loi de melange, etablir la contraite moyenne
  9. *     nota : le modele 'PARALLELE' ne calcule pas par lui-meme les coef
  10. *            de phase
  11. *-----------------------------------------------------------------------
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14.  
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC CCGEOME
  19. -INC SMCHAML
  20. -INC SMELEME
  21. -INC SMMODEL
  22. -INC DECHE
  23.  
  24.       LOGICAL lsupco
  25.       CHARACTER*8 lcon
  26.  
  27. * Obligation d'initialiser ce segment WRK53 (DECHE) compte tenu du
  28. * fait que les variables de dimensionnement des melval ont le meme
  29. * nom que des variables contenues dans ce segment.
  30. * Si on ne le fait pas, plantage GEMAT !!!i
  31. * A revoir par la suite pour supprimer l'utilisation du segment wrk53.
  32. c      segini,wrk53
  33.       wrk53 = iwrk53
  34.  
  35.       lilcon = ipcon
  36.       IMODEL = IQMOD
  37.  
  38.       meleme = IMAMOD
  39.       SEGACT,meleme*nomod
  40.       wrk53.nel = num(/2)
  41.       SEGDES,meleme
  42.  
  43. c     information sur l'element fini
  44. c____________________________________________________________________
  45.       MINTE  = INFMOD(2+insupp)
  46.       wrk53.nbptel = INFELE(4)
  47. c
  48. c modele de melange mecanique : nom des composantes
  49. c
  50.       lsupco=.false.
  51.       do iv = 1 , ivamod(/1)
  52.         if (tymode(iv).eq.'IMODEL  ') then
  53.           imode1 = ivamod(iv)
  54.           segact,imode1
  55.           if (imode1.formod(1).eq.'MECANIQUE       ') then
  56.             if (imode1.lnomid(4).ne.0) then
  57.               mocomp = imode1.lnomid(4)
  58.             else
  59.               lsupco=.true.
  60.               CALL IDCONT(IMODE1,IFOUR,MOCOMP,NOBL,NFAC)
  61.             endif
  62.             goto 11
  63.           endif
  64.         endif
  65.       enddo
  66.  
  67.  11   CONTINUE
  68.       lesupp = 5
  69.       nomid = mocomp
  70.       segact nomid*nomod
  71.       nobl = lesobl(/2)
  72.       nfac = lesfac(/2)
  73.  
  74.       ijlcon = lilcon(/1)
  75.       iilcon = ijlcon + nobl + nfac
  76.       segadj lilcon
  77.  
  78.       do icom = 1,nobl
  79. * cree deche
  80.         N3 = 6
  81.         segini deche
  82.         lilcon(ijlcon + icom) = deche
  83.         indec  = indeso
  84.         nomdec = lesobl(icom)
  85.         condec = CONMOD
  86.         typdec = 'REAL*8'
  87.         typree = .true.
  88.         imadec = IMAMOD
  89.         ifodec = IFOUR
  90.         infdec(1) = 0
  91.         infdec(2) = 0
  92.         infdec(3) = NIFOUR
  93.         infdec(4) = MINTE
  94.         infdec(5) = 0
  95.         infdec(6) = lesupp
  96. * cree melval
  97. c* Attention n2ptel <=> wrk53.n2ptel & n2el <=> wrk53.n2el
  98.         n1ptel = wrk53.nbptel
  99.         n1el   = wrk53.nel
  100.         n2ptel = 0
  101.         n2el   = 0
  102.         segini,melval
  103.         ieldec = melval
  104.  
  105. * boucle sur les modeles
  106.         do 31 iv = 1,ivamod(/1)
  107.             if (tymode(iv).eq.'IMODEL  ') then
  108.               imode1 = ivamod(iv)
  109.               segact,imode1
  110.             else
  111.               goto 31
  112.             endif
  113. * somme les contributions
  114.         do idcon = 1, lilcon(/1)
  115.           dec1 = lilcon(idcon)
  116.           if (dec1.gt.0) then
  117.           if (dec1.nomdec          .eq.nomdec.and.
  118.      &        dec1.condec(1:LCONMO).eq.imode1.conmod(1:LCONMO))
  119.      & then
  120. *            write(6,*) 'c9',nomdec,dec1,dec1.indec,iv,idcon
  121.             melva1 = ABS(dec1.ieldec)
  122.             im1 = melva1.velche(/1)
  123.             jm1 = melva1.velche(/2)
  124.  
  125.             do idco2 = 1,lilcon(/1)
  126.               dec2 = lilcon(idco2)
  127.               if (dec2.gt.0) then
  128. C-??-??-      if (dec2.nomdec(1:8).eq.imode1.conmod(17:24)) then
  129.               if (dec2.nomdec(1:4).eq.imode1.conmod(17:20)) then
  130. *          write(6,*) 'c92',dec2,dec2.nomdec,dec2.indec,iv,idcon,idco2              
  131.                 melva2 = ABS(dec2.ieldec)
  132.                 im2 = melva2.velche(/1)
  133.                 jm2 = melva2.velche(/2)
  134. *
  135.                do jel = 1,n1el
  136.                 j1 = min(jel,jm1)
  137.                 j2 = min(jel,jm2)
  138.                 do jptel = 1,n1ptel
  139.                   i1 = min(jptel,im1)
  140.                   i2 = min(jptel,im2)
  141.        velche(jptel,jel) = ( melva1.velche(i1,j1)*melva2.velche(i2,j2))
  142.      &              + velche(jptel,jel)
  143.                 enddo
  144.                enddo
  145.                goto 31
  146.               endif
  147.               endif
  148.             enddo
  149.           endif
  150.           endif
  151.         enddo
  152.  31    continue
  153.       enddo
  154.  
  155.       segdes,nomid
  156.       if (lsupco) segsup,nomid
  157. c      segsup,wrk53
  158.  
  159.       RETURN
  160.       END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales