Télécharger la plaquette Cast3M


fr en

Télécharger chatab.eso

Retour à la liste

Numérotation des lignes : 

chatab

  1. C CHATAB    SOURCE    GOUNAND   25/05/05    21:15:02     12259          
  2.       subroutine chatab
  3.       implicit real*8(a-h,o-z)
  4.       implicit integer (i-n)
  5. *
  6. *  ce sous programme permet de changer fabriquer un chargement
  7. *  defini par deux tables pour le type demandé. ou pour tous les types.
  8. *  il ne travaille que sur les chpoints.
  9. *
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMCHARG
  14. -INC SMCOORD
  15. -INC SMCHPOI
  16. -INC TMTRAV
  17. -INC SMELEME
  18. -INC SMLREEL
  19. -INC SMTABLE
  20.        segment nominc
  21.          character*(LOCOMP) noinc(ml)
  22.          integer noh(ml)
  23.        endsegment
  24.        segment mtempo
  25.           real*8 tempo(ml)
  26.        endsegment
  27.        segment iliste
  28.           integer listem (ibon)
  29.        endsegment
  30.        segment mbbb
  31.          real*8 bbb(ntem,nnin,nnnoe)
  32.        endsegment
  33.        pointeur mlree4.mlreel
  34.        segment ipass(nnin)
  35. *
  36.       segment icpr(nbpts)
  37.       character*4 moty
  38.       call lirobj ('CHARGEME',mcharg,1,iretou)
  39.       if(ierr.ne.0) return
  40.       moty='    '
  41.       call lircha(moty,0,ilong)
  42.       segact mcharg
  43.       ik= kcharg(/1)
  44. *
  45. *     on verifie que le type de chargement demandé existe
  46. *
  47.       ibon=0
  48.       do ikk=1,ik
  49.         if(chanom(ikk).eq.moty) ibon=ibon+1
  50.       enddo
  51.       if(ibon.eq.0) then
  52.         call erreur(19)
  53.         return
  54.       endif
  55. *
  56. *     on verifie que les chargements concernés ont des objets chpoint
  57. *
  58.       ibon=0
  59.       iprem=0
  60.       do ikk=1,ik
  61.         if(chanom(ikk).eq.moty)then
  62.           icharg=kcharg(ikk)
  63.           segact icharg
  64.           if(chatyp.eq.'CHPOINT ') then
  65.               ibon=ibon+1
  66.               if(iprem.eq.0) iprem=ikk
  67.           endif
  68.          endif
  69.       enddo
  70.       if(ibon.eq.0) then
  71.         call erreur(19)
  72.         return
  73.       endif
  74. *
  75. *     on duplique l'objet en sautant ceux qui vont etre transformés
  76. *
  77.       N= ik - ibon + 1
  78.       segini mchar1
  79.       ipl=1
  80.       do ikk=1,N
  81.         if(chanom(ikk).eq.moty)then
  82.           icharg=kcharg(ikk)
  83.           if(chatyp.ne.'CHPOINT ') then
  84.              mchar1.kcharg(ipl)=kcharg(ikk)
  85.              mchar1.CHANAT(ipl)=CHANAT(ikk)
  86.              mchar1.CHANOM(ipl)=CHANOM(ikk)
  87.              mchar1.CHAMOB(ipl)=CHAMOB(ikk)
  88.              mchar1.CHALIE(ipl)=CHALIE(ikk)
  89.              ipl=ipl+1
  90.           endif
  91.         endif
  92.       enddo
  93. *
  94. *   debut du travail
  95. *
  96. * on fabrique la liste des inconnues
  97. *
  98.       i1fois = 0
  99.       ifochs = -99
  100.       ml=100
  101.       segini nominc
  102.       nnin=0
  103.       do ikk=1,ik
  104.         if(chanom(ikk).eq.moty)then
  105.           icharg=kcharg(ikk)
  106.           if(chatyp.eq.'CHPOINT ') then
  107.             mchpoi=ichpo1
  108.             segact mchpoi
  109.             if (i1fois.eq.0) then
  110.               i1fois = 1
  111.               ifochs = mchpoi.ifopoi
  112.             endif
  113.             if (mchpoi.ifopoi .ne. ifochs) then
  114.                moterr(1:8)='CHPOINT'
  115.               interr(1)=mchpoi.ifopoi
  116.               interr(2)=ifochs
  117.               interr(3)=ifour
  118. c-dbg              write(ioimp,*) '1132 chatab',ikk,mchpoi
  119.               call erreur(1132)
  120.               ifochs=ifour
  121.             endif
  122.             do ipc=1,ipchp(/1)
  123.               msoupo=ipchp(ipc)
  124.               segact msoupo
  125.               do nc=1,nocomp(/2)
  126.                 do nomb=1,nnin
  127.                   if( nocomp(nc).eq.noinc(nomb)) go to 1
  128.                 enddo
  129.                 nnin=nnin+1
  130.                 if( nnin.gt.ml) then
  131.                   ml= ml+100
  132.                   segadj nominc
  133.                 endif
  134.                 noinc(nnin)=nocomp(nc)
  135.                 noh(nnin)=noharm(nc)
  136.     1           continue
  137.               enddo
  138.             enddo
  139.           endif
  140.         endif
  141.       enddo
  142. *
  143. *  on fabrique la liste des temps
  144. *
  145.       ml = 500
  146.       segini mtempo
  147.       segini iliste
  148.       mlree3=0
  149.       do ikk=1,ik
  150.         if(chanom(ikk).eq.moty)then
  151.           icharg=kcharg(ikk)
  152.           if(chatyp.eq.'CHPOINT ') then
  153.             mlree1=ichpo2
  154.             do ikkm1= 1,ikk-1
  155.               if( listem(ikkm1) . eq . mlree1) go to 2
  156.             enddo
  157.             listem(ikk)=mlree1
  158.             if(mlree3.eq.0) then
  159.               segini,mlree3=mlree1
  160.             else
  161.               segact mlree1
  162.               jg1=mlree1.prog(/1)
  163.               jg3=mlree3.prog(/1)
  164.               jg= mlree1.prog(/1)+mlree3.prog(/1)
  165.               segini mlree2
  166.               i3=1
  167.               i1=1
  168.               i2=1
  169.     3         continue
  170.               if( mlree1.prog(I1).le.mlree3.prog(i3))then
  171.                 mlree2.prog(i2)=mlree1.prog(I1)
  172.                 i2=i2+1
  173.                 if( mlree3.prog(i3).eq.mlree1.prog(I1)) i3 = i3 +1
  174.                 i1=i1+1
  175.               else
  176.                 mlree2.prog(i2)=mlree3.prog(I3)
  177.                 i2=i2+1
  178.                 i3=i3+1
  179.               endif
  180.               if(i1+i3.le.jg1+jg3)then
  181.                 if( i1.gt. jg1) then
  182.                   i2=i2-1
  183.                   i3=i3-1
  184.                   do ifi=1,jg3-i3
  185.                     mlree2.prog(i2+ifi)=mlree3.prog(i3+ifi)
  186.                   enddo
  187.                   i2=I2+jg3-i3
  188.                 elseif (i3.gt.jg3) then
  189.                   i2=i2-1
  190.                   i1=i1-1
  191.                   do ifi=1,jg1-i1
  192.                     mlree2.prog(i2+ifi)=mlree1.prog(i1+ifi)
  193.                   enddo
  194.                   i2=I2+jg1-i1
  195.                 else
  196.                   go to 3
  197.                 endif
  198.               endif
  199.               jg=i2-1
  200.               segsup mlree3
  201.               segadj mlree2
  202.               mlree3=mlree2
  203.               segdes mlree1
  204.             endif
  205.           endif
  206.         endif
  207.     2   continue
  208.       enddo
  209.  
  210.       ntem=mlree3.prog(/1)
  211.       xmax= mlree3.prog(ntem)
  212.       xprec= xmax /ntem * 1.d-4
  213. *
  214. * on fabrique la liste des points concernés
  215. *
  216.       segini icpr
  217.       nnnoe=0
  218.       do ikk=1,ik
  219.         if(chanom(ikk).eq.moty)then
  220.           icharg=kcharg(ikk)
  221.           if(chatyp.eq.'CHPOINT ') then
  222.             mchpoi=ichpo1
  223.             do ipc=1,ipchp(/1)
  224.               msoupo=ipchp(ipc)
  225.               meleme=igeoc
  226.               segact meleme
  227.               do iel=1,num(/2)
  228.                 ip=num(1,iel)
  229.                 if(icpr(ip).eq.0) then
  230.                   nnnoe=nnnoe+1
  231.                   icpr(ip)=nnnoe
  232.                 endif
  233.               enddo
  234.             enddo
  235.           endif
  236.         endif
  237.       enddo
  238.       nbnn=1
  239.       nbelem=nnnoe
  240.       nbsous=0
  241.       nbref=0
  242.       segini ipt4
  243.       ipt4.itypel=1
  244.       do ip=1,icpr(/1)
  245.         if(icpr(ip).ne.0) then
  246.           ipt4.num(1,icpr(ip))=ip
  247.         endif
  248.       enddo
  249.       segdes ipt4
  250. *
  251. *  on cree le segment mtrav et on cree le segment contenant tous les
  252. * ntem chpoints
  253. *
  254. *      write(6,*)'ntem nnin nnnoe  tot ',ntem,nnin,nnnoe,ntem*nnin*nnnoe
  255.       segini mtrav
  256.       segini mbbb
  257. *
  258. *     on remplit les tableaux bbb en prenant chargement par chargement
  259. *
  260.       segini ipass
  261.       jg3=mlree3.prog(/1)
  262.       do ikk=1,ik
  263.         if(chanom(ikk).eq.moty)then
  264.           icharg=kcharg(ikk)
  265.           if(chatyp.eq.'CHPOINT ') then
  266. *          write(6,*) ' traitement du chargement numero ',ikk
  267.             mchpoi=ichpo1
  268.             mlree1=ichpo2
  269.             mlree4=ichpo3
  270.             segact mlree4
  271.             segact mlree1
  272.             jg1=mlree1.prog(/1)
  273.             do ipc=1,ipchp(/1)
  274.               msoupo=ipchp(ipc)
  275.               meleme=igeoc
  276.               segact meleme
  277.               mpoval=ipoval
  278.               segact mpoval
  279. * on cherche la correspondance nocomp -> noinc
  280.               do ipu=1,nocomp(/2)
  281.                 do jpu=1,nnin
  282.                   if( nocomp(ipu).eq.noinc(jpu)) then
  283.                     ipass (ipu)=jpu
  284.                     go to 5
  285.                   endif
  286.                 enddo
  287.     5           continue
  288.               enddo
  289. *  on boucle sur les temps
  290.               I1=1
  291.               i3=1
  292.     6         continue
  293.               if( mlree3.prog(i3).lt.mlree1.prog(i1)) then
  294.                 if( i1.eq.1) then
  295.                   coe = mlree4.prog(1)
  296.                 else
  297.                   coe = mlree4.prog(i1-1) +
  298.      $            (mlree3.prog(i3) -mlree1.prog(i1-1))/
  299.      $            (mlree1.prog(i1) -mlree1.prog(i1-1))*
  300.      $            (mlree4.prog(i1)-mlree4.prog(i1-1))
  301.                 endif
  302.               elseif (mlree3.prog(i3).eq.mlree1.prog(i1)) then
  303.                   coe =  mlree4.prog(i1)
  304.                   i1=I1+1
  305.               else
  306.                 if(i1.eq.jg1) then
  307.                   coe = mlree4.prog(i1)
  308.                 else
  309.                   i1=i1+1
  310.                   go to 6
  311.                 endif
  312.               endif
  313.               do ipp=1,vpocha(/1)
  314.                 ie=icpr(num(1,ipp))
  315.                 do inn=1,vpocha(/2)
  316.                   icomp=ipass(inn)
  317.                   bbb(i3,icomp,ie)=bbb(i3,icomp,ie)+vpocha(ipp,inn)*coe
  318.                 enddo
  319.               enddo
  320.               i3=i3+1
  321.               if(i3.le.jg3) go to 6
  322.               segdes mpoval,meleme
  323.             enddo
  324.             segdes mlree1,mlree4,icharg
  325.           endif
  326.         endif
  327.  
  328.       enddo
  329. *
  330. * il faut creer le chargement de type table
  331. *
  332.       nc=nnin
  333.       n=nnnoe
  334.       m=ntem
  335.       segini mtab1,mtab2
  336.       mtab1.mlotab=ntem
  337.       mtab2.mlotab=ntem
  338.       do i=1,ntem
  339.         mtab1.mtabti(i)='ENTIER'
  340.         mtab1.mtabii(i)=i-1
  341.         mtab1.mtabtv(i)='CHPOINT '
  342.         mtab2.mtabti(i)='ENTIER'
  343.         mtab2.mtabii(i)=i-1
  344.         mtab2.mtabtv(i)='FLOTTANT'
  345.         mtab2.rmtabv(i)=mlree3.prog(i)
  346.         nsoupo=1
  347.         nat=1
  348.         segini mchpoi
  349.         mtab1.mtabiv(i)=mchpoi
  350.         mochde='      '
  351.         mtypoi='FORCES'
  352.         ifopoi=ifochs
  353.         jattri(1)=2
  354.         segini msoupo
  355.         ipchp(1)=msoupo
  356.         igeoc=ipt4
  357.         segini mpoval
  358.         ipoval=mpoval
  359.         do io=1,nnin
  360.           nocomp(io)=noinc(io)
  361.           noharm(io)=noh(io)
  362.         enddo
  363.         do ip=1,nc
  364.           do io=1,n
  365.             vpocha(io,ip) = bbb(i,ip,io)
  366.           enddo
  367.         enddo
  368.         segdes mpoval
  369.         segdes msoupo
  370.         segdes mchpoi
  371.       enddo
  372.       segdes mtab1,mtab2
  373.       segdes mlree3
  374.       segini icharg
  375.       mchar1.kcharg(ipl)=icharg
  376.       mchar1.chanat(ipl)='FORCE'
  377.       mchar1.CHANOM(ipl)=CHANOM(iprem)
  378.       mchar1.CHAMOB(ipl)=CHAMOB(iprem)
  379.       mchar1.CHALIE(ipl)=CHALIE(iprem)
  380.       CHATYP='TABLE   '
  381.       ichpo1=mtab2
  382.       ichpo2=mtab1
  383.       segdes icharg
  384.       segdes mchar1,mcharg
  385.       call ecrobj('CHARGEME',mchar1)
  386.  
  387. c      return
  388.       end
  389.  
  390.  

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