Télécharger la plaquette Cast3M


fr en

Télécharger verlx.eso

Retour à la liste

Numérotation des lignes : 

verlx

  1. C VERLX     SOURCE    CB215821  20/11/25    13:42:23     10792          
  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 deplacement
  8. *
  9.  
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8 (A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMCHPOI
  16. -INC SMRIGID
  17. -INC SMELEME
  18. -INC SMCOORD
  19. -INC CCREEL
  20.  
  21.       segment vpoch(nbpts)
  22.  
  23.  
  24.       nbnn=1
  25.       nbsous=0
  26.       nbref=0
  27.       xmcrit=xpetit
  28.       segini vpoch
  29. *  expension des LX du chpoint
  30.       segact mchpoi
  31.       do 10 isoupo=1,ipchp(/1)
  32.          msoupo=ipchp(isoupo)
  33.          segact msoupo
  34.          if (nocomp(/2).ne.1    ) goto 10
  35.          if (nocomp(1) .ne.'FLX') goto 10
  36.          mpoval=ipoval
  37.          segact mpoval
  38.          meleme=igeoc
  39.          segact meleme
  40.          do 15 i=1,vpocha(/1)
  41.             vpoch(num(1,i))=vpocha(i,1)
  42.             xmcrit=max(xmcrit,abs(vpocha(i,1)))
  43.  15      continue
  44.  10   continue
  45. *  calcul du critere
  46.       segact mchpo1
  47.       do 50 isoupo=1,mchpo1.ipchp(/1)
  48.          msoupo=mchpo1.ipchp(isoupo)
  49.          segact msoupo
  50. *      WRITE(IOIMP,*) ' verlx nocomp(1) ',nocomp(1)
  51.          if (nocomp(1).eq.'FLX') goto 50
  52.          mpoval=ipoval
  53.          segact mpoval
  54.          do 55 i=1,vpocha(/1)
  55.             do 56 j=1,vpocha(/2)
  56.                xmcrit=max(xmcrit,abs(vpocha(i,j)))
  57.  56         continue
  58.  55      continue
  59.  50   continue
  60.       xmcrit=xmcrit*1d-6
  61. *     WRITE(IOIMP,*) ' xmcrit dans verlx ',xmcrit
  62. *  balayer les matrices pour tester les LX y apparaissant
  63.       segact mrigid
  64.       do 100 irige=1,irigel(/2)
  65.          meleme=irigel(1,irige)
  66.          descr=irigel(3,irige)
  67.          segact descr
  68.          if (lisinc(1).ne.'LX') goto 100
  69.          segact meleme
  70.          do 110 iel=1,num(/2)
  71.             if (abs(vpoch(num(1,iel))).gt.xmcrit) then
  72.                if (noen.eq.0) then
  73.                   nbelem=ipt8.num(/2)+1
  74.                   segadj ipt8
  75.                   ipt8.num(1,nbelem)=num(1,iel)
  76.                else
  77.                   interr(1)=num(1,iel)
  78.                   moterr(1:4)='LX'
  79. * Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4
  80.                   call erreur(143)
  81.                endif
  82.             else
  83.                vpoch(num(1,iel))=0.d0
  84.             endif
  85.  110     continue
  86.  100  continue
  87. *  remise à zero des petits FLX
  88.       do 210 isoupo=1,ipchp(/1)
  89.          msoupo=ipchp(isoupo)
  90.          segact msoupo
  91.          if (nocomp(/2).ne.1) goto 210
  92.          if (nocomp(1).ne.'FLX') goto 210
  93.          mpoval=ipoval
  94.          segact mpoval*mod
  95.          meleme=igeoc
  96.          segact meleme
  97.          do 215 i=1,vpocha(/1)
  98.             vpocha(i,1)=vpoch(num(1,i))
  99.  215     continue
  100.  210  continue
  101.       segsup vpoch
  102.       end
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  

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