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    FANDEUR   22/03/01    21:15:01     11301          
  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.               interr(1)=mchpoi.ifopoi
  115.               interr(2)=ifochs
  116.               interr(3)=ifour
  117. c-dbg              write(ioimp,*) '1132 chatab',ikk,mchpoi
  118.               call erreur(1132)
  119.               ifochs=ifour
  120.             endif
  121.             do ipc=1,ipchp(/1)
  122.               msoupo=ipchp(ipc)
  123.               segact msoupo
  124.               do nc=1,nocomp(/2)
  125.                 do nomb=1,nnin
  126.                   if( nocomp(nc).eq.noinc(nomb)) go to 1
  127.                 enddo
  128.                 nnin=nnin+1
  129.                 if( nnin.gt.ml) then
  130.                   ml= ml+100
  131.                   segadj nominc
  132.                 endif
  133.                 noinc(nnin)=nocomp(nc)
  134.                 noh(nnin)=noharm(nc)
  135.     1           continue
  136.               enddo
  137.             enddo
  138.           endif
  139.         endif
  140.       enddo
  141. *
  142. *  on fabrique la liste des temps
  143. *
  144.       ml = 500
  145.       segini mtempo
  146.       segini iliste
  147.       mlree3=0
  148.       do ikk=1,ik
  149.         if(chanom(ikk).eq.moty)then
  150.           icharg=kcharg(ikk)
  151.           if(chatyp.eq.'CHPOINT ') then
  152.             mlree1=ichpo2
  153.             do ikkm1= 1,ikk-1
  154.               if( listem(ikkm1) . eq . mlree1) go to 2
  155.             enddo
  156.             listem(ikk)=mlree1
  157.             if(mlree3.eq.0) then
  158.               segini,mlree3=mlree1
  159.             else
  160.               segact mlree1
  161.               jg1=mlree1.prog(/1)
  162.               jg3=mlree3.prog(/1)
  163.               jg= mlree1.prog(/1)+mlree3.prog(/1)
  164.               segini mlree2
  165.               i3=1
  166.               i1=1
  167.               i2=1
  168.     3         continue
  169.               if( mlree1.prog(I1).le.mlree3.prog(i3))then
  170.                 mlree2.prog(i2)=mlree1.prog(I1)
  171.                 i2=i2+1
  172.                 if( mlree3.prog(i3).eq.mlree1.prog(I1)) i3 = i3 +1
  173.                 i1=i1+1
  174.               else
  175.                 mlree2.prog(i2)=mlree3.prog(I3)
  176.                 i2=i2+1
  177.                 i3=i3+1
  178.               endif
  179.               if(i1+i3.le.jg1+jg3)then
  180.                 if( i1.gt. jg1) then
  181.                   i2=i2-1
  182.                   i3=i3-1
  183.                   do ifi=1,jg3-i3
  184.                     mlree2.prog(i2+ifi)=mlree3.prog(i3+ifi)
  185.                   enddo
  186.                   i2=I2+jg3-i3
  187.                 elseif (i3.gt.jg3) then
  188.                   i2=i2-1
  189.                   i1=i1-1
  190.                   do ifi=1,jg1-i1
  191.                     mlree2.prog(i2+ifi)=mlree1.prog(i1+ifi)
  192.                   enddo
  193.                   i2=I2+jg1-i1
  194.                 else
  195.                   go to 3
  196.                 endif
  197.               endif
  198.               jg=i2-1
  199.               segsup mlree3
  200.               segadj mlree2
  201.               mlree3=mlree2
  202.               segdes mlree1
  203.             endif
  204.           endif
  205.         endif
  206.     2   continue
  207.       enddo
  208.  
  209.       ntem=mlree3.prog(/1)
  210.       xmax= mlree3.prog(ntem)
  211.       xprec= xmax /ntem * 1.d-4
  212. *
  213. * on fabrique la liste des points concernés
  214. *
  215.       segini icpr
  216.       nnnoe=0
  217.       do ikk=1,ik
  218.         if(chanom(ikk).eq.moty)then
  219.           icharg=kcharg(ikk)
  220.           if(chatyp.eq.'CHPOINT ') then
  221.             mchpoi=ichpo1
  222.             do ipc=1,ipchp(/1)
  223.               msoupo=ipchp(ipc)
  224.               meleme=igeoc
  225.               segact meleme
  226.               do iel=1,num(/2)
  227.                 ip=num(1,iel)
  228.                 if(icpr(ip).eq.0) then
  229.                   nnnoe=nnnoe+1
  230.                   icpr(ip)=nnnoe
  231.                 endif
  232.               enddo
  233.             enddo
  234.           endif
  235.         endif
  236.       enddo
  237.       nbnn=1
  238.       nbelem=nnnoe
  239.       nbsous=0
  240.       nbref=0
  241.       segini ipt4
  242.       ipt4.itypel=1
  243.       do ip=1,icpr(/1)
  244.         if(icpr(ip).ne.0) then
  245.           ipt4.num(1,icpr(ip))=ip
  246.         endif
  247.       enddo
  248.       segdes ipt4
  249. *
  250. *  on cree le segment mtrav et on cree le segment contenant tous les
  251. * ntem chpoints
  252. *
  253. *      write(6,*)'ntem nnin nnnoe  tot ',ntem,nnin,nnnoe,ntem*nnin*nnnoe
  254.       segini mtrav
  255.       segini mbbb
  256. *
  257. *     on remplit les tableaux bbb en prenant chargement par chargement
  258. *
  259.       segini ipass
  260.       jg3=mlree3.prog(/1)
  261.       do ikk=1,ik
  262.         if(chanom(ikk).eq.moty)then
  263.           icharg=kcharg(ikk)
  264.           if(chatyp.eq.'CHPOINT ') then
  265. *          write(6,*) ' traitement du chargement numero ',ikk
  266.             mchpoi=ichpo1
  267.             mlree1=ichpo2
  268.             mlree4=ichpo3
  269.             segact mlree4
  270.             segact mlree1
  271.             jg1=mlree1.prog(/1)
  272.             do ipc=1,ipchp(/1)
  273.               msoupo=ipchp(ipc)
  274.               meleme=igeoc
  275.               segact meleme
  276.               mpoval=ipoval
  277.               segact mpoval
  278. * on cherche la correspondance nocomp -> noinc
  279.               do ipu=1,nocomp(/2)
  280.                 do jpu=1,nnin
  281.                   if( nocomp(ipu).eq.noinc(jpu)) then
  282.                     ipass (ipu)=jpu
  283.                     go to 5
  284.                   endif
  285.                 enddo
  286.     5           continue
  287.               enddo
  288. *  on boucle sur les temps
  289.               I1=1
  290.               i3=1
  291.     6         continue
  292.               if( mlree3.prog(i3).lt.mlree1.prog(i1)) then
  293.                 if( i1.eq.1) then
  294.                   coe = mlree4.prog(1)
  295.                 else
  296.                   coe = mlree4.prog(i1-1) +
  297.      $            (mlree3.prog(i3) -mlree1.prog(i1-1))/
  298.      $            (mlree1.prog(i1) -mlree1.prog(i1-1))*
  299.      $            (mlree4.prog(i1)-mlree4.prog(i1-1))
  300.                 endif
  301.               elseif (mlree3.prog(i3).eq.mlree1.prog(i1)) then
  302.                   coe =  mlree4.prog(i1)
  303.                   i1=I1+1
  304.               else
  305.                 if(i1.eq.jg1) then
  306.                   coe = mlree4.prog(i1)
  307.                 else
  308.                   i1=i1+1
  309.                   go to 6
  310.                 endif
  311.               endif
  312.               do ipp=1,vpocha(/1)
  313.                 ie=icpr(num(1,ipp))
  314.                 do inn=1,vpocha(/2)
  315.                   icomp=ipass(inn)
  316.                   bbb(i3,icomp,ie)=bbb(i3,icomp,ie)+vpocha(ipp,inn)*coe
  317.                 enddo
  318.               enddo
  319.               i3=i3+1
  320.               if(i3.le.jg3) go to 6
  321.               segdes mpoval,meleme
  322.             enddo
  323.             segdes mlree1,mlree4,icharg
  324.           endif
  325.         endif
  326.  
  327.       enddo
  328. *
  329. * il faut creer le chargement de type table
  330. *
  331.       nc=nnin
  332.       n=nnnoe
  333.       m=ntem
  334.       segini mtab1,mtab2
  335.       mtab1.mlotab=ntem
  336.       mtab2.mlotab=ntem
  337.       do i=1,ntem
  338.         mtab1.mtabti(i)='ENTIER'
  339.         mtab1.mtabii(i)=i-1
  340.         mtab1.mtabtv(i)='CHPOINT '
  341.         mtab2.mtabti(i)='ENTIER'
  342.         mtab2.mtabii(i)=i-1
  343.         mtab2.mtabtv(i)='FLOTTANT'
  344.         mtab2.rmtabv(i)=mlree3.prog(i)
  345.         nsoupo=1
  346.         nat=1
  347.         segini mchpoi
  348.         mtab1.mtabiv(i)=mchpoi
  349.         mochde='      '
  350.         mtypoi='FORCES'
  351.         ifopoi=ifochs
  352.         jattri(1)=2
  353.         segini msoupo
  354.         ipchp(1)=msoupo
  355.         igeoc=ipt4
  356.         segini mpoval
  357.         ipoval=mpoval
  358.         do io=1,nnin
  359.           nocomp(io)=noinc(io)
  360.           noharm(io)=noh(io)
  361.         enddo
  362.         do ip=1,nc
  363.           do io=1,n
  364.             vpocha(io,ip) = bbb(i,ip,io)
  365.           enddo
  366.         enddo
  367.         segdes mpoval
  368.         segdes msoupo
  369.         segdes mchpoi
  370.       enddo
  371.       segdes mtab1,mtab2
  372.       segdes mlree3
  373.       segini icharg
  374.       mchar1.kcharg(ipl)=icharg
  375.       mchar1.chanat(ipl)='FORCE'
  376.       mchar1.CHANOM(ipl)=CHANOM(iprem)
  377.       mchar1.CHAMOB(ipl)=CHAMOB(iprem)
  378.       mchar1.CHALIE(ipl)=CHALIE(iprem)
  379.       CHATYP='TABLE   '
  380.       ichpo1=mtab2
  381.       ichpo2=mtab1
  382.       segdes icharg
  383.       segdes mchar1,mcharg
  384.       call ecrobj('CHARGEME',mchar1)
  385.  
  386. c      return
  387.       end
  388.  
  389.  
  390.  

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