Télécharger la plaquette Cast3M


fr en

Télécharger zcvfpu.eso

Retour à la liste

Numérotation des lignes : 

zcvfpu

  1. C ZCVFPU    SOURCE    CHAT      05/01/13    04:21:45     5004
  2.       SUBROUTINE ZCVFPU(NEL,K0,NPF,IES,NPTD,IAXI,IPADL,
  3.      &     LEF,XCOOR,
  4.      &     VOLF,
  5.      &     UN,TK,TE,
  6.      &     F,
  7.      &     DK,DE,
  8.      &     ANU,IKC,UET,YP)
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12. C************************************************************************
  13. C
  14. C     SYNTAXE :
  15. C
  16. C        FPU (NU,UET,YP <,VPAROI> )
  17. C
  18. C       1------2
  19. C       (R1,AL1)  LEF   FLUIDE  NOEUDS 1 2
  20. C
  21. C
  22. C     ANU     VISCOSITE CINEMATIQUE
  23. C     UET     U*
  24. C     YP      DISTANCE A LA PAROI
  25. C     VPAROI  VITESSE DE LA PAROI (PAR DEFAUT 0.D0)
  26. C
  27. C   CAS TRIDIMENSIONNEL
  28. C                       4 ________ 3
  29. C                       / FLUIDE /
  30. C                    1 /________/2
  31. C
  32. C
  33. C************************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC CCREEL
  38.       DIMENSION UN(NPTD,IES),TK(*),TE(*)
  39.  
  40.       REAL*8    F(NPTD,IES)
  41.       REAL*8    DK(*),DE(*)
  42.  
  43.       DIMENSION UET(*)
  44.       DIMENSION AF(2,2),CF(2,2)
  45.       DIMENSION ANU(*),VOLF(*)
  46.       DIMENSION XCOOR(*),XYZ(3,4)
  47.       DIMENSION LEF(NPF,NEL),IPADL(*)
  48.       DIMENSION LE(4)
  49.       DIMENSION UIX(4),UIY(4),UIZ(4),UFI(4)
  50.  
  51.       DIMENSION UPIU(101)
  52.  
  53. C     -------------------CAROLI----I------------------------------------
  54.       DATA UPIU(  1) /0.000000D+00/
  55.       DATA UPIU(  2) /0.999954D+00/
  56.       DATA UPIU(  3) /0.199858D+01/
  57.       DATA UPIU(  4) /0.298974D+01/
  58.       DATA UPIU(  5) /0.395957D+01/
  59.       DATA UPIU(  6) /0.488802D+01/
  60.       DATA UPIU(  7) /0.575502D+01/
  61.       DATA UPIU(  8) /0.654720D+01/
  62.       DATA UPIU(  9) /0.726016D+01/
  63.       DATA UPIU( 10) /0.789663D+01/
  64.       DATA UPIU( 11) /0.846323D+01/
  65.       DATA UPIU( 12) /0.896802D+01/
  66.       DATA UPIU( 13) /0.941906D+01/
  67.       DATA UPIU( 14) /0.982372D+01/
  68.       DATA UPIU( 15) /0.101884D+02/
  69.       DATA UPIU( 16) /0.105188D+02/
  70.       DATA UPIU( 17) /0.108193D+02/
  71.       DATA UPIU( 18) /0.110941D+02/
  72.       DATA UPIU( 19) /0.113464D+02/
  73.       DATA UPIU( 20) /0.115790D+02/
  74.       DATA UPIU( 21) /0.117944D+02/
  75.       DATA UPIU( 22) /0.119944D+02/
  76.       DATA UPIU( 23) /0.121809D+02/
  77.       DATA UPIU( 24) /0.123553D+02/
  78.       DATA UPIU( 25) /0.125189D+02/
  79.       DATA UPIU( 26) /0.126727D+02/
  80.       DATA UPIU( 27) /0.128178D+02/
  81.       DATA UPIU( 28) /0.129549D+02/
  82.       DATA UPIU( 29) /0.130849D+02/
  83.       DATA UPIU( 30) /0.132082D+02/
  84.       DATA UPIU( 31) /0.133256D+02/
  85.       DATA UPIU( 32) /0.134375D+02/
  86.       DATA UPIU( 33) /0.135443D+02/
  87.       DATA UPIU( 34) /0.136465D+02/
  88.       DATA UPIU( 35) /0.137444D+02/
  89.       DATA UPIU( 36) /0.138383D+02/
  90.       DATA UPIU( 37) /0.139285D+02/
  91.       DATA UPIU( 38) /0.140153D+02/
  92.       DATA UPIU( 39) /0.140988D+02/
  93.       DATA UPIU( 40) /0.141794D+02/
  94.       DATA UPIU( 41) /0.142573D+02/
  95.       DATA UPIU( 42) /0.143325D+02/
  96.       DATA UPIU( 43) /0.144052D+02/
  97.       DATA UPIU( 44) /0.144757D+02/
  98.       DATA UPIU( 45) /0.145440D+02/
  99.       DATA UPIU( 46) /0.146102D+02/
  100.       DATA UPIU( 47) /0.146746D+02/
  101.       DATA UPIU( 48) /0.147371D+02/
  102.       DATA UPIU( 49) /0.147979D+02/
  103.       DATA UPIU( 50) /0.148570D+02/
  104.       DATA UPIU( 51) /0.149147D+02/
  105.       DATA UPIU( 52) /0.149708D+02/
  106.       DATA UPIU( 53) /0.150256D+02/
  107.       DATA UPIU( 54) /0.150790D+02/
  108.       DATA UPIU( 55) /0.151311D+02/
  109.       DATA UPIU( 56) /0.151821D+02/
  110.       DATA UPIU( 57) /0.152319D+02/
  111.       DATA UPIU( 58) /0.152806D+02/
  112.       DATA UPIU( 59) /0.153282D+02/
  113.       DATA UPIU( 60) /0.153749D+02/
  114.       DATA UPIU( 61) /0.154206D+02/
  115.       DATA UPIU( 62) /0.154653D+02/
  116.       DATA UPIU( 63) /0.155092D+02/
  117.       DATA UPIU( 64) /0.155522D+02/
  118.       DATA UPIU( 65) /0.155944D+02/
  119.       DATA UPIU( 66) /0.156358D+02/
  120.       DATA UPIU( 67) /0.156765D+02/
  121.       DATA UPIU( 68) /0.157164D+02/
  122.       DATA UPIU( 69) /0.157556D+02/
  123.       DATA UPIU( 70) /0.157942D+02/
  124.       DATA UPIU( 71) /0.158321D+02/
  125.       DATA UPIU( 72) /0.158694D+02/
  126.       DATA UPIU( 73) /0.159060D+02/
  127.       DATA UPIU( 74) /0.159421D+02/
  128.       DATA UPIU( 75) /0.159776D+02/
  129.       DATA UPIU( 76) /0.160126D+02/
  130.       DATA UPIU( 77) /0.160470D+02/
  131.       DATA UPIU( 78) /0.160809D+02/
  132.       DATA UPIU( 79) /0.161143D+02/
  133.       DATA UPIU( 80) /0.161472D+02/
  134.       DATA UPIU( 81) /0.161797D+02/
  135.       DATA UPIU( 82) /0.162117D+02/
  136.       DATA UPIU( 83) /0.162433D+02/
  137.       DATA UPIU( 84) /0.162744D+02/
  138.       DATA UPIU( 85) /0.163051D+02/
  139.       DATA UPIU( 86) /0.163354D+02/
  140.       DATA UPIU( 87) /0.163653D+02/
  141.       DATA UPIU( 88) /0.163949D+02/
  142.       DATA UPIU( 89) /0.164240D+02/
  143.       DATA UPIU( 90) /0.164528D+02/
  144.       DATA UPIU( 91) /0.164813D+02/
  145.       DATA UPIU( 92) /0.165094D+02/
  146.       DATA UPIU( 93) /0.165371D+02/
  147.       DATA UPIU( 94) /0.165646D+02/
  148.       DATA UPIU( 95) /0.165917D+02/
  149.       DATA UPIU( 96) /0.166185D+02/
  150.       DATA UPIU( 97) /0.166450D+02/
  151.       DATA UPIU( 98) /0.166712D+02/
  152.       DATA UPIU( 99) /0.166971D+02/
  153.       DATA UPIU(100) /0.167228D+02/
  154.       DATA UPIU(101) /0.167481D+02/
  155. C -----------------------CAROLI---------F-----------------------
  156.  
  157. C CONSTANTES PHYSIQUES
  158. C
  159.       DATA CNU,AKER /0.09D0,0.41D0/
  160.  
  161. C
  162.       IF(IKC.NE.1)GO TO 9990
  163.       R1=1.D0
  164. C
  165. C
  166.       SQCNU=SQRT(CNU)
  167.       KC=1
  168. C     --------------------CAROLI-----------I-----------------------
  169.       ANUL=ANU(KC)
  170. C     --------------------CAROLI-----------F-----------------------
  171.  
  172.       IF(IES.EQ.3)GO TO 300
  173.  
  174. C                     *********
  175. C                     *   2D  *
  176. C                     *********
  177.  
  178.       CF(1,1)=R1/3.D0
  179.       CF(2,1)=CF(1,1)/2.D0
  180.       CF(1,2)=CF(2,1)
  181.       CF(2,2)=CF(1,1)
  182.  
  183. C      IF(IPT.EQ.100)WRITE(IOIMP,*)' YCVFPU : ANUL,R1 ',ANUL,R1
  184.  
  185.       DO 50 K=1,NEL
  186.          NK=K0+K
  187. C     WRITE(IOIMP,*)' XCVFPS NK=',NK
  188.          KC=1+(1-IKC)*(NK-1)
  189.          CALL RSETD(AF,CF,4)
  190. C
  191. C
  192.          IP=LEF(1,K)
  193.          XYZ(1,1)=XCOOR((IP-1)*(IES+1)    +1)
  194.          XYZ(2,1)=XCOOR((IP-1)*(IES+1)    +2)
  195.          IP=LEF(2,K)
  196.          XYZ(1,2)=XCOOR((IP-1)*(IES+1)    +1)
  197.          XYZ(2,2)=XCOOR((IP-1)*(IES+1)    +2)
  198.  
  199.          LE(1)=IPADL(LEF(1,K))
  200.          LE(2)=IPADL(LEF(2,K))
  201.  
  202. C     WRITE(IOIMP,*)' LE.... ',(LE(MM),MM=1,4)
  203.  
  204.          DO 5  I=1,2
  205.  
  206.             NF=LE(I)
  207.  
  208.             UIX(I)= UN(NF,1)
  209.             UIY(I)= UN(NF,2)
  210.  
  211.  5       CONTINUE
  212.  
  213. C
  214. C     CALCUL DES LONGUEURS DE L'ELEMENT :  AL1
  215. C
  216.          IF (IAXI.EQ.0) THEN
  217.             R1=1.D0
  218.          ELSEIF (IAXI.EQ.1) THEN
  219.             R1=(XYZ(2,1)+XYZ(2,2))*XPI
  220.          ELSEIF (IAXI.EQ.2) THEN
  221.             R1=(XYZ(1,1)+XYZ(1,2))*XPI
  222.          ENDIF
  223.  
  224.          AL1X=XYZ(1,2)-XYZ(1,1)
  225.          AL1Y=XYZ(2,2)-XYZ(2,1)
  226.          AL1=SQRT(AL1X*AL1X+AL1Y*AL1Y)
  227.  
  228. C
  229. C     CALCUL DES COMPOSANTES TANGENTIELLES A LA PAROI DES VITESSES
  230. C     ET DE LA MOYENNE DE LEURS DIFFERENCES FLUIDE-PAROI : UTM
  231. C
  232.  
  233.          UT1=UIX(1)*UIX(1) + UIY(1)*UIY(1)
  234.          UT2=UIX(2)*UIX(2) + UIY(2)*UIY(2)
  235.          UT1=SQRT(UT1)
  236.          UT2=SQRT(UT2)
  237.          UTM=(UT1+UT2)/2.D0
  238.  
  239. C
  240. C     CALCUL DE U ETOILE  A PARTIR UTM
  241. C
  242. C     --------------------CAROLI---I--------------------------
  243.          DO 57 I=1,2
  244.             YPLUS=YP*UET(K)/ANUL
  245.             YPLUS=ABS(YPLUS)+1.D-5
  246.             IF(YPLUS.GT.100.0D0) THEN
  247.                UPLUS=5.5D0+(LOG(YPLUS))/0.41D0
  248.             ELSE
  249.                IY=INT(YPLUS)
  250.                RY=YPLUS-IY
  251.                UPLUS=UPIU(IY+1)+RY*(UPIU(IY+2)-UPIU(IY+1))
  252.             ENDIF
  253. C     ---- RELAX SU UET ------------------------------------
  254.             UET(NK)=0.5D0*UET(NK)+0.5D0*(ABS(UTM/(UPLUS+1.D-5)))
  255.  57      CONTINUE
  256. C     --------------------CAROLI----F------------------
  257.  
  258. C************************************************************************
  259. C     CALCUL Q D M
  260. C************************************************************************
  261.  
  262. C     CALCUL DU COEFFICIENT AK  A PARTIR DE UTM
  263.  
  264.          AUTM=ABS(UTM)
  265.          AK=0.D0
  266.          IF(AUTM.GT.1.D-10)AK=UET(NK)*UET(NK)/AUTM
  267.  
  268. C     CALCUL DE LA MATRICE VITESSE
  269.          DO 82 I=1,2
  270.             DO 72 J=1,2
  271.                AF(J,I)=AK*AL1*AF(J,I)*R1
  272.  72         CONTINUE
  273.  82      CONTINUE
  274. C
  275. C     SATURATION VITESSE
  276. C
  277. C      IF(IPAT.LE.2)WRITE(IOIMP,*)' UTM=',UTM,AL1
  278.          DO 54 J=1,2
  279.             AF(1,J)=AF(1,J)*UT1
  280.             AF(2,J)=AF(2,J)*UT2
  281.  54      CONTINUE
  282.  
  283.          DO 65 I=1,2
  284.             NF=LE(I)
  285.             FF1=(AF(1,I)+AF(2,I))*AL1X/AL1
  286.             FF2=(AF(1,I)+AF(2,I))*AL1Y/AL1
  287. C     if(k.ge.10.AND.k.le.15)then
  288. C     WRITE(IOIMP,*)' FF1,FF2=',ff1,ff2
  289. C     endif
  290.             F(NF,1)=F(NF,1)+SIGN(FF1,UN(NF,1))
  291.             F(NF,2)=F(NF,2)+SIGN(FF2,UN(NF,2))
  292.  
  293. C------------------------------------------------------------------------
  294. C     CALCUL Q D M    FIN
  295. C------------------------------------------------------------------------
  296.  
  297.  65      CONTINUE
  298.  
  299. C
  300. C     CALCUL DE KP ET DE EPSILONP
  301. C
  302.          YPLUS2=-(YPLUS+0.01D0)*(YPLUS+0.01D0)*0.0017D0
  303.          DO 66 I=1,2
  304.             NF=LE(I)
  305.             DK(NF)=XGRAND
  306.             DE(NF)=XGRAND
  307.             TK(NF)=UET(NK)*UET(NK)/SQCNU
  308.             TE(NF)=UET(NK)*UET(NK)*UET(NK)/
  309.      &           (AKER*YP*(1.D0-EXP(YPLUS2)))
  310.  66      CONTINUE
  311.  
  312.  50   CONTINUE
  313.       RETURN
  314.  
  315. C                     *********
  316. C                     *   3D  *
  317. C                     *********
  318.  300  CONTINUE
  319.  
  320.       DO 350 K=1,NEL
  321.          NK=K0+K
  322.          KC=1+(1-IKC)*(NK-1)
  323. C
  324.          UTM=0.D0
  325.  
  326.          DO 35  I=1,NPF
  327.             NFA=IPADL(LEF(I,K))
  328.             UIX(I)=UN(NFA,1)+XPETIT
  329.             UIY(I)=UN(NFA,2)+XPETIT
  330.             UIZ(I)=UN(NFA,3)+XPETIT
  331.             UFI(I)=UIX(I)*UIX(I)+UIY(I)*UIY(I)+UIZ(I)*UIZ(I)
  332.             UFI(I)=SQRT(UFI(I))
  333.             UTM=UTM+UFI(I)
  334.  35      CONTINUE
  335.  
  336.          UTM=UTM/NPF
  337.  
  338.          AIRF=VOLF(NK)
  339. C
  340. C     CALCUL DE U ETOILE  A PARTIR UTM
  341. C
  342. C     --------------------CAROLI---I--------------------------
  343.          DO 357 I=1,2
  344.             YPLUS=YP*UET(NK)/ANUL
  345.             YPLUS=ABS(YPLUS)+1.D-5
  346.             IF(YPLUS.GT.100.0D0) THEN
  347.                UPLUS=5.5D0+(LOG(YPLUS))/0.41D0
  348.             ELSE
  349.                IY=INT(YPLUS)
  350.                RY=YPLUS-IY
  351.                UPLUS=UPIU(IY+1)+RY*(UPIU(IY+2)-UPIU(IY+1))
  352.             ENDIF
  353. C     ---- RELAX SU UET ------------------------------------
  354.             UET(NK)=0.5D0*UET(NK)+0.5D0*(ABS(UTM/(UPLUS+1.D-5)))
  355.  357     CONTINUE
  356. C     --------------------CAROLI----F------------------
  357.  
  358. C************************************************************************
  359. C     CALCUL Q D M
  360. C************************************************************************
  361.  
  362. C     CALCUL DU COEFFICIENT AK  A PARTIR DE UTM
  363.  
  364.          AUTM=ABS(UTM)
  365.          AK=0.D0
  366.          IF(AUTM.GT.1.D-10)AK=UET(NK)*UET(NK)/AUTM
  367. C
  368.          DO 365 I=1,NPF
  369.             NFA=IPADL(LEF(I,K))
  370.             F(NFA,1)=F(NFA,1)+AK/NPF*UIX(I)/UFI(I)*AIRF
  371.             F(NFA,2)=F(NFA,2)+AK/NPF*UIY(I)/UFI(I)*AIRF
  372.             F(NFA,3)=F(NFA,3)+AK/NPF*UIZ(I)/UFI(I)*AIRF
  373.  365     CONTINUE
  374. C------------------------------------------------------------------------
  375. C     CALCUL Q D M    FIN
  376. C------------------------------------------------------------------------
  377. C
  378. C     CALCUL DE KP ET DE EPSILONP
  379. C
  380.          YPLUS2=-(YPLUS+0.01D0)*(YPLUS+0.01D0)*0.0017D0
  381.          DO 366 I=1,NPF
  382.             NFA=IPADL(LEF(I,K))
  383.             DK(NFA)=XGRAND
  384.             DE(NFA)=XGRAND
  385.             TK(NFA)=UET(NK)*UET(NK)/SQCNU
  386.             TE(NFA)=UET(NK)*UET(NK)*UET(NK)/
  387.      &           (AKER*YP*(1.D0-EXP(YPLUS2)))
  388.  366     CONTINUE
  389.  
  390.  350  CONTINUE
  391.  
  392.       RETURN
  393.  
  394.  9990 CONTINUE
  395.       WRITE(IOIMP,*)' IKC ',IKC
  396.       WRITE(IOIMP,*)
  397.      $     ' COEF D''UN MAUVAIS TYPE : ON VEUT (SCAL OU VECT DOMA)'
  398.       CALL ARRET(0)
  399.       RETURN
  400.  1002 FORMAT(10(1X,1PE11.4))
  401.  1001 FORMAT(20(1X,I5))
  402.       END
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  

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