Télécharger la plaquette Cast3M


fr en

Télécharger zcvi.eso

Retour à la liste

Numérotation des lignes : 

zcvi

  1. C ZCVI      SOURCE    CHAT      05/01/13    04:21:47     5004
  2.       SUBROUTINE ZCVI
  3. C
  4. C
  5. C     VERSION VECTORISEE
  6. C
  7. C     Les {l{ments sont group{s en paquets de LRV {l{ments, LRV {tant
  8. C     la longueur des registres vectoriels de la machine cible, i.e
  9. C     64 sur Cray, 128 ou 256 sur IBM 3090VF. On prom}ne une fenetre
  10. C     de longueur LRV sur la boucle g{n{rale de longueur NEL.
  11. C
  12. C
  13.      & (HR,RPG,DRR,LE,NEL,K0,NPTD,IES,NP,IAXI,IKOMP,IKAS,
  14.      & COEFF,IK1,RGE,IKG,NELG,TN,IKT,TREF,IKREF,IPADS,
  15.      & UN,IPADU,NPTU,GN,F,IPADI,VF,IPADF,NPTF,
  16.      & VOLU,COTE,NELZ,IDCEN,IPG,
  17.      & DTM1,DT,DTT1,DTT2,NUEL,DIAEL,FN)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22. C***********************************************************************
  23. C
  24. C  CE SP DISCRETISE LES EQUATIONS DE NAVIER STOKES
  25. C    EN 2D SUR LES ELEMENTS QUA4 ET TRI3      PLAN OU AXI
  26. C    EN 3D SUR LES ELEMENTS CUB8 ET PRI6
  27. C  LES OPERATEURS SONT "SOUS-INTEGRES"
  28. C
  29. C  SYNTAXE :
  30. C
  31. C         NS(NU,UN,RGE,DE)  INCO GN :
  32. C
  33. C  COEFFICIENTS :
  34. C  --------------
  35. C
  36. C  UN(NPTD,IES)       CHAMPS DE VITESSE TRANSPORTANT
  37. C  COEFF(SCAL DOMA)  VISCOSITE CINEMATIQE MOLECULAIRE( NU )
  38. C       (SCAL ELEM)
  39. C   RGE(NELG,IES)       TERME SOURCE
  40. C
  41. C
  42. C  INCONNUES :
  43. C  -----------
  44. C
  45. C   UN(NPTD,IES)        CHAMPS DE VITESSE TRANSPORTANT
  46. C   GN(NPTD,IES)        CHAMPS DE VITESSE TRANSPORTE
  47. C   VN(NPTD,IES)        CHAMPS DE VITESSE DU FLUIDE
  48. C
  49. C
  50. C
  51. C
  52. C  TABLEAUX DE TRAVAIL :
  53. C  ---------------------        N     N-1
  54. C                     (D + D1) U - D U              N-1    T  N
  55. C                     -------------------  = F - A U    - C  P
  56. C                               DT
  57. C
  58. C                              N-1
  59. C   F(NPTD,IES)   CONTIENT   A U   - F     (VITESSE)
  60. C
  61. C
  62. C
  63. C***********************************************************************
  64.  
  65. -INC CCVQUA4
  66. -INC CCREEL
  67. *-
  68.  
  69. -INC PPARAM
  70. -INC CCOPTIO
  71. -INC SMCOORD
  72. C
  73. C Longueur des registres vectoriels de la machine cible
  74. C On prend 64 pour ne pas augmenter la taille des tableaux
  75. C n{cessaires @ la vectorisation.
  76. C
  77.       PARAMETER(LRV=64)
  78.  
  79.       DIMENSION UN(NPTU,IES),GN(NPTD,IES),VF(NPTF,IES)
  80.       DIMENSION TN(*),TREF(*)
  81.       DIMENSION COEFF(*),RGE(NELG,IES)
  82.       DIMENSION COTE(NELZ,IES),VOLU(NELZ),KLIP(100)
  83.  
  84.       DIMENSION IPADI(*),LE(NP,1),IPADU(*),IPADF(*),IPADS(*)
  85.       DIMENSION HR(NEL,NP,IES),RPG(1),DRR(NP,NEL)
  86.  
  87.       DIMENSION QGGT(8,8),Q1(8,8),Q2(8,8),Q3(8,8)
  88.  
  89.       DIMENSION COEF(LRV),AIRE(LRV)
  90.       DIMENSION WX(LRV,9),WY(LRV,9),WZ(LRV,9)
  91.       DIMENSION AL(LRV),AH(LRV),AP(LRV)
  92. C UIX,... vitesse transportante
  93.       DIMENSION UIX(LRV,9),UIY(LRV,9),UIZ(LRV,9)
  94. C GIX,... vitesse massique ou transportée ou inconnue du/dt
  95.       DIMENSION GIX(LRV,9),GIY(LRV,9),GIZ(LRV,9)
  96. C VIX,... vitesse du fluide
  97.       DIMENSION VIX(LRV,9),VIY(LRV,9),VIZ(LRV,9)
  98.  
  99.       DIMENSION UMI(LRV,3),VMI(LRV,3)
  100.       DIMENSION COEFT(LRV),RGX(LRV),RGY(LRV),RGZ(LRV)
  101.       DIMENSION TO1(LRV),TO2X(LRV),TO2Y(LRV)
  102.       DIMENSION SAF1(LRV,9),SAF2(LRV,9),SAF3(LRV,9)
  103.       DIMENSION CHGLD(LRV),CHGLPX(LRV),CHGLPY(LRV),CHGLPZ(LRV)
  104.  
  105.       DIMENSION F(NPTD,*),FN(NP,*)
  106.  
  107.       SAVE IPAS,QGGT,Q1,Q2,Q3
  108.       DATA IPAS/0/
  109.  
  110. C
  111. C           INITIALISATIONS DIVERSES
  112. C
  113. C     write(6,*)' DEBUT YCVI ',' IKAS=',ikas,' IKOMP=',ikomp,idcen
  114. C     write(6,*)' NPTD=',nptd,IPAS
  115.       IF(IPAS.EQ.0)CALL CALHRH(QGGT,Q1,Q2,Q3,IES)
  116.  
  117. C                           ********
  118. C                           *  2D  *
  119. C                           ********
  120.  
  121.       IF(IES.EQ.3)GO TO 10
  122.  
  123. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  124. C                           DIFFERENCES TRIANGLE / QUADRANGLE
  125.       IF(NP.EQ.4)THEN
  126.       QUA4=1.D0
  127.       ELSE
  128.       QUA4=0.D0
  129.       ENDIF
  130. C
  131. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  132.  
  133. C
  134. C Calcul du nombre de paquets de LRV {l{ments
  135. C
  136.       NNN=MOD(NEL,LRV)
  137.       IF(NNN.EQ.0) NPACK=NEL/LRV
  138.       IF(NNN.NE.0) NPACK=1+(NEL-NNN)/LRV
  139.       KPACKD=1
  140.       KPACKF=NPACK
  141. C
  142. C ******* BOUCLE SUR LES PAQUETS DE LRV ELEMENTS **********
  143. C
  144. C     write(6,*)' DEBUT YCVI 7001'
  145.       DO 7001 KPACK=KPACKD,KPACKF
  146. C
  147. C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  148. C
  149. C 1. Calcul des limites du paquet courant.
  150.       KDEB=1+(KPACK-1)*LRV
  151.       KFIN=MIN(NEL,KDEB+LRV-1)
  152. C
  153. C Ben voil@, on peut y aller ... i.e. traiter le paquet courant.
  154. C
  155.       DO 7002 K=KDEB,KFIN
  156.       KP=K-KDEB+1
  157.       NK=K+K0
  158.       K1=1+(1-IK1)*(NK-1)
  159.       COEF(KP)=COEFF(K1)
  160.       AIRE(KP)=VOLU(NK)
  161.       AL(KP)=COTE(NK,1)+XPETIT
  162.       AH(KP)=COTE(NK,2)+XPETIT
  163.  7002 CONTINUE
  164.  
  165. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  166.       DO 7006 I=1,NP
  167.       DO 7006 K=KDEB,KFIN
  168.       KP=K-KDEB+1
  169.       NU=IPADU(LE(I,K))
  170.       NG=IPADI(LE(I,K))
  171.       NF=IPADF(LE(I,K))
  172.       UIX(KP,I)=UN(NU,1)
  173.       UIY(KP,I)=UN(NU,2)
  174.       GIX(KP,I)=GN(NG,1)
  175.       GIY(KP,I)=GN(NG,2)
  176.       VIX(KP,I)=VF(NF,1)
  177.       VIY(KP,I)=VF(NF,2)
  178.  7006 CONTINUE
  179.  
  180.       CALL KSUPG1(WX,UMI,CHGLD,CHGLPX,KDEB,KFIN,LRV,
  181.      &GN(1,1),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  182.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,QUA4,IKOMP,
  183.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  184.  
  185.       CALL KSUPG1(WY,UMI,CHGLD,CHGLPY,KDEB,KFIN,LRV,
  186.      &GN(1,2),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  187.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,QUA4,IKOMP,
  188.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  189.  
  190. C
  191. C Initialisation des variables d'accumulation SAF1,SAF2,SBF
  192. C
  193.  
  194.       IF(IAXI.NE.0)THEN
  195.        DO 70050 N=1,IDIM
  196.        DO 70050 K=KDEB,KFIN
  197.        KP=K-KDEB+1
  198.        VMI(KP,N)=XPETIT
  199. 70050 CONTINUE
  200.        DO 70051 N=1,IDIM
  201.        DO 70051 I=1,NP
  202.        DO 70051 K=KDEB,KFIN
  203.        KP=K-KDEB+1
  204.        NF=IPADF(LE(I,K))
  205.        VMI(KP,N)=VMI(KP,N)+VF(NF,N)*DRR(I,K)
  206. 70051 CONTINUE
  207.        DO 70052 K=KDEB,KFIN
  208.        KP=K-KDEB+1
  209.        VMI(KP,1)=VMI(KP,1)/AIRE(KP)
  210.        VMI(KP,2)=VMI(KP,2)/AIRE(KP)
  211. 70052 CONTINUE
  212.       ENDIF
  213.  
  214.       IF(IKOMP.EQ.0)THEN
  215.  
  216.        IF(IKAS.EQ.1)THEN
  217.        DO 70061 I=1,NP
  218.        DO 70061 K=KDEB,KFIN
  219.        KP=K-KDEB+1
  220.        SAF1(KP,I)=0.D0
  221.        SAF2(KP,I)=0.D0
  222. 70061  CONTINUE
  223.        ELSEIF(IKAS.EQ.2)THEN
  224.        DO 70021 K=KDEB,KFIN
  225.        KP=K-KDEB+1
  226.        NK=K+K0
  227.        NKG=1+(1-IKG)*(NK-1)
  228.        RGX(KP)=RGE(NKG,1)
  229.        RGY(KP)=RGE(NKG,2)
  230. 70021  CONTINUE
  231.  
  232.        IF(IPG.EQ.0)THEN
  233.        DO 70062 I=1,NP
  234.        DO 70062 K=KDEB,KFIN
  235.        KP=K-KDEB+1
  236.        SAF1(KP,I)=(-RGX(KP))*DRR(I,K)
  237.        SAF2(KP,I)=(-RGY(KP))*DRR(I,K)
  238. 70062  CONTINUE
  239.        ELSE
  240.        DO 71062 I=1,NP
  241.        DO 71062 K=KDEB,KFIN
  242.        KP=K-KDEB+1
  243.        SAF1(KP,I)=(-RGX(KP))*WX(KP,I)
  244.        SAF2(KP,I)=(-RGY(KP))*WY(KP,I)
  245. 71062  CONTINUE
  246.        ENDIF
  247.  
  248.        ELSEIF(IKAS.EQ.4)THEN
  249.        DO 70022 K=KDEB,KFIN
  250.        KP=K-KDEB+1
  251.        NK=K+K0
  252.        NKG=1+(1-IKG)*(NK-1)
  253.        RGX(KP)=RGE(NKG,1)
  254.        RGY(KP)=RGE(NKG,2)
  255. 70022  CONTINUE
  256.  
  257.        IF(IPG.EQ.0)THEN
  258.        DO 70063 I=1,NP
  259.        DO 70063 K=KDEB,KFIN
  260.        KP=K-KDEB+1
  261.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  262.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  263. C?     write(6,*)' NF=',NF,' NFR=',nfr
  264.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  265.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  266. 70063  CONTINUE
  267.        ELSE
  268.        DO 71063 I=1,NP
  269.        DO 71063 K=KDEB,KFIN
  270.        KP=K-KDEB+1
  271.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  272.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  273.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*WX(KP,I)
  274.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*WY(KP,I)
  275. 71063  CONTINUE
  276.        ENDIF
  277.  
  278.        ENDIF
  279.  
  280.       ELSEIF(IKOMP.EQ.1)THEN
  281.  
  282.        IF(IKAS.EQ.2)THEN
  283.        DO 70064 I=1,NP
  284.        DO 70064 K=KDEB,KFIN
  285.        KP=K-KDEB+1
  286.        SAF1(KP,I)=0.D0
  287.        SAF2(KP,I)=0.D0
  288. 70064  CONTINUE
  289.  
  290.        ELSEIF(IKAS.EQ.3)THEN
  291.        DO 70024 K=KDEB,KFIN
  292.        KP=K-KDEB+1
  293.        NK=K+K0
  294.        NKG=1+(1-IKG)*(NK-1)
  295.        RGX(KP)=RGE(NKG,1)
  296.        RGY(KP)=RGE(NKG,2)
  297. 70024  CONTINUE
  298.  
  299.        IF(IPG.EQ.0)THEN
  300.        DO 70065 I=1,NP
  301.        DO 70065 K=KDEB,KFIN
  302.        KP=K-KDEB+1
  303.        SAF1(KP,I)=-RGX(KP)*DRR(I,K)
  304.        SAF2(KP,I)=-RGY(KP)*DRR(I,K)
  305. 70065  CONTINUE
  306.        ELSE
  307.        DO 71065 I=1,NP
  308.        DO 71065 K=KDEB,KFIN
  309.        KP=K-KDEB+1
  310.        SAF1(KP,I)=-RGX(KP)*WX(KP,I)
  311.        SAF2(KP,I)=-RGY(KP)*WY(KP,I)
  312. 71065  CONTINUE
  313.        ENDIF
  314.  
  315.        ENDIF
  316.  
  317.       ENDIF
  318.  
  319. C Le coeur du calcul ...
  320.  
  321.       IF(IKOMP.EQ.0)THEN
  322.  
  323.       DO 7014 I=1,NP
  324.       DO 7014 J= 1,NP
  325.       DO 7014 K=KDEB,KFIN
  326.       KP=K-KDEB+1
  327.  
  328.       ZVGGX=AIRE(KP)*CHGLPX(KP)*VGGT(J,I)
  329.  
  330.       ZVGGY=AIRE(KP)*CHGLPY(KP)*VGGT(J,I)
  331.  
  332.       ZVGT=AIRE(KP)*(
  333.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  334.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  335.      &+    CHGLD(KP)*VGGT(J,I) )
  336.  
  337.       V2=UMI(KP,1)*HR(K,J,1)+UMI(KP,2)*HR(K,J,2)
  338.  
  339.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*VIX(KP,J)
  340.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*VIY(KP,J)
  341.  
  342.  7014 CONTINUE
  343.  
  344.       ELSEIF(IKOMP.EQ.1)THEN
  345.  
  346.       DO 7015 I=1,NP
  347.       DO 7015 J= 1,NP
  348.       DO 7015 K=KDEB,KFIN
  349.       KP=K-KDEB+1
  350.       ZVGGX=AIRE(KP)*CHGLPX(KP)*VGGT(J,I)
  351.  
  352.       ZVGGY=AIRE(KP)*CHGLPY(KP)*VGGT(J,I)
  353.  
  354.       ZVGT=AIRE(KP)*(
  355.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  356.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  357.      &+    CHGLD(KP)*VGGT(J,I) )
  358.  
  359.       COEFT3=COEF(KP)/3.D0
  360.       ZVGUU=AIRE(KP)*(1.D0/AL(KP)/AL(KP)/12.D0
  361.      &     *VGGT(J,I)*QUA4  )*COEFT3*UIX(KP,J)
  362.       ZVGUV=AIRE(KP)*( HR(K,I,1)*HR(K,J,2))*COEFT3*UIY(KP,J)
  363.       ZVGVU=AIRE(KP)*( HR(K,I,2)*HR(K,J,1))*COEFT3*UIX(KP,J)
  364.       ZVGVV=AIRE(KP)*(1.D0/AH(KP)/AH(KP)/12.D0
  365.      &     *VGGT(J,I)*QUA4  )*COEFT3*UIY(KP,J)
  366.  
  367.       V2=UIX(KP,J)*HR(K,J,1)+UIY(KP,J)*HR(K,J,2)
  368.  
  369.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*UIX(KP,J)
  370.      &+ ZVGUU + ZVGUV
  371.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*UIY(KP,J)
  372.      &+ ZVGVU + ZVGVV
  373.  
  374.  7015 CONTINUE
  375.  
  376.       ENDIF
  377.  
  378.       IF(IAXI.NE.0) THEN
  379.  
  380.          DO 7016 I=1,NP
  381.          DO 7016 K=KDEB,KFIN
  382.          KP=K-KDEB+1
  383.  
  384.          R2=1.D0/RPG(K)/RPG(K)*WX(KP,I)
  385.         SAF1(KP,I)=SAF1(KP,I)+R2*COEF(KP)*VMI(KP,1)
  386.  
  387.  7016    CONTINUE
  388.  
  389.          IF(IKOMP.EQ.1)THEN
  390.          DO 7118 I=1,NP
  391.          DO 7118 K=KDEB,KFIN
  392.          KP=K-KDEB+1
  393.          R1=1.D0/RPG(K)*WY(KP,I)
  394.          SAF1(KP,I)=SAF1(KP,I)+R1*UMI(KP,1)*GIX(KP,I)
  395.          SAF2(KP,I)=SAF2(KP,I)+R1*UMI(KP,1)*GIY(KP,I)
  396.  7118    CONTINUE
  397.         ENDIF
  398.  
  399.       ENDIF
  400. C
  401. C     Fin de l'accumulation dans SAF1,SAF2.
  402. C     On ajoute ces incr{ments @ F.
  403. C
  404.       DO 7017 I=1,NP
  405.       DO 7017 K=KDEB,KFIN
  406.       KP=K-KDEB+1
  407.       NF=IPADI(LE(I,K))
  408.       F(NF,1)=F(NF,1)+SAF1(KP,I)
  409.       F(NF,2)=F(NF,2)+SAF2(KP,I)
  410.  7017 CONTINUE
  411.  
  412.  1960 FORMAT(/,' ***** SUB XCVTIT : IPAT=',I5,'  K=',I5,' *****')
  413.  1961 FORMAT(2X,I5,' * ',4(1X,I5))
  414.  1962 FORMAT(2X,8(1X,1PE11.4))
  415.  1964 FORMAT(4(1X,1PE11.4))
  416.  7001 CONTINUE
  417.  
  418. C     WRITE(6,*)' ********** FIN YCVI 2D *****************'
  419. C     CALL ARRET(0)
  420.       IPAS=1
  421.       RETURN
  422.  
  423. C                           ********
  424. C                           *  3D  *
  425. C                           ********
  426.  
  427.  10   CONTINUE
  428.  
  429. C::::::BENET:::SUPPRESION CORRECTION HOURGLASS POUR LES PRISME::29:01:91
  430.  
  431.       CUB8=0.D0
  432.       IF(NP.EQ.8)CUB8=1.D0
  433.  
  434. C
  435. C Calcul du nombre de paquets de LRV {l{ments
  436. C
  437.       NNN=MOD(NEL,LRV)
  438.       IF(NNN.EQ.0) NPACK=NEL/LRV
  439.       IF(NNN.NE.0) NPACK=1+(NEL-NNN)/LRV
  440.       KPACKD=1
  441.       KPACKF=NPACK
  442. C
  443. C ******* BOUCLE SUR LES PAQUETS DE LRV ELEMENTS **********
  444. C
  445.       DO 8001 KPACK=KPACKD,KPACKF
  446. C
  447. C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  448. C
  449. C 1. Calcul des limites du paquet courant.
  450.       KDEB=1+(KPACK-1)*LRV
  451.       KFIN=MIN(NEL,KDEB+LRV-1)
  452. C
  453. C Ben voil@, on peut y aller ... i.e. traiter le paquet courant.
  454. C
  455.       DO 8002 K=KDEB,KFIN
  456.       KP=K-KDEB+1
  457.       NK=K+K0
  458.       K1=1+(1-IK1)*(NK-1)
  459.       COEF(KP)=COEFF(K1)
  460.       AIRE(KP)=VOLU(NK)
  461.       AL(KP)=COTE(NK,1)+XPETIT
  462.       AH(KP)=COTE(NK,2)+XPETIT
  463.       AP(KP)=COTE(NK,3)+XPETIT
  464.  8002 CONTINUE
  465.  
  466. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  467. C Initialisation des UMI avant accumulation
  468.  
  469.       DO 8006 I=1,NP
  470.       DO 8006 K=KDEB,KFIN
  471.       KP=K-KDEB+1
  472.       NU=IPADU(LE(I,K))
  473.       NF=IPADF(LE(I,K))
  474.       NG=IPADI(LE(I,K))
  475.       UIX(KP,I)=UN(NU,1)
  476.       UIY(KP,I)=UN(NU,2)
  477.       UIZ(KP,I)=UN(NU,3)
  478.       VIX(KP,I)=VF(NF,1)
  479.       VIY(KP,I)=VF(NF,2)
  480.       VIZ(KP,I)=VF(NF,3)
  481.       GIX(KP,I)=GN(NG,1)
  482.       GIY(KP,I)=GN(NG,2)
  483.       GIZ(KP,I)=GN(NG,3)
  484.  8006 CONTINUE
  485.  
  486. C     write(6,*)'****************************'
  487. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  488.       CALL KSUPG1(WX,UMI,CHGLD,CHGLPX,KDEB,KFIN,LRV,
  489.      &GN(1,1),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  490.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  491.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  492. C     write(6,1002)umi
  493.  
  494. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  495.       CALL KSUPG1(WY,UMI,CHGLD,CHGLPY,KDEB,KFIN,LRV,
  496.      &GN(1,2),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  497.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  498.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  499.  
  500. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  501.       CALL KSUPG1(WZ,UMI,CHGLD,CHGLPZ,KDEB,KFIN,LRV,
  502.      &GN(1,3),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  503.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  504.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  505. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  506.  
  507. C
  508. C Initialisation des variables d'accumulation SAF1,SAF2,SBF
  509. C
  510.       IF(IKOMP.EQ.0)THEN
  511.  
  512.        IF(IKAS.EQ.1)THEN
  513.        DO 80061 I=1,NP
  514.        DO 80061 K=KDEB,KFIN
  515.        KP=K-KDEB+1
  516.        SAF1(KP,I)=0.D0
  517.        SAF2(KP,I)=0.D0
  518.        SAF3(KP,I)=0.D0
  519. 80061  CONTINUE
  520.        ELSEIF(IKAS.EQ.2)THEN
  521.        DO 80021 K=KDEB,KFIN
  522.        KP=K-KDEB+1
  523.        NK=K+K0
  524.        NKG=1+(1-IKG)*(NK-1)
  525.        RGX(KP)=RGE(NKG,1)
  526.        RGY(KP)=RGE(NKG,2)
  527.        RGZ(KP)=RGE(NKG,3)
  528. 80021  CONTINUE
  529.  
  530.        IF(IPG.EQ.0)THEN
  531.        DO 80062 I=1,NP
  532.        DO 80062 K=KDEB,KFIN
  533.        KP=K-KDEB+1
  534.        SAF1(KP,I)=(-RGX(KP))*DRR(I,K)
  535.        SAF2(KP,I)=(-RGY(KP))*DRR(I,K)
  536.        SAF3(KP,I)=(-RGZ(KP))*DRR(I,K)
  537. 80062  CONTINUE
  538.        ELSE
  539.        DO 81062 I=1,NP
  540.        DO 81062 K=KDEB,KFIN
  541.        KP=K-KDEB+1
  542.        SAF1(KP,I)=(-RGX(KP))*WX(KP,I)
  543.        SAF2(KP,I)=(-RGY(KP))*WY(KP,I)
  544.        SAF3(KP,I)=(-RGZ(KP))*WZ(KP,I)
  545. 81062  CONTINUE
  546.        ENDIF
  547.  
  548.        ELSEIF(IKAS.EQ.4)THEN
  549.        DO 80022 K=KDEB,KFIN
  550.        KP=K-KDEB+1
  551.        NK=K+K0
  552.        NKG=1+(1-IKG)*(NK-1)
  553.        RGX(KP)=RGE(NKG,1)
  554.        RGY(KP)=RGE(NKG,2)
  555.        RGZ(KP)=RGE(NKG,3)
  556. 80022  CONTINUE
  557.  
  558.        IF(IPG.EQ.0)THEN
  559.        DO 80063 I=1,NP
  560.        DO 80063 K=KDEB,KFIN
  561.        KP=K-KDEB+1
  562.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  563.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  564.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  565.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  566.        SAF3(KP,I)=(-RGZ(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  567. 80063  CONTINUE
  568.        ELSE
  569.        DO 81063 I=1,NP
  570.        DO 81063 K=KDEB,KFIN
  571.        KP=K-KDEB+1
  572.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  573.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  574.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*WX(KP,I)
  575.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*WY(KP,I)
  576.        SAF3(KP,I)=(-RGZ(KP)*(TREF(NFR)-TN(NF)))*WZ(KP,I)
  577. 81063  CONTINUE
  578.        ENDIF
  579.  
  580.        ENDIF
  581.  
  582.       ELSEIF(IKOMP.EQ.1)THEN
  583.  
  584.        IF(IKAS.EQ.2)THEN
  585.        DO 80064 I=1,NP
  586.        DO 80064 K=KDEB,KFIN
  587.        KP=K-KDEB+1
  588.        SAF1(KP,I)=0.D0
  589.        SAF2(KP,I)=0.D0
  590.        SAF3(KP,I)=0.D0
  591. 80064  CONTINUE
  592.  
  593.        ELSEIF(IKAS.EQ.3)THEN
  594.        DO 80024 K=KDEB,KFIN
  595.        KP=K-KDEB+1
  596.        NK=K+K0
  597.        NKG=1+(1-IKG)*(NK-1)
  598.        RGX(KP)=RGE(NKG,1)
  599.        RGY(KP)=RGE(NKG,2)
  600.        RGZ(KP)=RGE(NKG,3)
  601. 80024  CONTINUE
  602.  
  603.        IF(IPG.EQ.0)THEN
  604.        DO 80065 I=1,NP
  605.        DO 80065 K=KDEB,KFIN
  606.        KP=K-KDEB+1
  607.        SAF1(KP,I)=-RGX(KP)*DRR(I,K)
  608.        SAF2(KP,I)=-RGY(KP)*DRR(I,K)
  609.        SAF3(KP,I)=-RGZ(KP)*DRR(I,K)
  610. 80065  CONTINUE
  611.        ELSE
  612.        DO 81065 I=1,NP
  613.        DO 81065 K=KDEB,KFIN
  614.        KP=K-KDEB+1
  615.        SAF1(KP,I)=-RGX(KP)*WX(KP,I)
  616.        SAF2(KP,I)=-RGY(KP)*WY(KP,I)
  617.        SAF3(KP,I)=-RGZ(KP)*WZ(KP,I)
  618. 81065  CONTINUE
  619.        ENDIF
  620.  
  621.        ENDIF
  622.  
  623.       ENDIF
  624.  
  625. C Le coeur du calcul ...
  626.  
  627.       IF(IKOMP.EQ.0)THEN
  628.  
  629.       DO 8014 I=1,NP
  630.       DO 8014 J= 1,NP
  631.       DO 8014 K=KDEB,KFIN
  632.       KP=K-KDEB+1
  633.  
  634.       ZVGGX=AIRE(KP)*CHGLPX(KP)*QGGT(J,I)
  635.  
  636.       ZVGGY=AIRE(KP)*CHGLPY(KP)*QGGT(J,I)
  637.  
  638.       ZVGGZ=AIRE(KP)*CHGLPZ(KP)*QGGT(J,I)
  639.  
  640.       ZVGT=AIRE(KP)*(
  641.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  642.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  643.      &+    HR(K,I,3)*HR(K,J,3)*COEF(KP) )
  644.      &+    CHGLD(KP)*QGGT(J,I)
  645.  
  646.       V2=UMI(KP,1)*HR(K,J,1)+UMI(KP,2)*HR(K,J,2)
  647.      &  +UMI(KP,3)*HR(K,J,3)
  648.  
  649.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*VIX(KP,J)
  650.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*VIY(KP,J)
  651.       SAF3(KP,I)=SAF3(KP,I)+(V2*WZ(KP,I)+ZVGGZ)*GIZ(KP,J)+ZVGT*VIZ(KP,J)
  652.  
  653.  8014 CONTINUE
  654.  
  655.       ELSEIF(IKOMP.EQ.1)THEN
  656.  
  657.       DO 8015 I=1,NP
  658.       DO 8015 J= 1,NP
  659.       DO 8015 K=KDEB,KFIN
  660.       KP=K-KDEB+1
  661.  
  662.       ZVGGX=AIRE(KP)*CHGLPX(KP)*QGGT(J,I)
  663.  
  664.       ZVGGY=AIRE(KP)*CHGLPY(KP)*QGGT(J,I)
  665.  
  666.       ZVGGZ=AIRE(KP)*CHGLPZ(KP)*QGGT(J,I)
  667.  
  668.       ZVGT=AIRE(KP)*(
  669.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  670.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  671.      &+    HR(K,I,3)*HR(K,J,3)*COEF(KP) )
  672.      &+    CHGLD(KP)*QGGT(J,I)
  673.  
  674.       COEFT3=COEF(KP)/3.D0
  675.       GEO1=0.D0
  676.       ZVGUU=(AIRE(KP)*(HR(K,I,1)*HR(K,J,1))+GEO1)*COEFT3*UIX(KP,J)
  677.       ZVGUV=AIRE(KP)*( HR(K,I,1)*HR(K,J,2))*COEFT3*UIY(KP,J)
  678.       ZVGUW=AIRE(KP)*( HR(K,I,1)*HR(K,J,3))*COEFT3*UIZ(KP,J)
  679.       ZVGVU=AIRE(KP)*( HR(K,I,2)*HR(K,J,1))*COEFT3*UIX(KP,J)
  680.       ZVGVV=(AIRE(KP)*(HR(K,I,2)*HR(K,J,2))+GEO1)*COEFT3*UIY(KP,J)
  681.       ZVGVW=AIRE(KP)*( HR(K,I,2)*HR(K,J,3))*COEFT3*UIZ(KP,J)
  682.       ZVGWU=AIRE(KP)*( HR(K,I,3)*HR(K,J,1))*COEFT3*UIX(KP,J)
  683.       ZVGWV=AIRE(KP)*( HR(K,I,3)*HR(K,J,2))*COEFT3*UIY(KP,J)
  684.       ZVGWW=(AIRE(KP)*(HR(K,I,3)*HR(K,J,3))+GEO1)*COEFT3*UIZ(KP,J)
  685.  
  686.       V2=(UIX(KP,J)*HR(K,J,1)+UIY(KP,J)*HR(K,J,2)+UIZ(KP,J)*HR(K,J,3))
  687.      &   *WZ(KP,I)
  688.  
  689.       SAF1(KP,I)=SAF1(KP,I)+(V2+ZVGGX)*GIX(KP,J)+ZVGT*UIX(KP,J)
  690.      &+ ZVGUU + ZVGUV + ZVGUW
  691.       SAF2(KP,I)=SAF2(KP,I)+(V2+ZVGGY)*GIY(KP,J)+ZVGT*UIY(KP,J)
  692.      &+ ZVGVU + ZVGUV + ZVGVW
  693.       SAF3(KP,I)=SAF3(KP,I)+(V2+ZVGGZ)*GIZ(KP,J)+ZVGT*UIZ(KP,J)
  694.      &+ ZVGWU + ZVGWV + ZVGWW
  695.  
  696.  8015 CONTINUE
  697.  
  698.       ENDIF
  699.  
  700. C
  701. C     Fin de l'accumulation dans SAF1,SAF2.
  702. C     On ajoute ces incr{ments @ F.
  703. C
  704.       DO 8017 I=1,NP
  705.       DO 8017 K=KDEB,KFIN
  706.       KP=K-KDEB+1
  707.       NF=IPADI(LE(I,K))
  708.       F(NF,1)=F(NF,1)+SAF1(KP,I)
  709.       F(NF,2)=F(NF,2)+SAF2(KP,I)
  710.       F(NF,3)=F(NF,3)+SAF3(KP,I)
  711.  8017 CONTINUE
  712.  
  713.  8001 CONTINUE
  714.  
  715. C     WRITE(6,*)' ********** FIN YCVI 3D *****************'
  716.  
  717.       IPAS=1
  718.       RETURN
  719.  1002 FORMAT(10(1X,1PE11.4))
  720.  1001 FORMAT(20(1X,I5))
  721.       END
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  

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