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

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