Télécharger la plaquette Cast3M


fr en

Télécharger splitag.eso

Retour à la liste

Numérotation des lignes : 

splitag

  1. C SPLITAG   SOURCE    CB215821  24/04/12    21:17:16     11897          
  2.       SUBROUTINE SPLITAG(IPMODL,IPCARA,IPCHC1,IPMOD2,IPCAR2,
  3.      & ipchc2,siezo)
  4. *======================================================================
  5. *   On a un seul modele   defini sur des seg2 definissant des cables
  6. *   on veut fabriquer un modele intermediaire comportant une sous zone
  7. *   par cable pour appliquer des tensions a leurs extremites  et
  8. *   calculer des pertes  de precontraintes
  9. *
  10. *   on partitione  :
  11. *          geometrie
  12. *          modele                                ipmodl ---> ipmod2
  13. *          champs de caracteristiques            ipcara ---> ipcar2
  14. *          champs de precontraintes si presents  ipchc1 ---> ipchc2
  15. *
  16. *             routine appelee par precop
  17. *======================================================================
  18.       IMPLICIT INTEGER(I-N)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCHAML
  23. -INC SMELEME
  24. -INC SMMODEL
  25. -INC CCHAMP
  26. -INC SMCOORD
  27.         segment icpr(3,nbpts)
  28.         segment iextr(0)
  29.       segment sielc
  30.       integer ideb(niz),ifin(niz),nbcz,isens(2,nbele),idejvu(nbele)
  31.       endsegment
  32. * stockage  depointeurs sur des segment sielc
  33.       segment siezo
  34.       integer iezon(nsous)
  35.       endsegment
  36. *
  37.         MMODEL = ipmodl
  38.         segact MMODEL
  39.         nsous = kmodel(/1)
  40.  
  41.         segini siezo
  42.         nbcabt=0
  43.         iz=1
  44. C=====
  45.         do 1000 isous=1,nsous
  46.         imodel= kmodel(isous)
  47.  
  48.         segact imodel
  49.         meleme = imamod
  50. *
  51.         segact meleme
  52.         nbele = num(/2)
  53.  
  54.         niz=50
  55.         segini sielc
  56.         iezon(isous)=sielc
  57. C
  58.         segini iextr
  59.         segini icpr
  60. C icpr(1,ip) contient le nombre d elements connectes au pt ip
  61. C icpr(2,ip) et (3,ip) les numeros des elements en question
  62.         do iel=1,num(/2)
  63.         do j=1,num(/1)
  64.         ip = num(j,iel)
  65.         icpr(1,ip) = icpr(1,ip)+1
  66.         if(icpr(1,ip).le.2) then
  67.         icpr(icpr(1,ip)+1,ip) =iel
  68.         else
  69. C   maillage incorrect  deux cables se coupent
  70.         segsup iextr,icpr,sielc,siezo
  71.         iret=0
  72.         call erreur(845)
  73.         return
  74.         endif
  75.         enddo
  76.         enddo
  77. C  tableau des extremites
  78.         do iel=1,num(/2)
  79.         do j=1,num(/1)
  80.         if(icpr(1,num(j,iel)).eq.1) iextr(**)= num(j,iel)
  81.         enddo
  82.         enddo
  83. C      write(6,*) (iextr(k),k=1,iextr(/1))
  84. C
  85. C   on fabrique de toute  facon   des objets temporaires
  86. C    ----- reorientation  et decoupages
  87. C   il y a plusieurs cables  dans le modele
  88. C   isens(1,n) numero du nieme element ordonne dans le maillage originel
  89. C   isens(2,n) son sens de parcours / par rapport au pt de depart
  90.         nbc =0
  91.         inel=0
  92.         ip1= iextr(1)
  93.         iextr(1)=0
  94. C
  95. 1999    continue
  96.  
  97.         nbc =nbc+1
  98.                 if (nbc.gt.niz) then
  99.                 niz = niz+50
  100.                 segadj sielc
  101.                 endif
  102.         inel=inel+1
  103.         iel=icpr(2,ip1)
  104.         idejvu(iel)=inel
  105.         isens(1,inel)=iel
  106.  
  107.         ideb(nbc)=inel
  108.         if(num(2,iel).eq.ip1) then
  109.         ip1=num(1,iel)
  110.         isens(2,inel)=2
  111.         else
  112.         ip1=num(2,iel)
  113.         isens(2,inel)=1
  114.         endif
  115. C ----  recherche suite des  elements
  116.         if(icpr(1,ip1).eq.1)  then
  117. C  petit rattrapage  pour fantaisie ( cables a 1 seul element )
  118.         i2= ip1
  119.         goto 2001
  120.         endif
  121. 1998    continue
  122.         do  2000 ik=2,3
  123.         iel=icpr(ik,ip1)
  124.                 if(idejvu(iel).ne.0) goto 2000
  125.                 if(num(1,iel).eq.ip1) then
  126.                 i2= num(2,iel)
  127.                 ise=1
  128.                 elseif(num(2,iel).eq.ip1) then
  129.                 i2= num(1,iel)
  130.                 ise=2
  131.                 endif
  132. C        write(6,*) 'iel ip1 num ',iel,ip1, num(1,iel),num(2,iel)
  133.         inel=inel+1
  134.         idejvu(iel)=inel
  135.         isens(1,inel)=iel
  136.         isens(2,inel)=ise
  137.         if(icpr(1,i2).eq.1)  goto 2001
  138.         ip1=i2
  139. 2000    continue
  140.         goto 1998
  141. 2001    continue
  142.         ifin(nbc)=inel
  143. C        write(6,*) ' fin  de  la partition '
  144. C        write(6,*) nbc,ideb(nbc),ifin(nbc)
  145. C recherche d un nouveau depart
  146.         do  ik=1,iextr(/1)
  147.         if(iextr(ik).eq.i2) iextr(ik)=0
  148.         enddo
  149.         do  ik=1,iextr(/1)
  150.         if(iextr(ik).ne.0) then
  151.         ip1 =iextr(ik)
  152.         iextr(ik)=0
  153.         goto 1999
  154.         endif
  155.         enddo
  156. C fin du traitement des cables elementaires
  157. C       endif
  158.        nbcz=nbc
  159. C       write(6,*) ' nombre de cables  crees ' ,nbc,nbcz
  160.        segdes sielc
  161.        segsup icpr,iextr
  162.         nbcabt=nbcabt+nbc
  163. 1000    continue
  164.  
  165.  
  166. 4444    format(10I4)
  167. C========
  168. *
  169. * MCHELM   caracteristiques     MCHEL2 caract   splitees
  170. * MCHEL3   contraintes init     MCHEL4 cont int splitees
  171. *
  172. *  le champ de caracteristiques
  173.         n1=nbcabt
  174.         n3=6
  175.         MCHELM = ipcara
  176.         segact  MCHELM
  177.         L1=titche(/1)
  178.         segini,MMODE2,MCHEL2
  179.         mchel2.ifoche=ifoche
  180.         mchel2.titche=titche
  181.         ipmod2= mmode2
  182.         ipcar2= mchel2
  183. C
  184.         if(ipchc1.ne.0) then
  185.         MCHEL3 =ipchc1
  186.         SEGACT MCHEL3
  187.         L1=MCHEL3.titche(/1)
  188.         segini MCHEL4
  189.         ipchc2=MCHEL4
  190.         mchel4.titche=mchel3.titche
  191.         mchel4.ifoche=mchel3.ifoche
  192.         else
  193.         ipchc2 =0
  194.         endif
  195. C
  196.         mn3=infmod(/1)
  197.         nfor=formod(/2)
  198.         nmat=matmod(/2)
  199.         nparmo=0
  200. C
  201.         idmod=0
  202.         do 2100 isous=1,nsous
  203.         imodel = kmodel(isous)
  204.         mchaml=ichaml(isous)
  205.         segact imodel,mchaml
  206.         meleme = imamod
  207.         sielc=iezon(isous)
  208.         segact sielc
  209. C=======
  210.         do 2150 ibc = 1,nbcz
  211.         idmod=idmod+1
  212.         NBSOUS=0
  213.         NBREF=0
  214.         NBNN=2
  215.         NBELEM=ifin(ibc)-ideb(ibc)+1
  216. C   le meleme
  217.         segini ipt1
  218.         ipt1.itypel=2
  219.         iii = 0
  220.         do inel=ideb(ibc),ifin(ibc)
  221.         iel=isens(1,inel)
  222.         iii = iii+1
  223.                 if(isens(2,inel).eq.1) then
  224.                 do ip=1,2
  225.                 ipt1.num(ip,iii)=num(ip,iel)
  226.                 enddo
  227.                 else
  228.                 do ip=1,2
  229.                 ipt1.num(ip,iii)=num(3-ip,iel)
  230.                 enddo
  231.                 endif
  232.         enddo
  233. C-------------
  234. C        call ecmail(ipt1)
  235.          nobmod=0
  236.         segini imode2
  237.         mmode2.kmodel(idmod) = imode2
  238. C
  239. C  le modele
  240. C
  241.         imode2.imamod = ipt1
  242.         imode2.nefmod=nefmod
  243.         imode2.conmod=conmod
  244.         do i=1,infmod(/1)
  245.         imode2.infmod(i)=infmod(i)
  246.         enddo
  247.         do i=1,nfor
  248.         imode2.formod(i) = formod(i)
  249.         enddo
  250.         do i=1,nmat
  251.         imode2.matmod(i)=matmod(i)
  252.         enddo
  253. C
  254. C -------  les caracteristiques
  255. C
  256.         mchel2.conche(idmod)= conche(isous)
  257.         mchel2.imache(idmod)= ipt1
  258.  
  259. C ------- on a seulement besoin  de 'YOUN' et 'SECT'
  260.         n2=2
  261.         segini mcham2
  262.         mchel2.ichaml(idmod)= mcham2
  263. C
  264.         do i=1,n3
  265.         mchel2.infche(idmod,i)=infche(isous,i)
  266.         enddo
  267. C
  268.         N1EL= NBELEM
  269.         N2EL= 0
  270.         N2PTEL= 0
  271. C       ipos=0
  272.         do ic=1,ielval(/1)
  273.         ipos=1
  274.         if (nomche(ic).eq.'YOUN'.or.nomche(ic).eq.'SECT'.
  275.      .      or.nomche(ic).eq.'FF  '.or.nomche(ic).eq.'PHIF') then
  276.         if (nomche(ic).eq.'SECT'.or.nomche(ic).eq.'PHIF') ipos=2
  277.  
  278.         melval=mchaml.ielval(ic)
  279.         segact melval
  280.         N1PTEL= velche(/1)
  281.         if(velche(/2).eq.1) N1EL=1
  282.         segini melva2
  283.         mcham2.ielval(ipos)= melva2
  284.         mcham2.nomche(ipos)=nomche(ic)
  285.         mcham2.typche(ipos)=typche(ic)
  286.  
  287.         if(velche(/1).eq.1.and.velche(/2).eq.1) then
  288.         melva2.velche(1,1)=velche(1,1)
  289.         else
  290.         iii=0
  291.         do inel=ideb(ibc),ifin(ibc)
  292.         iii=iii+1
  293.         iel=isens(1,inel)
  294.             if(isens(2,inel).eq.1) then
  295.                 do ip=1,velche(/1)
  296.                 melva2.velche(ip,iii) = velche(ip,iel)
  297.                 enddo
  298.             else
  299.                 id=2
  300.                 if(velche(/1).eq.2) id=3
  301.                 do ip=1,velche(/1)
  302.                 melva2.velche(ip,iii) = velche(id-ip,iel)
  303.                 enddo
  304.             endif
  305.         enddo
  306.         endif
  307.         endif
  308.         enddo
  309. C
  310. C   les  precontraintes
  311. C
  312.         if(ipchc1.ne.0) then
  313. C       mchel4.titche=mchel3.titche
  314. C       mchel4.ifoche=mchel3.ifoche
  315.         mchel4.imache(idmod)= ipt1
  316.         mcham3=mchel3.ichaml(isous)
  317.         mchel4.conche(idmod)= mchel3.conche(isous)
  318.         do i=1,n3
  319.         mchel4.infche(idmod,i)=mchel3.infche(isous,i)
  320.         enddo
  321. C
  322.         segact mcham3
  323.         n2=mcham3.ielval(/1)
  324.         segini mcham4
  325.         mchel4.ichaml(idmod)= mcham4
  326. C
  327.         N1EL= NBELEM
  328.         N2EL= 0
  329.         N2PTEL= 0
  330. C
  331.         do ic=1,n2
  332.         mcham4.nomche(ic)=mcham3.nomche(ic)
  333.         mcham4.typche(ic)=mcham3.typche(ic)
  334.         melval = mcham3.ielval(ic)
  335.         segact melval
  336.         N1PTEL= velche(/1)
  337.         if(velche(/2).eq.1) N1EL=1
  338.         segini melva4
  339.         mcham4.ielval(ic)=melva4
  340. C
  341.         if(velche(/1).eq.1.and.velche(/2).eq.1) then
  342.         melva4.velche(1,1)=velche(1,1)
  343.         else
  344.         iii=0
  345.         do inel=ideb(ibc),ifin(ibc)
  346.         iel=isens(1,inel)
  347.         iii=iii+1
  348.             if(isens(2,inel).eq.1) then
  349.                 do ip=1,velche(/1)
  350.                 melva4.velche(ip,iii) = velche(ip,iel)
  351.                 enddo
  352.             else
  353.                 do ip=1,velche(/1)
  354.                 melva4.velche(ip,iii) = velche(3-ip,iel)
  355.                 enddo
  356.             endif
  357.         enddo
  358.         endif
  359.         enddo
  360.         endif
  361. C
  362. 2150    continue
  363. 2100    continue
  364.         end
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  

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