Esope source files

   1 : C ZTOIMP    SOURCE    CHAT      06/06/01    21:23:24     5450           
   2 :       SUBROUTINE ZTOIMP(NEL,K0,NP,IPADL,LE,
   3 :      & DRR,COTE,NC4,IKIMPL,
   4 :      & UN,F,NPTD,TAU,NTAU,IKA)
   5 : 
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 : C************************************************************************
   9 : C
  10 : C     SYNTAXE :
  11 : C
  12 : C        TOIMP (TO)
  13 : C
  14 : C
  15 : C************************************************************************
  16 :       DIMENSION UN(NPTD,*),F(NPTD,*),TAU(NTAU,*),COTE(NC4,NEL)
  17 :       DIMENSION XT(3),XN(3)
  18 :       DIMENSION LE(NP,NEL),IPADL(*),DRR(NP,NEL)
  19 : -INC CCOPTIO
  20 : -INC CCREEL
  21 : *- 
  22 : 
  23 : C
  24 : C
  25 :       IF(IDIM.EQ.3)GO TO 300
  26 : 
  27 : C                     *********
  28 : C                     *   2D  *
  29 : C                     *********
  30 : 
  31 :       DO 50 K=1,NEL
  32 :       NK=K0+K
  33 :       KA=1+(1-IKA)*(NK-1)
  34 : C
  35 :       XT(1)=COTE(5,NK)
  36 :       XT(2)=COTE(7,NK)
  37 :       XN(1)=COTE(6,NK)
  38 :       XN(2)=COTE(8,NK)
  39 : C
  40 :       DO 50 I=1,NP
  41 :       NF=IPADL(LE(I,K))
  42 : C     UX=UN(NF,1)
  43 : C     UY=UN(NF,2)
  44 : C     UM=UX*UX+UY*UY
  45 : C     UM=SQRT(UM)+XPETIT
  46 : C     XT(1)=UX/UM
  47 : C     XT(2)=UY/UM
  48 :       FF1=(TAU(KA,1)*XT(1)+TAU(KA,2)*XN(1))*DRR(I,K)
  49 :       F(NF,1)=F(NF,1)-FF1*IKIMPL
  50 :       FF2=(TAU(KA,1)*XT(2)+TAU(KA,2)*XN(2))*DRR(I,K)
  51 :       F(NF,2)=F(NF,2)-FF2*IKIMPL
  52 :  50   CONTINUE
  53 : 
  54 :       RETURN
  55 : 
  56 : C                     *********
  57 : C                     *   3D  *
  58 : C                     *********
  59 :  300  CONTINUE
  60 : 
  61 : 
  62 :       DO 350 K=1,NEL
  63 :       NK=K0+K
  64 :       KA=1+(1-IKA)*(NK-1)
  65 :       XT(1)=COTE(5,NK)
  66 :       XT(2)=COTE(6,NK)
  67 :       XT(3)=COTE(7,NK)
  68 :       XN(1)=COTE(7 ,NK)
  69 :       XN(2)=COTE(10,NK)
  70 :       XN(3)=COTE(13,NK)
  71 :       TO=TAU(KA,1)*TAU(KA,1)+TAU(KA,2)*TAU(KA,2)
  72 :       TO=SQRT(TO)
  73 : C
  74 :       DO 350  I=1,NP
  75 : 
  76 :       NF=IPADL(LE(I,K))
  77 : C     UX=UN(NF,1)
  78 : C     UY=UN(NF,2)
  79 : C     UZ=UN(NF,3)
  80 : C     UM=UX*UX+UY*UY+UZ*UZ
  81 : C     UM=SQRT(UM)+XPETIT
  82 : C     XT(1)=UX/UM
  83 : C     XT(2)=UY/UM
  84 : C     XT(3)=UZ/UM
  85 : 
  86 :       FF1=(TO*XT(1)+TAU(KA,3)*XN(1))*DRR(I,K)
  87 :       F(NF,1)=F(NF,1)-FF1
  88 :       FF2=(TO*XT(2)+TAU(KA,3)*XN(2))*DRR(I,K)
  89 :       F(NF,2)=F(NF,2)-FF2
  90 :       FF3=(TO*XT(3)+TAU(KA,3)*XN(3))*DRR(I,K)
  91 :       F(NF,3)=F(NF,3)-FF3
  92 : 
  93 :  350  CONTINUE
  94 : 
  95 : 
  96 :       RETURN
  97 : 
  98 : 
  99 :  1002 FORMAT(10(1X,1PE11.4))
 100 :  1001 FORMAT(20(1X,I5))
 101 :       END
 102 : 
 103 : 
 104 : 
 105 : 
 106 :  
 107 :  
 108 :  
 109 :