Esope source files

   1 : C CHAHUT    SOURCE    CHAT      05/01/12    21:54:17     5004           
   2 :       SUBROUTINE CHAHUT(MELEME,ALFA)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z) 
   5 : -INC CCOPTIO
   6 : -INC SMCOORD
   7 : -INC SMELEME
   8 : -INC SMLENTI
   9 : 
  10 :       COEF=ALFA*0.05D0
  11 :       IF(IDIM.EQ.3)THEN
  12 :       WRITE(6,*)' DOMA : CHAHUT non prevu en 3D'
  13 :       RETURN
  14 :       ENDIF
  15 : 
  16 :       JG=XCOOR(/1)/(IDIM+1)
  17 :       SEGINI MLENTI
  18 :       SEGACT MELEME
  19 :       NBSOUS=LISOUS(/1)
  20 :       IF(NBSOUS.EQ.0)NBSOUS=1
  21 : 
  22 :       DO 1 L=1,NBSOUS
  23 :       IPT1=MELEME
  24 :       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  25 :       SEGACT IPT1
  26 :       NBEL=IPT1.NUM(/2)
  27 :       NP  =IPT1.NUM(/1)
  28 :       DO 101 K=1,NBEL
  29 :       DO 102 I=2,NP,2
  30 :       N2=IPT1.NUM(I,K)
  31 :       LECT(N2)=LECT(N2)+1
  32 :  102  CONTINUE
  33 :  101  CONTINUE
  34 :  1    CONTINUE
  35 : 
  36 :       DO 2 L=1,NBSOUS
  37 :       IPT1=MELEME
  38 :       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  39 :       NBEL=NUM(/2)
  40 :       NP  =NUM(/1)
  41 : 
  42 :       IF(NP.EQ.6)THEN
  43 :       DO 206 K=1,NBEL
  44 :       N1=IPT1.NUM(1,K)
  45 :       N2=IPT1.NUM(2,K)
  46 :       N3=IPT1.NUM(3,K)
  47 :       N4=IPT1.NUM(3,K)
  48 :       N5=IPT1.NUM(3,K)
  49 :       N6=IPT1.NUM(3,K)
  50 : 
  51 : 
  52 :       XN1=XCOOR((N1-1)*(IDIM+1)    +1)
  53 :       YN1=XCOOR((N1-1)*(IDIM+1)    +2)
  54 :       XN2=XCOOR((N2-1)*(IDIM+1)    +1)
  55 :       YN2=XCOOR((N2-1)*(IDIM+1)    +2)
  56 :       XN3=XCOOR((N3-1)*(IDIM+1)    +1)
  57 :       YN3=XCOOR((N3-1)*(IDIM+1)    +2)
  58 :       XN4=XCOOR((N4-1)*(IDIM+1)    +1)
  59 :       YN4=XCOOR((N4-1)*(IDIM+1)    +2)
  60 :       XN5=XCOOR((N5-1)*(IDIM+1)    +1)
  61 :       YN5=XCOOR((N5-1)*(IDIM+1)    +2)
  62 :       XN6=XCOOR((N6-1)*(IDIM+1)    +1)
  63 :       YN6=XCOOR((N6-1)*(IDIM+1)    +2)
  64 : 
  65 :       D1=(XN2-XN6)*(XN2-XN6)+(YN2-YN6)*(YN2-YN6)
  66 :       D1=SQRT(D1)
  67 :       D2=(XN2-XN4)*(XN2-XN4)+(YN2-YN4)*(YN2-YN4)
  68 :       D2=SQRT(D2)
  69 :       D3=(XN6-XN4)*(XN6-XN4)+(YN6-YN4)*(YN6-YN4)
  70 :       D3=SQRT(D2)
  71 : 
  72 :       IF(LECT(N2).EQ.2)THEN
  73 :       D=MIN(D1,D2)*COEF
  74 :       UU=(XN2-XN5)*(XN2-XN5)+(YN2-YN5)*(YN2-YN5)
  75 :       UU=SQRT(UU)
  76 :       UX=(XN2-XN5)/UU
  77 :       UY=(YN2-YN5)/UU
  78 :       XCOOR((N2-1)*(IDIM+1)    +1)= XCOOR((N2-1)*(IDIM+1)    +1)+D*UX
  79 :       XCOOR((N2-1)*(IDIM+1)    +2)= XCOOR((N2-1)*(IDIM+1)    +2)+D*UY
  80 :       ENDIF
  81 : 
  82 :       IF(LECT(N4).EQ.2)THEN
  83 :       D=MIN(D3,D2)*COEF
  84 :       UU=(XN1-XN4)*(XN1-XN4)+(YN1-YN4)*(YN1-YN4)
  85 :       UU=SQRT(UU)
  86 :       UX=(XN1-XN4)/UU
  87 :       UY=(YN1-YN4)/UU
  88 :       XCOOR((N4-1)*(IDIM+1)    +1)= XCOOR((N4-1)*(IDIM+1)    +1)+D*UX
  89 :       XCOOR((N4-1)*(IDIM+1)    +2)= XCOOR((N4-1)*(IDIM+1)    +2)+D*UY
  90 :       ENDIF
  91 : 
  92 :       IF(LECT(N6).EQ.2)THEN
  93 :       D=MIN(D3,D1)*COEF
  94 :       UU=(XN6-XN3)*(XN6-XN3)+(YN6-YN3)*(YN6-YN3)
  95 :       UU=SQRT(UU)
  96 :       UX=(XN6-XN3)/UU
  97 :       UY=(YN6-YN3)/UU
  98 :       XCOOR((N6-1)*(IDIM+1)    +1)= XCOOR((N6-1)*(IDIM+1)    +1)+D*UX
  99 :       XCOOR((N6-1)*(IDIM+1)    +2)= XCOOR((N6-1)*(IDIM+1)    +2)+D*UY
 100 :       ENDIF
 101 : 
 102 : 
 103 :  206  CONTINUE
 104 :       ELSEIF(NP.EQ.8)THEN
 105 :       GO TO 2
 106 :       ELSE
 107 :       WRITE(6,*)' DOMA : CHAHUT non prevu pour NP=',NP
 108 :       GO TO 2
 109 :       ENDIF
 110 :       SEGDES IPT1
 111 :  2    CONTINUE
 112 : 
 113 :       SEGDES MELEME
 114 :       SEGSUP MLENTI
 115 : 
 116 :       RETURN
 117 :       END
 118 :  
 119 :  
 120 :  
 121 :