Esope source files

   1 : C TRANSR    SOURCE    CHAT      09/10/09    21:25:37     6519           
   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 SMCHPOI
  14 : -INC SMRIGID
  15 : -INC CCOPTIO
  16 : -INC SMCOORD
  17 : -INC SMELEME
  18 :       segment trav
  19 :        real*8 val(nbnn)
  20 :       endsegment
  21 : *  exploser les flx
  22 :       nbnn=xcoor(/1)/(idim+1)
  23 :       segini trav
  24 :       segact mchpo2
  25 :       do 10 isoupo=1,mchpo2.ipchp(/1)
  26 :         msoupo=mchpo2.ipchp(isoupo)
  27 :         segact msoupo
  28 :         meleme=igeoc
  29 :         segact meleme
  30 :         do 20 ic=1,nocomp(/2)
  31 :           if (nocomp(ic).eq.'FLX ') goto 30
  32 :   20    continue
  33 :         goto 10
  34 :   30    continue
  35 :         mpoval=ipoval
  36 :         segact mpoval
  37 :         do 40 in=1,num(/2)
  38 :          val(num(1,in))=vpocha(in,ic)
  39 :   40    continue
  40 :   10  continue
  41 : *  on balaye les raideurs de dependances, on remplit le chpoin cible
  42 :       segact ri4
  43 :       nat=2
  44 :       nsoupo=0
  45 :       segini mchpo1
  46 :        mchpo1.mochde='créé par transr'
  47 :        mchpo1.ifopoi=mchpo2.ifopoi
  48 :        mchpo1.jattri(1)=2
  49 :       if (ri4.irigel(/1).lt.8) return
  50 :       do 100 irig=1,ri4.irigel(/2)
  51 :        if (ri4.irigel(8,irig).ne.0) then
  52 :          descr=ri4.irigel(3,irig)
  53 :          meleme=ri4.irigel(1,irig)
  54 :          Xmatri=ri4.irigel(4,irig)
  55 :          segact descr,meleme,Xmatri
  56 :          do 110 iligrp=1,lisinc(/2)
  57 :            if (lisinc(iligrp).eq.'LX  ') goto 120
  58 :  110     continue
  59 :          goto 100
  60 :  120     continue
  61 :          segact meleme
  62 : *  on a un lx a transferer
  63 :          nsoupo=nsoupo+1
  64 :          segadj mchpo1
  65 :          nc=1
  66 :          segini msoupo
  67 :          n=num(/2)
  68 :          nbnn=1
  69 :          nbelem=n
  70 :          nbref=0
  71 :          nbsous=0
  72 :          segini ipt1
  73 :          ipt1.itypel=1
  74 :          igeoc=ipt1
  75 :          nocomp(1)=lisinc(2)
  76 :          noharm(1)=ri4.irigel(5,irig)
  77 :          mchpo1.ipchp(nsoupo)=msoupo
  78 :          segini mpoval
  79 :          ipoval=mpoval
  80 :          do 130 i=1,n
  81 : *          xmatri=imattt(i)
  82 :           segact xmatri
  83 :           ip=num(noelep(2),i)
  84 :           ipt1.num(1,i)=ip
  85 :           ip1=num(noelep(1),i)
  86 :           vpocha(i,1)=val(ip1)/(re(1,2,i)*ri4.coerig(irig))
  87 : *          segdes xmatri
  88 :  130     continue
  89 :          segdes descr,meleme,xmatri
  90 :        endif
  91 :  100   continue
  92 :          segsup trav
  93 : *  toilettage de mchpo1
  93 :          call elchpo(mchpo1,iratt)
  94 :          end
  95 :  
  96 :