Télécharger la plaquette Cast3M


fr en

Télécharger transr.eso

Retour à la liste

Numérotation des lignes : 

transr

  1. C TRANSR    SOURCE    GOUNAND   25/05/05    21:15:09     12259          
  2. *  transfert des valeurs imposées dans le second membre (elimination de lignes)
  3. *
  4.       subroutine transr(mchpo2,ri4,mchpo1)
  5. *
  6. *     mchpo2 : entree = second membre complet
  7. *     ri4 : entree = matrice de relation
  8. *     mchpo1 : sortie = increment du second membre
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11. *  pour le moment en cas de mode de fourier on suppose qu'il n'y en
  12. *  n'a qu'un
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMCHPOI
  16. -INC SMRIGID
  17. -INC SMCOORD
  18. -INC SMELEME
  19.       segment trav
  20.         real*8 val(nbnn)
  21.       endsegment
  22. *  exploser les flx
  23.       nbnn=nbpts
  24.       segini trav
  25.       segact mchpo2
  26.       do 10 isoupo=1,mchpo2.ipchp(/1)
  27.          msoupo=mchpo2.ipchp(isoupo)
  28.          segact msoupo
  29.          meleme=igeoc
  30.          segact meleme
  31.          do 20 ic=1,nocomp(/2)
  32.             if (nocomp(ic).eq.'FLX ') goto 30
  33.  20      continue
  34.          goto 10
  35.  30      continue
  36.          mpoval=ipoval
  37.          segact mpoval
  38.          do 40 in=1,num(/2)
  39.             val(num(1,in))=vpocha(in,ic)
  40.  40      continue
  41.  10   continue
  42. *  on balaye les raideurs de dependances, on remplit le chpoin cible
  43.       segact ri4
  44.       nat=2
  45.       nsoupo=0
  46.       segini mchpo1
  47.       mchpo1.mochde='créé par transr'
  48.       mchpo1.ifopoi=mchpo2.ifopoi
  49.       if (mchpo2.ifopoi .ne. ri4.iforig) then
  50.         moterr(1:8)='CHPO-RIG'
  51.         interr(1)=mchpo2.ifopoi
  52.         interr(2)=ri4.iforig
  53.         interr(3)=ifour
  54. c-dbg      write(ioimp,*) '1132 transr',mchpo2,ri4
  55.         call erreur(1132)
  56.         mchpo1.ifopoi=ifour
  57.       end if
  58.       mchpo1.jattri(1)=2
  59.       if (ri4.irigel(/1).lt.8) return
  60.       do 100 irig=1,ri4.irigel(/2)
  61.          if (ri4.irigel(8,irig).ne.0) then
  62.             descr=ri4.irigel(3,irig)
  63.             meleme=ri4.irigel(1,irig)
  64.             Xmatri=ri4.irigel(4,irig)
  65.             segact descr,meleme,Xmatri
  66.             do 110 iligrp=1,lisinc(/2)
  67.                if (lisinc(iligrp).eq.'LX  ') goto 120
  68.  110        continue
  69.             goto 100
  70.  120        continue
  71.             segact meleme
  72. *  on a un lx a transferer
  73.             nsoupo=nsoupo+1
  74.             segadj mchpo1
  75.             nc=1
  76.             segini msoupo
  77.             n=num(/2)
  78.             nbnn=1
  79.             nbelem=n
  80.             nbref=0
  81.             nbsous=0
  82.             segini ipt1
  83.             ipt1.itypel=1
  84.             igeoc=ipt1
  85.             nocomp(1)=lisinc(2)
  86.             noharm(1)=ri4.irigel(5,irig)
  87.             mchpo1.ipchp(nsoupo)=msoupo
  88.             segini mpoval
  89.             ipoval=mpoval
  90.             do 130 i=1,n
  91.                ip=num(noelep(2),i)
  92.                ipt1.num(1,i)=ip
  93.                ip1=num(noelep(1),i)
  94.                vpocha(i,1)=val(ip1)/(re(1,2,i)*ri4.coerig(irig))
  95.  130        continue
  96.             segdes descr,meleme,xmatri
  97.          endif
  98.  100  continue
  99.       segsup trav
  100. *  toilettage de mchpo1
  101.       call elchpo(mchpo1,iratt)
  102.       end
  103.  
  104.  

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