Télécharger la plaquette Cast3M


fr en

Télécharger ztoimp.eso

Retour à la liste

Numérotation des lignes : 

ztoimp

  1. C ZTOIMP    SOURCE    CB215821  26/08/24    21:19:06     12622          
  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.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCREEL
  23. *-
  24.  
  25. C
  26. C
  27.       IF(IDIM.EQ.3)GO TO 300
  28.  
  29. C                     *********
  30. C                     *   2D  *
  31. C                     *********
  32.  
  33.       DO 1003 K=1,NEL
  34.       NK=K0+K
  35.       KA=1+(1-IKA)*(NK-1)
  36. C
  37.       XT(1)=COTE(5,NK)
  38.       XT(2)=COTE(7,NK)
  39.       XN(1)=COTE(6,NK)
  40.       XN(2)=COTE(8,NK)
  41. C
  42.       DO 50 I=1,NP
  43.       NF=IPADL(LE(I,K))
  44. C     UX=UN(NF,1)
  45. C     UY=UN(NF,2)
  46. C     UM=UX*UX+UY*UY
  47. C     UM=SQRT(UM)+XPETIT
  48. C     XT(1)=UX/UM
  49. C     XT(2)=UY/UM
  50.       FF1=(TAU(KA,1)*XT(1)+TAU(KA,2)*XN(1))*DRR(I,K)
  51.       F(NF,1)=F(NF,1)-FF1*IKIMPL
  52.       FF2=(TAU(KA,1)*XT(2)+TAU(KA,2)*XN(2))*DRR(I,K)
  53.       F(NF,2)=F(NF,2)-FF2*IKIMPL
  54.  50   CONTINUE
  55.  1003 CONTINUE
  56.  
  57.       RETURN
  58.  
  59. C                     *********
  60. C                     *   3D  *
  61. C                     *********
  62.  300  CONTINUE
  63.  
  64.  
  65.       DO 1004 K=1,NEL
  66.       NK=K0+K
  67.       KA=1+(1-IKA)*(NK-1)
  68.       XT(1)=COTE(5,NK)
  69.       XT(2)=COTE(6,NK)
  70.       XT(3)=COTE(7,NK)
  71.       XN(1)=COTE(7 ,NK)
  72.       XN(2)=COTE(10,NK)
  73.       XN(3)=COTE(13,NK)
  74.       TO=TAU(KA,1)*TAU(KA,1)+TAU(KA,2)*TAU(KA,2)
  75.       TO=SQRT(TO)
  76. C
  77.       DO 350  I=1,NP
  78.  
  79.       NF=IPADL(LE(I,K))
  80. C     UX=UN(NF,1)
  81. C     UY=UN(NF,2)
  82. C     UZ=UN(NF,3)
  83. C     UM=UX*UX+UY*UY+UZ*UZ
  84. C     UM=SQRT(UM)+XPETIT
  85. C     XT(1)=UX/UM
  86. C     XT(2)=UY/UM
  87. C     XT(3)=UZ/UM
  88.  
  89.       FF1=(TO*XT(1)+TAU(KA,3)*XN(1))*DRR(I,K)
  90.       F(NF,1)=F(NF,1)-FF1
  91.       FF2=(TO*XT(2)+TAU(KA,3)*XN(2))*DRR(I,K)
  92.       F(NF,2)=F(NF,2)-FF2
  93.       FF3=(TO*XT(3)+TAU(KA,3)*XN(3))*DRR(I,K)
  94.       F(NF,3)=F(NF,3)-FF3
  95.  
  96.  350  CONTINUE
  97.  1004 CONTINUE
  98.  
  99.  
  100.       RETURN
  101.  
  102.  
  103.  1002 FORMAT(10(1X,1PE11.4))
  104.  1001 FORMAT(20(1X,I5))
  105.       END
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  

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