Télécharger la plaquette Cast3M


fr en

Télécharger crech1.eso

Retour à la liste

Numérotation des lignes : 

crech1

  1. C CRECH1    SOURCE    CB215821  19/08/20    21:16:26     10287          
  2. *  preconditionnement des meleme cree par crechp
  3.       subroutine crech1(meleme,idet)
  4. -INC CCPRECO
  5. -INC SMELEME
  6.       if=nbemel
  7.       ith=oothrd
  8.  
  9. C     Activations par paquets
  10.       CALL oooprl(1)
  11.       segact meleme
  12.       do i=1,nbemel
  13.         ipt1=premel(i,ith)
  14.         if (ipt1.eq.0) goto 1
  15.         segact,ipt1
  16.       enddo
  17.  1    CONTINUE
  18.       CALL oooprl(0)
  19.  
  20.       if (num(/1).ne.1.or.itypel.ne.1) return
  21.       nbel=num(/2)
  22.       if (nbel.eq.0) then
  23.        ihash1=0
  24.        ihash2=0
  25.       elseif (nbel.eq.1) then
  26.        ihash1=num(1,1)
  27.        ihash2=num(1,1)
  28.       else
  29.        ihash1=num(1,1)+num(1,nbel)
  30.        ihash2=num(1,1)-num(1,nbel)
  31.       endif
  32.       do 10 i=1,nbemel
  33.         if (premel(i,ith).eq.0) goto 20
  34.         ipt1=premel(i,ith)
  35.         if (ipt1.eq.meleme) return
  36.         if (nbso(i,ith) .ne.nbel)   goto 10
  37.         if (hash1(i,ith).ne.ihash1) goto 10
  38.         if (hash2(i,ith).ne.ihash2) goto 10
  39.         if (ipt1.num(/2).ne.nbel)   goto 10
  40.         do j=1,nbel
  41.           if (num(1,j) .ne.ipt1.num(1,j))  goto 10
  42.           if (icolor(j).ne.ipt1.icolor(j)) goto 10
  43.         enddo
  44. *  maillage identiques
  45. *       write (6,*) ' crech1 ',meleme,' remplace par ',ipt1,
  46. *    >   'position ',i, 'thread ',ith
  47. ***        if (idet.eq.1) segsup meleme
  48.         meleme=ipt1
  49.         if = i
  50.         goto 20
  51.         return
  52.   10  continue
  53.   20  continue
  54.       if (if.lt.nbemel/3) return
  55.  
  56. *  on rajoute le maillage courant en tête
  57.       do j=if,2,-1
  58.         premel(j,ith)=premel(j-1,ith)
  59.         nbso(j,ith)=nbso(j-1,ith)
  60.         hash1(j,ith)=hash1(j-1,ith)
  61.         hash2(j,ith)=hash2(j-1,ith)
  62.       enddo
  63.       premel(1,ith)=meleme
  64.       nbso(1,ith)  =nbel
  65.       hash1(1,ith) =ihash1
  66.       hash2(1,ith) =ihash2
  67.       end
  68.  
  69.  
  70.  

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