Esope source files

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