Télécharger la plaquette Cast3M


fr en

Télécharger fpshb8.eso

Retour à la liste

Numérotation des lignes : 

fpshb8

  1. C FPSHB8    SOURCE    CB215821  24/04/12    21:16:03     11897          
  2.       subroutine fpshb8(mmodel,mchpo1,p,mchpoi)
  3.       implicit real*8(a-h,o-z)
  4.       implicit integer (i-n)
  5. -INC PPARAM
  6. -INC CCOPTIO
  7. -INC SMCHPOI
  8. -INC SMELEME
  9. -INC SMMODEL
  10. -INC SMCOORD
  11.       character*4 moopt(2)
  12.       segment tratra
  13.        real *8 propel(2),out(3,8),re(1),d(1),xe(3,8),work(3)
  14.       endsegment
  15.       segment icpr(nbpts)
  16.       segment icprp(nbpts)
  17.       data moopt/'INTE','EXTE'/
  18. *
  19. *    verif que les surfaces interne ou externe existent
  20. *
  21.       icpr=0
  22.       icprp=0
  23.       mchpoi=0
  24.       segact mmodel
  25.       do  ia=1,kmodel(/1)
  26.          imodel=kmodel(ia)
  27.          segact imodel
  28.          if(nefmod.ne.260) then
  29.            call erreur (19)
  30.            return
  31.          endif
  32.          meleme=imamod
  33.          segact meleme
  34.          if(lisref(/1).ne.2) then
  35.            call erreur(1004)
  36.            return
  37.          endif
  38.          ipt1=lisref(1)
  39.          segact ipt1
  40.          if(ipt1.itypel.ne.8) then
  41.             call erreur (1004)
  42.             return
  43.          endif
  44.          segdes ipt1
  45.          ipt1=lisref(2)
  46.          segact ipt1
  47.          if(ipt1.itypel.ne.8) then
  48.             call erreur (1004)
  49.             return
  50.          endif
  51.          segdes ipt1
  52.       enddo
  53. *
  54. *  reperage du champpointy de pression si necessaire
  55. *
  56.       if( mchpo1.ne.0) then
  57.         segini icpr
  58.         segact mchpo1
  59.         if(mchpo1.ipchp(/1).ne.1) then
  60.            call erreur(180)
  61.            mchpoi=0
  62.            return
  63.         endif
  64.         msoupo=mchpo1.ipchp(1)
  65.         segact msoupo
  66.         ipt1=igeoc
  67.         segact ipt1
  68.         do i=1,ipt1.num(/2)
  69.            ia=ipt1.num(1,i)
  70.            icpr(ia)=i
  71.         enddo
  72.         mpova2=ipoval
  73.         segact mpova2
  74.         segdes msoupo,ipt1
  75.       endif
  76. *
  77. *    lecture du mot interne ou externe et debut de la
  78. *    fabrication du chpoint résultat
  79. *
  80.       call lirmot(moopt,2,isur,0)
  81.       if(isur.eq.0) then
  82. * on a pas lu ni interne ni externe on essaye de savoir
  83. * sur qui le chpoint de pression est appliqué
  84.          if(mchpo1.eq.0) then
  85.              call erreur(1005)
  86.              return
  87.          endif
  88.       isur1=0
  89.       do ia=1,kmodel(/1)
  90.         imodel=kmodel(ia)
  91.         meleme=imamod
  92.         do 321 io=1,2
  93.         ipt3=lisref(io)
  94.         segact ipt3
  95.         do iel=1,ipt3.num(/2)
  96.           iell=ipt3.num(1,iel)
  97.           if( icpr(iell).eq.0) go to 321
  98.         enddo
  99.         if(isur1.eq.0)  then
  100.          isur1=io
  101.          go to 322
  102.         else
  103.          if(isur1.ne.io)then
  104.            call erreur(1006)
  105.            return
  106.          endif
  107.         endif
  108.   321   continue
  109.   322   continue
  110.       enddo
  111.       if(isur1.eq.0) call erreur(286)
  112.       isur=isur1
  113.       endif
  114. *
  115. *   reperage de la surface
  116. *
  117.       segini icprp
  118.       nbelem=0
  119.       do ia=1,kmodel(/1)
  120.          imodel=kmodel(ia)
  121.          meleme=imamod
  122.          ipt3=lisref(isur)
  123.          segact ipt3
  124.          do ib=1,ipt3.num(/2)
  125.            do ic=1,ipt3.num(/1)
  126.              ie=ipt3.num(ic,ib)
  127.              if(icprp(ie).eq.0)  then
  128.                nbelem=nbelem+1
  129.               icprp(ie)=nbelem
  130.              endif
  131.            enddo
  132.          enddo
  133.       enddo
  134. *
  135. * debut de la fabrication du chpoint résultat
  136. *
  137.       nbnn=1
  138.       nbref=0
  139.       nbsous=0
  140.       segini ipt4
  141.       nsoupo=1
  142.       nat=1
  143.       segini mchpoi
  144.       ifopoi=ifour
  145.       mtypoi='FORCES'
  146.       mochde='crée par fpshb8 '
  147.       nc=3
  148.       segini msoupo
  149.       ipchp(1)=msoupo
  150.       segdes mchpoi
  151.       n=nbelem
  152.       segini mpoval
  153.       ipoval=mpoval
  154.       igeoc=ipt4
  155.       nocomp(1)='F  '
  156.       nocomp(2)='FY '
  157.       nocomp(3)='FZ '
  158.       noharm(1)=nifour
  159.       noharm(2)=nifour
  160.       noharm(3)=nifour
  161.       segdes msoupo
  162.       do ib=1,icprp(/1)
  163.         ia=icprp(ib)
  164.         if(ia.ne.0) ipt4.num(1,ia)=ib
  165.       enddo
  166.       segdes ipt4
  167. *
  168. *     boucle sur les élements
  169. *
  170.       segini tratra
  171.       idim1=idim+1
  172.       do  ir=1,kmodel(/1)
  173.         imodel=kmodel(ir)
  174.         meleme=imamod
  175.         segact meleme
  176.         ipt3=lisref(isur)
  177.         segact ipt3
  178.         propel(2)=isur
  179.         propel(1)=p
  180.         do iel=1,num(/2)
  181.           if( mchpo1.ne.0) then
  182.             p=0.d0
  183.             do j=1,ipt3.num(/1)
  184.               ih=ipt3.num(j,iel)
  185.               if(icpr(ih).ne.0) then
  186.                  p=p+mpova2.vpocha(icpr(ih),1)/4
  187.               endif
  188.             enddo
  189.             propel(1)=p
  190.           endif
  191.           do io=1,8
  192.             ia=num(io,iel)
  193.             xe(1,io)=xcoor((ia-1)*idim1+1)
  194.             xe(2,io)=xcoor((ia-1)*idim1+2)
  195.             xe(3,io)=xcoor((ia-1)*idim1+3)
  196.           enddo
  197.           call shb8(5,xe,D,propel,work,re,out)
  198. * assemblage
  199.  
  200.           do io=1,8
  201.             ia=num(io,iel)
  202.             ib=icprp(ia)
  203.             if(ib.ne.0) then
  204.             vpocha(ib,1)=out(1,io)+vpocha(ib,1)
  205.             vpocha(ib,2)=out(2,io)+vpocha(ib,2)
  206.             vpocha(ib,3)=out(3,io)+vpocha(ib,3)
  207.             endif
  208.           enddo
  209.         enddo
  210.         segdes imodel,meleme,ipt3
  211.       enddo
  212.       segdes mpoval
  213.       segdes mmodel
  214.       segsup icprp,tratra
  215.       if(icpr.ne.0) then
  216.          segsup icpr
  217.          segdes mpova2
  218.       endif
  219.       return
  220.       end
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  

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