Esope source files

   1 : C VERLX     SOURCE    CHAT      09/10/09    21:25:49     6519           
   2 : *  verification LX nuls
   3 : *
   4 :       subroutine verlx(mrigid,mchpoi,mchpo1,noen,ipt8)
   5 : *
   6 : *  verification que les LX apparaissant dand mrigid sont nuls
   7 : *  mcphpo1 sert a construire le critere en deplacemento
   8 : *
   9 :       implicit real*8 (a-h,o-z)
  10 : -INC CCOPTIO
  11 : -INC SMCHPOI
  12 : -INC SMRIGID
  13 : -INC SMELEME
  14 : -INC SMCOORD
  15 : -INC CCREEL
  16 :       segment vpoch(xcoor(/1)/(idim+1))
  17 :       nbnn=1
  18 :       nbsous=0 
  19 :       nbref=0
  20 :       xmcrit=xpetit
  21 :       segact mcoord
  22 :       segini vpoch
  23 : *  expension des LX du chpoint
  24 :       segact mchpoi
  25 :       do 10 isoupo=1,ipchp(/1)
  26 :        msoupo=ipchp(isoupo)
  27 :        segact msoupo
  28 :        if (nocomp(/2).ne.1) goto 10
  29 :        if (nocomp(1).ne.'FLX') goto 10
  30 :        mpoval=ipoval
  31 :        segact mpoval
  32 :        meleme=igeoc
  33 :        segact meleme
  34 :        do 15 i=1,vpocha(/1)
  35 :         vpoch(num(1,i))=vpocha(i,1)
  36 :         xmcrit=max(xmcrit,abs(vpocha(i,1)))
  37 :  15    continue
  38 :  10   continue
  39 : *  calcul du critere
  40 :       segact mchpo1
  41 :       do 50 isoupo=1,mchpo1.ipchp(/1)
  42 :        msoupo=mchpo1.ipchp(isoupo)
  43 :        segact msoupo
  44 : *      write (6,*) ' verlx nocomp(1) ',nocomp(1)
  45 :        if (nocomp(1).eq.'FLX') goto 50
  46 :        mpoval=ipoval
  47 :        segact mpoval
  48 :        do 55 i=1,vpocha(/1)
  49 :        do 55 j=1,vpocha(/2)
  50 :         xmcrit=max(xmcrit,abs(vpocha(i,j)))
  51 :  55    continue
  52 :  50   continue
  53 :       xmcrit=xmcrit*1d-6
  54 : *     write (6,*) ' xmcrit dans verlx ',xmcrit
  55 : *  balayer les matrices pour tester les LX y apparaissant
  56 :       segact mrigid
  57 :       do 100 irige=1,irigel(/2)
  58 :        meleme=irigel(1,irige)
  59 :        descr=irigel(3,irige)
  60 :        segact descr
  61 :        if (lisinc(1).ne.'LX') goto 100
  62 :        segact meleme
  63 :        do 110 iel=1,num(/2)
  64 :         if (abs(vpoch(num(1,iel))).gt.xmcrit) then
  65 :          if (noen.eq.0) then
  66 :              nbelem=ipt8.num(/2)+1
  67 :              segadj ipt8
  68 :              ipt8.num(1,nbelem)=num(1,iel)
  69 :          else
  70 :           interr(1)=num(1,iel)
  71 :           moterr(1:4)='LX'
  71 :           call erreur(143)
  72 :          endif
  73 :         else
  74 :           vpoch(num(1,iel))=0.d0
  75 :         endif
  76 :  110   continue
  77 :  100  continue
  78 : *  remise à zero des petits FLX
  79 :       do 210 isoupo=1,ipchp(/1)
  80 :        msoupo=ipchp(isoupo)
  81 :        segact msoupo
  82 :        if (nocomp(/2).ne.1) goto 210
  83 :        if (nocomp(1).ne.'FLX') goto 210
  84 :        mpoval=ipoval
  85 :        segact mpoval*mod
  86 :        meleme=igeoc
  87 :        segact meleme
  88 :        do 215 i=1,vpocha(/1)
  89 :         vpocha(i,1)=vpoch(num(1,i))
  90 :  215   continue
  91 :  210  continue
  92 :       segsup vpoch
  93 :       end
  94 :  
  95 :  
  96 :  
  97 :