Télécharger la plaquette Cast3M


fr en

Télécharger yfrti.eso

Retour à la liste

Numérotation des lignes : 

yfrti

  1. C YFRTI     SOURCE    CB215821  26/08/24    21:18:59     12622          
  2.       SUBROUTINE YFRTI(DRR,LE,NEL,K0,NPT,IES,NP,IAXI,IPADL,KIMPL,
  3.      &                 COEF,NCOEF,IKK,
  4.      &                 BETA,NBETA,IKB,
  5.      &                 V0  ,NV0  ,IKV,
  6.      &                 UN,F,F1)
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8 (A-H,O-Z)
  10. C***********************************************************************
  11. C
  12. C                                                BETA
  13. C     CALCUL LE TENSEUR DE PERTE DE CHARGE    K U           I KX       I
  14. C                                                     K-->  I    KY    I
  15. C                                                           I       KZ I
  16. C
  17. C     COEFF    :  K
  18. C     BETA     :  BETA
  19. C
  20. C
  21. C
  22. C***********************************************************************
  23. C
  24.       DIMENSION LE(NP,*),IPADL(*),DRR(NP,NEL)
  25.       DIMENSION UN(NPT,IES),F(NPT,IES),F1(NPT,IES)
  26.       DIMENSION COEF(NCOEF,IES),BETA(NBETA,IES),V0(NV0,IES)
  27. -INC CCREEL
  28. C
  29.       IF(IES.EQ.2) THEN
  30. C
  31. C                 *******
  32. C                 * 2 D *
  33. C                 *******
  34. C
  35. C     write(6,*)' NPT=',NPT,' IES=',IES,' IKK=',ikk,' IKB=',ikb,
  36. C    & ' IKV=',ikv
  37.  
  38.       IF(KIMPL.EQ.0)THEN
  39.  
  40.       DO 1003 K=1,NEL
  41.       NK=K+K0
  42.       KK=1+(1-IKK)*(NK-1)
  43.       KB=1+(1-IKB)*(NK-1)
  44.  
  45.       DO 502 I=1,NP
  46.       NF=IPADL(LE(I,K))
  47.       KV=1+(1-IKV)*(NF-1)
  48.       UXN=UN(NF,1)-V0(KV,1)
  49.       UX=ABS(UXN)+XPETIT
  50.       BX=(BETA(KB,1)-1.D0)*LOG(UX)
  51.       ABX=ABS(BX)
  52.       IF(ABX.LE.XPETIT)THEN
  53.       UX=1.D0
  54.       ELSE
  55.       UX=EXP(BX)
  56.       ENDIF
  57.       UYN=UN(NF,2)-V0(KV,2)
  58.       UY=ABS(UYN)+XPETIT
  59.       BY=(BETA(KB,2)-1.D0)*LOG(UY)
  60.       ABY=ABS(BY)
  61.       IF(ABY.LE.XPETIT)THEN
  62.       UY=1.D0
  63.       ELSE
  64.       UY=EXP(BY)
  65.       ENDIF
  66.       FF1=COEF(KK,1)*UX*UXN*DRR(I,K)*(-1.)
  67.       FF2=COEF(KK,2)*UY*UYN*DRR(I,K)*(-1.)
  68.       F(NF,1)=F(NF,1)+FF1
  69.       F(NF,2)=F(NF,2)+FF2
  70.  502  CONTINUE
  71.  1003 CONTINUE
  72.  
  73.       ELSE
  74.       DO 1004 K=1,NEL
  75.       NK=K+K0
  76.       KK=1+(1-IKK)*(NK-1)
  77.       KB=1+(1-IKB)*(NK-1)
  78.  
  79.       DO 402 I=1,NP
  80.       NF=IPADL(LE(I,K))
  81.       KV=1+(1-IKV)*(NF-1)
  82.  
  83.       UXNE=-V0(KV,1)
  84.       UXNI=UN(NF,1)
  85.       UXN =UN(NF,1)-V0(KV,1)
  86.       UX=ABS(UXN)+XPETIT
  87.       BX=(BETA(KB,1)-1.D0)*LOG(UX)
  88.       ABX=ABS(BX)
  89.       IF(ABX.LE.XPETIT)THEN
  90.       UX=1.D0
  91.       ELSE
  92.       UX=EXP(BX)
  93.       ENDIF
  94.  
  95.       UYNE=-V0(KV,2)
  96.       UYNI=UN(NF,2)
  97.       UYN =UN(NF,2)-V0(KV,2)
  98.       UY=ABS(UYN)+XPETIT
  99.       BY=(BETA(KB,2)-1.D0)*LOG(UY)
  100.       ABY=ABS(BY)
  101.       IF(ABY.LE.XPETIT)THEN
  102.       UY=1.D0
  103.       ELSE
  104.       UY=EXP(BY)
  105.       ENDIF
  106.  
  107.       FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K)
  108. c      il semble qu'il y ait une erreur sur le terme
  109. c      FFI1 mis en commentaire. On le remplace par
  110. c      l'expression suivante.
  111. c      FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K)
  112.       FFI1=COEF(KK,1)*UX*DRR(I,K)
  113.       FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K)
  114. c      il semble qu'il y ait une erreur sur le terme
  115. c      FFI2 mis en commentaire. On le remplace par
  116. c      l'expression suivante.
  117. c      FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K)
  118.       FFI2=COEF(KK,2)*UY*DRR(I,K)
  119.       F(NF,1)=F(NF,1)+FFE1
  120.       F(NF,2)=F(NF,2)+FFE2
  121.       F1(NF,1)=F1(NF,1)+FFI1
  122.       F1(NF,2)=F1(NF,2)+FFI2
  123.  402  CONTINUE
  124.  1004 CONTINUE
  125.  
  126.       ENDIF
  127.  
  128. C
  129. C                 *******
  130. C                 * 3 D *
  131. C                 *******
  132. C
  133.       ELSE
  134.  
  135.       IF(KIMPL.EQ.0)THEN
  136.  
  137.       DO 1005 K=1,NEL
  138.       NK=K+K0
  139.       KK=1+(1-IKK)*(NK-1)
  140.       KB=1+(1-IKB)*(NK-1)
  141.  
  142.       DO 503 I=1,NP
  143.       NF=IPADL(LE(I,K))
  144.       KV=1+(1-IKV)*(NF-1)
  145.       UXN=UN(NF,1)-V0(KV,1)
  146.       UX=ABS(UXN)+XPETIT
  147.       BX=(BETA(KB,1)-1.D0)*LOG(UX)
  148.       ABX=ABS(BX)
  149.       IF(ABX.LE.XPETIT)THEN
  150.       UX=1.D0
  151.       ELSE
  152.       UX=EXP(BX)
  153.       ENDIF
  154.       UYN=UN(NF,2)-V0(KV,2)
  155.       UY=ABS(UYN)+XPETIT
  156.       BY=(BETA(KB,2)-1.D0)*LOG(UY)
  157.       ABY=ABS(BY)
  158.       IF(ABY.LE.XPETIT)THEN
  159.       UY=1.D0
  160.       ELSE
  161.       UY=EXP(BY)
  162.       ENDIF
  163.       UZN=UN(NF,3)-V0(KV,3)
  164.       UZ=ABS(UZN)+XPETIT
  165.       BZ=(BETA(KB,3)-1.D0)*LOG(UZ)
  166.       ABZ=ABS(BZ)
  167.       IF(ABZ.LE.XPETIT)THEN
  168.       UZ=1.D0
  169.       ELSE
  170.       UZ=EXP(BZ)
  171.       ENDIF
  172.       FF1=COEF(KK,1)*UX*UXN*DRR(I,K)*(-1.)
  173.       FF2=COEF(KK,2)*UY*UYN*DRR(I,K)*(-1.)
  174.       FF3=COEF(KK,3)*UZ*UZN*DRR(I,K)*(-1.)
  175.       F(NF,1)=F(NF,1)+FF1
  176.       F(NF,2)=F(NF,2)+FF2
  177.       F(NF,3)=F(NF,3)+FF3
  178.  503  CONTINUE
  179.  1005 CONTINUE
  180.  
  181.       ELSE
  182.       DO 1006 K=1,NEL
  183.       NK=K+K0
  184.       KK=1+(1-IKK)*(NK-1)
  185.       KB=1+(1-IKB)*(NK-1)
  186.  
  187.       DO 403 I=1,NP
  188.       NF=IPADL(LE(I,K))
  189.  
  190.       KV=1+(1-IKV)*(NF-1)
  191.       UXNE=-V0(KV,1)
  192.       UXNI=UN(NF,1)
  193.       UXN =UN(NF,1)-V0(KV,1)
  194.       UX=ABS(UXN)+XPETIT
  195.       BX=(BETA(KB,1)-1.D0)*LOG(UX)
  196.       ABX=ABS(BX)
  197.       IF(ABX.LE.XPETIT)THEN
  198.       UX=1.D0
  199.       ELSE
  200.       UX=EXP(BX)
  201.       ENDIF
  202.  
  203.       UYNE=-V0(KV,2)
  204.       UYNI=UN(NF,2)
  205.       UYN =UN(NF,2)-V0(KV,2)
  206.       UY=ABS(UYN)+XPETIT
  207.       BY=(BETA(KB,2)-1.D0)*LOG(UY)
  208.       ABY=ABS(BY)
  209.       IF(ABY.LE.XPETIT)THEN
  210.       UY=1.D0
  211.       ELSE
  212.       UY=EXP(BY)
  213.       ENDIF
  214.  
  215.       UZNE=-V0(KV,3)
  216.       UZNI=UN(NF,3)
  217.       UZN =UN(NF,3)-V0(KV,3)
  218.       UZ=ABS(UZN)+XPETIT
  219.       BZ=(BETA(KB,3)-1.D0)*LOG(UZ)
  220.       ABZ=ABS(BZ)
  221.       IF(ABZ.LE.XPETIT)THEN
  222.       UZ=1.D0
  223.       ELSE
  224.       UZ=EXP(BZ)
  225.       ENDIF
  226.  
  227.       FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K)
  228. c      il semble qu'il y ait une erreur sur le terme
  229. c      FFI1 mis en commentaire. On le remplace par
  230. c      l'expression suivante.
  231. c      FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K)
  232.       FFI1=COEF(KK,1)*UX*DRR(I,K)
  233.       FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K)
  234. c      il semble qu'il y ait une erreur sur le terme
  235. c      FFI2 mis en commentaire. On le remplace par
  236. c      l'expression suivante.
  237. c      FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K)
  238.       FFI2=COEF(KK,2)*UY*DRR(I,K)
  239.       FFE3=COEF(KK,3)*UZ*UZNE*DRR(I,K)
  240. c      il semble qu'il y ait une erreur sur le terme
  241. c      FFI3 mis en commentaire. On le remplace par
  242. c      l'expression suivante.
  243. c      FFI3=COEF(KK,3)*UZ*UZNI*DRR(I,K)
  244.       FFI3=COEF(KK,3)*UZ*DRR(I,K)
  245.       F(NF,1)=F(NF,1)+FFE1
  246.       F(NF,2)=F(NF,2)+FFE2
  247.       F(NF,3)=F(NF,3)+FFE3
  248.       F1(NF,1)=F1(NF,1)+FFI1
  249.       F1(NF,2)=F1(NF,2)+FFI2
  250.       F1(NF,3)=F1(NF,3)+FFI3
  251.  403  CONTINUE
  252.  1006 CONTINUE
  253.  
  254.       ENDIF
  255.  
  256.       ENDIF
  257.  
  258.  
  259.       RETURN
  260.  1001 FORMAT(20(1X,I5))
  261.  1002 FORMAT(10(1X,1PE11.4))
  262.       END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  

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