Télécharger la plaquette Cast3M


fr en

Télécharger mixemp.eso

Retour à la liste

Numérotation des lignes : 

mixemp

  1. C MIXEMP    SOURCE    CB215821  24/04/12    21:16:44     11897          
  2.       SUBROUTINE MIXEMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IRET,NOER)
  3. C_______________________________________________________________________
  4. C
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC CCHAMP
  12.  
  13. -INC SMMODEL
  14. -INC SMCHAML
  15. -INC SMELEME
  16. -INC SMINTE
  17. -INC SMLENTI
  18. -INC SMLMOTS
  19. -INC SMCOORD
  20. C
  21.       SEGMENT STBGRA
  22.        INTEGER LTBGRA(NBGRA,NBPHA)
  23.       ENDSEGMENT
  24.  
  25. *
  26.       SEGMENT NOTYPE
  27.         CHARACTER*16 TYPE(NBTYPE)
  28.       ENDSEGMENT
  29. *
  30.       SEGMENT LIMODE(NK100)
  31. *
  32.       PARAMETER ( NINF=3 )
  33.       INTEGER INFOS(NINF)
  34.       CHARACTER*8 CMATE
  35.       CHARACTER*(NCONCH) CONM
  36.       LOGICAL BDPGE,ldpge,lsupfo,lsupco,lsupma,dcmate
  37. *
  38.       lisloi = 0
  39.       liliph = 0
  40. C
  41. *      write(6,*) 'mixemp'
  42.       mmodel = IPMODL
  43.       NSOUS = mmodel.kmodel(/1)
  44. C
  45. C     ACTIVATION DES CONTRAINTES
  46. C
  47.       mchel1 = IPCHE1
  48.       mchel2 = IPCHE2
  49.  
  50. *      CALL oooprl(0)
  51.  
  52. * reperer le nombre de lois
  53.       jgn = 16
  54.       jgm = nsous
  55.       segini mlmots
  56.       imodel = kmodel(1)
  57.       mots(1) = conmod(1:16)
  58.       jg = nsous
  59.       segini mlenti,mlent1
  60.  
  61.       do ity = 1,ivamod(/1)
  62.        if(tymode(ity).eq.'PHASES  ') then
  63.          lect(1) = ivamod(ity)
  64.          goto 21
  65.        endif 
  66.       enddo 
  67.   21  klois = 1
  68.       do 100 ksous =2,nsous
  69.          imodel = kmodel(ksous)
  70.          do kl = 1,klois
  71.           if (conmod(1:16).eq.mots(kl)) goto 100
  72.          enddo
  73.          klois = klois + 1
  74.          mots(klois) = conmod(1:16)
  75.        do ity = 1,ivamod(/1)
  76.         if(tymode(ity).eq.'PHASES  ') then
  77.          lect(klois) = ivamod(ity)
  78.          goto 100
  79.         endif 
  80.        enddo 
  81.  100  continue
  82.       jgm = klois
  83.       segadj mlmots
  84.       lisloi = mlmots
  85.       jg = klois
  86.       segadj mlenti 
  87.       liliph = mlenti
  88.  
  89.       mlmot1 = lisloi
  90.       mlent1 = liliph
  91.       L1 = 14
  92.       n1 = nsous
  93.       n3 = 6
  94.       segini mchelm
  95.       TITCHE = 'CREE PAR  MIXE'
  96.       ifoche = ifour
  97.       ipche3 = mchelm
  98.       kche3 = 0
  99.  
  100.       DO iloi = 1,klois
  101.  
  102.         mlmots = mlent1.lect(iloi)
  103.         segact mlmots
  104.         nbpha = mots(/2)
  105.         jg = nbpha 
  106.         segini mlenti
  107. C
  108. C_______________________________________________________________________
  109. C
  110. C     BOUCLE SUR LES SOUS ZONES
  111. C_______________________________________________________________________
  112. C
  113.       DO 200 ISOUS = 1, NSOUS
  114.  
  115.         imode = kmodel(isous)
  116. *        write(6,*) CMATEE
  117.         ima0 = 1
  118.         IF(conmod(1:16).eq.mlmot1.mots(iloi)) THEN
  119.   208     ima1 = 0
  120.           do 221 im=ima0,mchel1.imache(/1)
  121.             if (mchel1.imache(im).eq.imamod) then
  122.               ima0 = im
  123.               mchaml = mchel1.ichaml(ima0)
  124.               do 211 inom1 = 1,nomche(/2)
  125.                 do iph = 1,nbpha
  126.                   if(nomche(inom1).eq.mots(iph)) then
  127.                     lect(iph) = ielval(inom1)
  128.                     goto 211
  129.                   endif
  130.                 enddo
  131.   211         continue
  132.               do iph =1,nbpha
  133.                 if(lect(iph).eq.0) then
  134. *      write(6,*) 'proportion de phase ',mots(iph),' zone ',isous, ' ?' 
  135.                   moterr(1:8)=mots(iph)
  136.                   interr(1) = isous 
  137.                   goto 9990
  138.                 endif
  139.               enddo
  140.               ima1 = im
  141.               ima0 = im + 1
  142.               goto 231
  143.             endif
  144.   221     continue
  145.  
  146.   231     if(ima1.le.0.and.ima0.le.1) then
  147.             call erreur(5) 
  148.             return
  149.           elseif(ima1.le.0.and.ima0.gt.1) then
  150.             goto 200
  151.           endif
  152.  
  153.           stbgra = 0
  154.           ima2 = 0
  155.           do 241 im=1,mchel2.imache(/1)
  156.             if (mchel2.imache(im).eq.imamod) then
  157.                 do iph = 1,nbpha
  158.                   if(mchel2.conche(im)(17:24).eq.mots(iph)) then
  159.                     if(stbgra.eq.0) then
  160.                       ima2 = im
  161.                       mchaml = mchel2.ichaml(im)
  162.                       mcham1 = mchaml
  163.                       n2 = nomche(/2)
  164.                       nbgra = n2
  165.                       segini stbgra
  166.                       do igr =1,n2
  167.                        ltbgra(igr,iph) = ielval(igr)
  168.                       enddo
  169.                     elseif(stbgra.gt.0) then
  170.                       mchaml = mchel2.ichaml(im)
  171.                       n2 = nomche(/2)
  172.                       if(n2.ne.nbgra) then
  173. *           write(6,*) 'incohérence grandeurs physiques', im
  174.                   moterr(1:8)='grandeur'
  175.                   interr(1) = im 
  176.                        goto 9990
  177.                       endif
  178.                       do ii = 1,6
  179.             if(mchel2.infche(im,ii).ne.mchel2.infche(ima2,ii)) then
  180.            write(6,*) 'incohérence grandeurs physiques infche', im,ii
  181.                        goto 9990
  182.             endif
  183.                       enddo
  184.                       do 248 iel =1,nbgra
  185.                         do igr =1,nbgra 
  186.                          if(nomche(iel).eq.mcham1.nomche(igr)) then
  187.                           ltbgra(igr,iph) = ielval(igr)
  188.                           goto 248
  189.                          endif
  190.                         enddo
  191.  248                  continue
  192.                     endif
  193.                   endif
  194.                 enddo
  195.             endif
  196.  241      continue
  197.  
  198.           do iph=1,nbpha
  199.             do igr=1,nbgra
  200.                 if(ltbgra(igr,iph).eq.0) then
  201. *      write(6,*) 'grandeur physique ',mcham1.nomche(igr),
  202. *     & ' phase ',mots(iph),' zone ',im,' ?' 
  203.                   moterr(1:8)=mots(iph)
  204.                   interr(1) = im
  205.                   goto 9990
  206.                 endif
  207.             enddo
  208.           enddo
  209.  
  210.           n2ptel = 0
  211.           n2el = 0
  212.           m1pt = 1
  213.           m1el = 1
  214.  
  215.           DO iph = 1,nbpha
  216.             melval = lect(iph)
  217.             m1pt = max(m1pt,velche(/1))
  218.             m1el = max(m1el,velche(/2))
  219.           ENDDO
  220.  
  221.           m0pt = m1pt
  222.           n0pt = m1el 
  223.  
  224.           n2 = nbgra
  225.           segini mchaml
  226.  
  227.           DO igr = 1,nbgra
  228.             if(m0pt.eq.1.or.m0el.eq.1) then
  229.               m1pt = m0pt
  230.               n1pt = n0pt
  231.               do iph = 1,nbpha
  232.                 melval = ltbgra(igr,iph)
  233.                 m1pt = max(m1pt,velche(/1))
  234.                 m1el = max(m1el,velche(/2))
  235.               enddo
  236.             endif
  237.  
  238.             n1ptel = m1pt
  239.             n1el = m1el 
  240.             segini melval
  241.  
  242.             DO iph = 1,nbpha
  243.               melva1 = lect(iph)
  244.               mphpt = melva1.velche(/1)
  245.               mphel = melva1.velche(/2)
  246.               melva2 = ltbgra(igr,iph)
  247.               mgrpt = melva2.velche(/1)
  248.               mgrel = melva2.velche(/2)
  249.  
  250.               do iel=1,n1el
  251.                 do ig = 1,n1ptel
  252.                 xph = melva1.velche(min(ig,mphpt),min(iel,mphel))
  253.                 xgr = melva2.velche(min(ig,mgrpt),min(iel,mgrel))
  254.                   if(cmatee.eq.'PARALLEL') then
  255.           velche(ig,iel) = xph * xgr + velche(ig,iel)          
  256.                   elseif(cmatee.eq.'SERIE   ') then
  257.                     if (xgr.eq.0) then
  258. *      write(6,*) 'grandeur physique nulle',mcham1.nomche(igr),
  259. *     & ' phase ',mots(iph),' zone ',im,' ?'
  260.                       goto 9990
  261.                   moterr(1:8)=mots(iph)
  262.                   interr(1) = im 
  263.                     endif
  264.           velche(ig,iel) = xph / xgr + velche(ig,iel)          
  265.                   endif
  266.  
  267.                 enddo
  268.               enddo
  269.  
  270.             ENDDO
  271.  
  272.             ielval(igr) = melval
  273.             typche(igr) = 'REAL*8'
  274.             nomche(igr) = mcham1.nomche(igr)
  275.           ENDDO
  276.  
  277.           kche3 = kche3 + 1
  278.           mchelm = ipche3
  279.           if(kche3.gt.imache(/1)) then
  280.              n1  = imache(/1) + 20
  281.              n3 = 6
  282.              segadj mchelm
  283.           endif
  284.           ichaml(kche3) = mchaml
  285.           imache(kche3) = imamod
  286.           conche(kche3)(1:16) = conmod(1:16)
  287.           mchel1 = ipche1
  288.           do ii =1,6 
  289.             infche(kche3,ii) = mchel2.infche(ima2,ii)
  290.           enddo
  291.           goto 208
  292.         ENDIF
  293.  
  294.  200  CONTINUE
  295.  
  296. * iloi
  297.       ENDDO
  298. *
  299. * Fin normale
  300.       IRET = 1
  301.       n1 = kche3
  302.       mchelm = ipche3
  303.       segadj mchelm
  304.       GOTO 9000
  305. *
  306. *     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  307. *
  308.  9990 CONTINUE
  309.       IRET = 0
  310.       if (nbgra.gt.0.and.igr.lt.nbgra) then
  311.           n2 = igr
  312.           segadj mchaml
  313.           kche3 = kche3 + 1
  314.           mchelm = ipche3
  315.           if(kche3.gt.imache(/1)) then
  316.              n1  = imache(/1) + 20
  317.              n3 = 6
  318.              segadj mchelm
  319.           endif
  320.           ichaml(kche3) = mchaml
  321.           imache(kche3) = imamod
  322.           n1 = kche3
  323.           mchelm = ipche3
  324.           segadj mchelm
  325.       else
  326.           if (kche3.gt.0) then
  327.            n1 = kche3
  328.            mchelm = ipche3
  329.            segadj mchelm
  330.           else
  331.            segsup mchelm
  332.            ipche3 = 0
  333.            call erreur(5)
  334.            return
  335.           endif
  336.       endif
  337.       call erreur(-370)
  338.       return
  339. *
  340. C Dernieres desactivations avant de quitter :
  341.  9000 CONTINUE
  342.       mmodel = IPMODL
  343.       SEGSUP,MMODEL
  344.  
  345.       END
  346.  
  347.  
  348.  
  349.  

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