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

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