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    FANDEUR   22/01/19    21:15:17     11256          
  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.         interr(1)=mchpo2.ifopoi
  51.         interr(2)=ri4.iforig
  52.         interr(3)=ifour
  53. c-dbg      write(ioimp,*) '1132 transr',mchpo2,ri4
  54.         call erreur(1132)
  55.         mchpo1.ifopoi=ifour
  56.       end if
  57.       mchpo1.jattri(1)=2
  58.       if (ri4.irigel(/1).lt.8) return
  59.       do 100 irig=1,ri4.irigel(/2)
  60.          if (ri4.irigel(8,irig).ne.0) then
  61.             descr=ri4.irigel(3,irig)
  62.             meleme=ri4.irigel(1,irig)
  63.             Xmatri=ri4.irigel(4,irig)
  64.             segact descr,meleme,Xmatri
  65.             do 110 iligrp=1,lisinc(/2)
  66.                if (lisinc(iligrp).eq.'LX  ') goto 120
  67.  110        continue
  68.             goto 100
  69.  120        continue
  70.             segact meleme
  71. *  on a un lx a transferer
  72.             nsoupo=nsoupo+1
  73.             segadj mchpo1
  74.             nc=1
  75.             segini msoupo
  76.             n=num(/2)
  77.             nbnn=1
  78.             nbelem=n
  79.             nbref=0
  80.             nbsous=0
  81.             segini ipt1
  82.             ipt1.itypel=1
  83.             igeoc=ipt1
  84.             nocomp(1)=lisinc(2)
  85.             noharm(1)=ri4.irigel(5,irig)
  86.             mchpo1.ipchp(nsoupo)=msoupo
  87.             segini mpoval
  88.             ipoval=mpoval
  89.             do 130 i=1,n
  90.                ip=num(noelep(2),i)
  91.                ipt1.num(1,i)=ip
  92.                ip1=num(noelep(1),i)
  93.                vpocha(i,1)=val(ip1)/(re(1,2,i)*ri4.coerig(irig))
  94.  130        continue
  95.             segdes descr,meleme,xmatri
  96.          endif
  97.  100  continue
  98.       segsup trav
  99. *  toilettage de mchpo1
  100.       call elchpo(mchpo1,iratt)
  101.       end
  102.  
  103.  
  104.  

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