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    CB215821  26/08/24    21:19:03     12622          
  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 81066 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. 81066 CONTINUE
  180.  
  181.       CALL KSUPG1(WX,UMI,CHGLD,CHGLPX,KDEB,KFIN,LRV,
  182.      &GN(1,1),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  183.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,QUA4,IKOMP,
  184.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  185.  
  186.       CALL KSUPG1(WY,UMI,CHGLD,CHGLPY,KDEB,KFIN,LRV,
  187.      &GN(1,2),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  188.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,QUA4,IKOMP,
  189.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  190.  
  191. C
  192. C Initialisation des variables d'accumulation SAF1,SAF2,SBF
  193. C
  194.  
  195.       IF(IAXI.NE.0)THEN
  196.        DO 81067 N=1,IDIM
  197.        DO 70050 K=KDEB,KFIN
  198.        KP=K-KDEB+1
  199.        VMI(KP,N)=XPETIT
  200. 70050 CONTINUE
  201. 81067  CONTINUE
  202.        DO 81069 N=1,IDIM
  203.        DO 81068 I=1,NP
  204.        DO 70051 K=KDEB,KFIN
  205.        KP=K-KDEB+1
  206.        NF=IPADF(LE(I,K))
  207.        VMI(KP,N)=VMI(KP,N)+VF(NF,N)*DRR(I,K)
  208. 70051 CONTINUE
  209. 81068  CONTINUE
  210. 81069  CONTINUE
  211.        DO 70052 K=KDEB,KFIN
  212.        KP=K-KDEB+1
  213.        VMI(KP,1)=VMI(KP,1)/AIRE(KP)
  214.        VMI(KP,2)=VMI(KP,2)/AIRE(KP)
  215. 70052 CONTINUE
  216.       ENDIF
  217.  
  218.       IF(IKOMP.EQ.0)THEN
  219.  
  220.        IF(IKAS.EQ.1)THEN
  221.        DO 81070 I=1,NP
  222.        DO 70061 K=KDEB,KFIN
  223.        KP=K-KDEB+1
  224.        SAF1(KP,I)=0.D0
  225.        SAF2(KP,I)=0.D0
  226. 70061  CONTINUE
  227. 81070  CONTINUE
  228.        ELSEIF(IKAS.EQ.2)THEN
  229.        DO 70021 K=KDEB,KFIN
  230.        KP=K-KDEB+1
  231.        NK=K+K0
  232.        NKG=1+(1-IKG)*(NK-1)
  233.        RGX(KP)=RGE(NKG,1)
  234.        RGY(KP)=RGE(NKG,2)
  235. 70021  CONTINUE
  236.  
  237.        IF(IPG.EQ.0)THEN
  238.        DO 81071 I=1,NP
  239.        DO 70062 K=KDEB,KFIN
  240.        KP=K-KDEB+1
  241.        SAF1(KP,I)=(-RGX(KP))*DRR(I,K)
  242.        SAF2(KP,I)=(-RGY(KP))*DRR(I,K)
  243. 70062  CONTINUE
  244. 81071  CONTINUE
  245.        ELSE
  246.        DO 81072 I=1,NP
  247.        DO 71062 K=KDEB,KFIN
  248.        KP=K-KDEB+1
  249.        SAF1(KP,I)=(-RGX(KP))*WX(KP,I)
  250.        SAF2(KP,I)=(-RGY(KP))*WY(KP,I)
  251. 71062  CONTINUE
  252. 81072  CONTINUE
  253.        ENDIF
  254.  
  255.        ELSEIF(IKAS.EQ.4)THEN
  256.        DO 70022 K=KDEB,KFIN
  257.        KP=K-KDEB+1
  258.        NK=K+K0
  259.        NKG=1+(1-IKG)*(NK-1)
  260.        RGX(KP)=RGE(NKG,1)
  261.        RGY(KP)=RGE(NKG,2)
  262. 70022  CONTINUE
  263.  
  264.        IF(IPG.EQ.0)THEN
  265.        DO 81073 I=1,NP
  266.        DO 70063 K=KDEB,KFIN
  267.        KP=K-KDEB+1
  268.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  269.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  270. C?     write(6,*)' NF=',NF,' NFR=',nfr
  271.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  272.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  273. 70063  CONTINUE
  274. 81073  CONTINUE
  275.        ELSE
  276.        DO 81074 I=1,NP
  277.        DO 71063 K=KDEB,KFIN
  278.        KP=K-KDEB+1
  279.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  280.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  281.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*WX(KP,I)
  282.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*WY(KP,I)
  283. 71063  CONTINUE
  284. 81074  CONTINUE
  285.        ENDIF
  286.  
  287.        ENDIF
  288.  
  289.       ELSEIF(IKOMP.EQ.1)THEN
  290.  
  291.        IF(IKAS.EQ.2)THEN
  292.        DO 81075 I=1,NP
  293.        DO 70064 K=KDEB,KFIN
  294.        KP=K-KDEB+1
  295.        SAF1(KP,I)=0.D0
  296.        SAF2(KP,I)=0.D0
  297. 70064  CONTINUE
  298. 81075  CONTINUE
  299.  
  300.        ELSEIF(IKAS.EQ.3)THEN
  301.        DO 70024 K=KDEB,KFIN
  302.        KP=K-KDEB+1
  303.        NK=K+K0
  304.        NKG=1+(1-IKG)*(NK-1)
  305.        RGX(KP)=RGE(NKG,1)
  306.        RGY(KP)=RGE(NKG,2)
  307. 70024  CONTINUE
  308.  
  309.        IF(IPG.EQ.0)THEN
  310.        DO 81076 I=1,NP
  311.        DO 70065 K=KDEB,KFIN
  312.        KP=K-KDEB+1
  313.        SAF1(KP,I)=-RGX(KP)*DRR(I,K)
  314.        SAF2(KP,I)=-RGY(KP)*DRR(I,K)
  315. 70065  CONTINUE
  316. 81076  CONTINUE
  317.        ELSE
  318.        DO 81077 I=1,NP
  319.        DO 71065 K=KDEB,KFIN
  320.        KP=K-KDEB+1
  321.        SAF1(KP,I)=-RGX(KP)*WX(KP,I)
  322.        SAF2(KP,I)=-RGY(KP)*WY(KP,I)
  323. 71065  CONTINUE
  324. 81077  CONTINUE
  325.        ENDIF
  326.  
  327.        ENDIF
  328.  
  329.       ENDIF
  330.  
  331. C Le coeur du calcul ...
  332.  
  333.       IF(IKOMP.EQ.0)THEN
  334.  
  335.       DO 81079 I=1,NP
  336.       DO 81078 J= 1,NP
  337.       DO 7014 K=KDEB,KFIN
  338.       KP=K-KDEB+1
  339.  
  340.       ZVGGX=AIRE(KP)*CHGLPX(KP)*VGGT(J,I)
  341.  
  342.       ZVGGY=AIRE(KP)*CHGLPY(KP)*VGGT(J,I)
  343.  
  344.       ZVGT=AIRE(KP)*(
  345.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  346.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  347.      &+    CHGLD(KP)*VGGT(J,I) )
  348.  
  349.       V2=UMI(KP,1)*HR(K,J,1)+UMI(KP,2)*HR(K,J,2)
  350.  
  351.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*VIX(KP,J)
  352.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*VIY(KP,J)
  353.  
  354.  7014 CONTINUE
  355. 81078 CONTINUE
  356. 81079 CONTINUE
  357.  
  358.       ELSEIF(IKOMP.EQ.1)THEN
  359.  
  360.       DO 81081 I=1,NP
  361.       DO 81080 J= 1,NP
  362.       DO 7015 K=KDEB,KFIN
  363.       KP=K-KDEB+1
  364.       ZVGGX=AIRE(KP)*CHGLPX(KP)*VGGT(J,I)
  365.  
  366.       ZVGGY=AIRE(KP)*CHGLPY(KP)*VGGT(J,I)
  367.  
  368.       ZVGT=AIRE(KP)*(
  369.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  370.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  371.      &+    CHGLD(KP)*VGGT(J,I) )
  372.  
  373.       COEFT3=COEF(KP)/3.D0
  374.       ZVGUU=AIRE(KP)*(1.D0/AL(KP)/AL(KP)/12.D0
  375.      &     *VGGT(J,I)*QUA4  )*COEFT3*UIX(KP,J)
  376.       ZVGUV=AIRE(KP)*( HR(K,I,1)*HR(K,J,2))*COEFT3*UIY(KP,J)
  377.       ZVGVU=AIRE(KP)*( HR(K,I,2)*HR(K,J,1))*COEFT3*UIX(KP,J)
  378.       ZVGVV=AIRE(KP)*(1.D0/AH(KP)/AH(KP)/12.D0
  379.      &     *VGGT(J,I)*QUA4  )*COEFT3*UIY(KP,J)
  380.  
  381.       V2=UIX(KP,J)*HR(K,J,1)+UIY(KP,J)*HR(K,J,2)
  382.  
  383.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*UIX(KP,J)
  384.      &+ ZVGUU + ZVGUV
  385.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*UIY(KP,J)
  386.      &+ ZVGVU + ZVGVV
  387.  
  388.  7015 CONTINUE
  389. 81080 CONTINUE
  390. 81081 CONTINUE
  391.  
  392.       ENDIF
  393.  
  394.       IF(IAXI.NE.0) THEN
  395.  
  396.          DO 81082 I=1,NP
  397.          DO 7016 K=KDEB,KFIN
  398.          KP=K-KDEB+1
  399.  
  400.          R2=1.D0/RPG(K)/RPG(K)*WX(KP,I)
  401.         SAF1(KP,I)=SAF1(KP,I)+R2*COEF(KP)*VMI(KP,1)
  402.  
  403.  7016    CONTINUE
  404. 81082    CONTINUE
  405.  
  406.          IF(IKOMP.EQ.1)THEN
  407.          DO 81083 I=1,NP
  408.          DO 7118 K=KDEB,KFIN
  409.          KP=K-KDEB+1
  410.          R1=1.D0/RPG(K)*WY(KP,I)
  411.          SAF1(KP,I)=SAF1(KP,I)+R1*UMI(KP,1)*GIX(KP,I)
  412.          SAF2(KP,I)=SAF2(KP,I)+R1*UMI(KP,1)*GIY(KP,I)
  413.  7118    CONTINUE
  414. 81083    CONTINUE
  415.         ENDIF
  416.  
  417.       ENDIF
  418. C
  419. C     Fin de l'accumulation dans SAF1,SAF2.
  420. C     On ajoute ces incr{ments @ F.
  421. C
  422.       DO 81084 I=1,NP
  423.       DO 7017 K=KDEB,KFIN
  424.       KP=K-KDEB+1
  425.       NF=IPADI(LE(I,K))
  426.       F(NF,1)=F(NF,1)+SAF1(KP,I)
  427.       F(NF,2)=F(NF,2)+SAF2(KP,I)
  428.  7017 CONTINUE
  429. 81084 CONTINUE
  430.  
  431.  1960 FORMAT(/,' ***** SUB XCVTIT : IPAT=',I5,'  K=',I5,' *****')
  432.  1961 FORMAT(2X,I5,' * ',4(1X,I5))
  433.  1962 FORMAT(2X,8(1X,1PE11.4))
  434.  1964 FORMAT(4(1X,1PE11.4))
  435.  7001 CONTINUE
  436.  
  437. C     WRITE(6,*)' ********** FIN YCVI 2D *****************'
  438. C     CALL ARRET(0)
  439.       IPAS=1
  440.       RETURN
  441.  
  442. C                           ********
  443. C                           *  3D  *
  444. C                           ********
  445.  
  446.  10   CONTINUE
  447.  
  448. C::::::BENET:::SUPPRESION CORRECTION HOURGLASS POUR LES PRISME::29:01:91
  449.  
  450.       CUB8=0.D0
  451.       IF(NP.EQ.8)CUB8=1.D0
  452.  
  453. C
  454. C Calcul du nombre de paquets de LRV {l{ments
  455. C
  456.       NNN=MOD(NEL,LRV)
  457.       IF(NNN.EQ.0) NPACK=NEL/LRV
  458.       IF(NNN.NE.0) NPACK=1+(NEL-NNN)/LRV
  459.       KPACKD=1
  460.       KPACKF=NPACK
  461. C
  462. C ******* BOUCLE SUR LES PAQUETS DE LRV ELEMENTS **********
  463. C
  464.       DO 8001 KPACK=KPACKD,KPACKF
  465. C
  466. C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  467. C
  468. C 1. Calcul des limites du paquet courant.
  469.       KDEB=1+(KPACK-1)*LRV
  470.       KFIN=MIN(NEL,KDEB+LRV-1)
  471. C
  472. C Ben voil@, on peut y aller ... i.e. traiter le paquet courant.
  473. C
  474.       DO 8002 K=KDEB,KFIN
  475.       KP=K-KDEB+1
  476.       NK=K+K0
  477.       K1=1+(1-IK1)*(NK-1)
  478.       COEF(KP)=COEFF(K1)
  479.       AIRE(KP)=VOLU(NK)
  480.       AL(KP)=COTE(NK,1)+XPETIT
  481.       AH(KP)=COTE(NK,2)+XPETIT
  482.       AP(KP)=COTE(NK,3)+XPETIT
  483.  8002 CONTINUE
  484.  
  485. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  486. C Initialisation des UMI avant accumulation
  487.  
  488.       DO 81085 I=1,NP
  489.       DO 8006 K=KDEB,KFIN
  490.       KP=K-KDEB+1
  491.       NU=IPADU(LE(I,K))
  492.       NF=IPADF(LE(I,K))
  493.       NG=IPADI(LE(I,K))
  494.       UIX(KP,I)=UN(NU,1)
  495.       UIY(KP,I)=UN(NU,2)
  496.       UIZ(KP,I)=UN(NU,3)
  497.       VIX(KP,I)=VF(NF,1)
  498.       VIY(KP,I)=VF(NF,2)
  499.       VIZ(KP,I)=VF(NF,3)
  500.       GIX(KP,I)=GN(NG,1)
  501.       GIY(KP,I)=GN(NG,2)
  502.       GIZ(KP,I)=GN(NG,3)
  503.  8006 CONTINUE
  504. 81085 CONTINUE
  505.  
  506. C     write(6,*)'****************************'
  507. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  508.       CALL KSUPG1(WX,UMI,CHGLD,CHGLPX,KDEB,KFIN,LRV,
  509.      &GN(1,1),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  510.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  511.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  512. C     write(6,1002)umi
  513.  
  514. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  515.       CALL KSUPG1(WY,UMI,CHGLD,CHGLPY,KDEB,KFIN,LRV,
  516.      &GN(1,2),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  517.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  518.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  519.  
  520. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  521.       CALL KSUPG1(WZ,UMI,CHGLD,CHGLPZ,KDEB,KFIN,LRV,
  522.      &GN(1,3),IPADI,UN,COEF,NPTD,NEL,NP,DRR,HR,FN,
  523.      &AIRE,AL,AH,AP,IDCEN,IPADU,LE,CUB8,IKOMP,
  524.      &DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  525. C     write(6,*)' DT,DTT1,DTT2=',DT,DTT1,DTT2
  526.  
  527. C
  528. C Initialisation des variables d'accumulation SAF1,SAF2,SBF
  529. C
  530.       IF(IKOMP.EQ.0)THEN
  531.  
  532.        IF(IKAS.EQ.1)THEN
  533.        DO 81086 I=1,NP
  534.        DO 80061 K=KDEB,KFIN
  535.        KP=K-KDEB+1
  536.        SAF1(KP,I)=0.D0
  537.        SAF2(KP,I)=0.D0
  538.        SAF3(KP,I)=0.D0
  539. 80061  CONTINUE
  540. 81086  CONTINUE
  541.        ELSEIF(IKAS.EQ.2)THEN
  542.        DO 80021 K=KDEB,KFIN
  543.        KP=K-KDEB+1
  544.        NK=K+K0
  545.        NKG=1+(1-IKG)*(NK-1)
  546.        RGX(KP)=RGE(NKG,1)
  547.        RGY(KP)=RGE(NKG,2)
  548.        RGZ(KP)=RGE(NKG,3)
  549. 80021  CONTINUE
  550.  
  551.        IF(IPG.EQ.0)THEN
  552.        DO 81087 I=1,NP
  553.        DO 80062 K=KDEB,KFIN
  554.        KP=K-KDEB+1
  555.        SAF1(KP,I)=(-RGX(KP))*DRR(I,K)
  556.        SAF2(KP,I)=(-RGY(KP))*DRR(I,K)
  557.        SAF3(KP,I)=(-RGZ(KP))*DRR(I,K)
  558. 80062  CONTINUE
  559. 81087  CONTINUE
  560.        ELSE
  561.        DO 81088 I=1,NP
  562.        DO 81062 K=KDEB,KFIN
  563.        KP=K-KDEB+1
  564.        SAF1(KP,I)=(-RGX(KP))*WX(KP,I)
  565.        SAF2(KP,I)=(-RGY(KP))*WY(KP,I)
  566.        SAF3(KP,I)=(-RGZ(KP))*WZ(KP,I)
  567. 81062  CONTINUE
  568. 81088  CONTINUE
  569.        ENDIF
  570.  
  571.        ELSEIF(IKAS.EQ.4)THEN
  572.        DO 80022 K=KDEB,KFIN
  573.        KP=K-KDEB+1
  574.        NK=K+K0
  575.        NKG=1+(1-IKG)*(NK-1)
  576.        RGX(KP)=RGE(NKG,1)
  577.        RGY(KP)=RGE(NKG,2)
  578.        RGZ(KP)=RGE(NKG,3)
  579. 80022  CONTINUE
  580.  
  581.        IF(IPG.EQ.0)THEN
  582.        DO 81089 I=1,NP
  583.        DO 80063 K=KDEB,KFIN
  584.        KP=K-KDEB+1
  585.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  586.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  587.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  588.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  589.        SAF3(KP,I)=(-RGZ(KP)*(TREF(NFR)-TN(NF)))*DRR(I,K)
  590. 80063  CONTINUE
  591. 81089  CONTINUE
  592.        ELSE
  593.        DO 81090 I=1,NP
  594.        DO 81063 K=KDEB,KFIN
  595.        KP=K-KDEB+1
  596.        NF=1+(1-IKT)*(IPADS(LE(I,K))-1)
  597.        NFR=1+(1-IKREF)*(IPADS(LE(I,K))-1)
  598.        SAF1(KP,I)=(-RGX(KP)*(TREF(NFR)-TN(NF)))*WX(KP,I)
  599.        SAF2(KP,I)=(-RGY(KP)*(TREF(NFR)-TN(NF)))*WY(KP,I)
  600.        SAF3(KP,I)=(-RGZ(KP)*(TREF(NFR)-TN(NF)))*WZ(KP,I)
  601. 81063  CONTINUE
  602. 81090  CONTINUE
  603.        ENDIF
  604.  
  605.        ENDIF
  606.  
  607.       ELSEIF(IKOMP.EQ.1)THEN
  608.  
  609.        IF(IKAS.EQ.2)THEN
  610.        DO 81091 I=1,NP
  611.        DO 80064 K=KDEB,KFIN
  612.        KP=K-KDEB+1
  613.        SAF1(KP,I)=0.D0
  614.        SAF2(KP,I)=0.D0
  615.        SAF3(KP,I)=0.D0
  616. 80064  CONTINUE
  617. 81091  CONTINUE
  618.  
  619.        ELSEIF(IKAS.EQ.3)THEN
  620.        DO 80024 K=KDEB,KFIN
  621.        KP=K-KDEB+1
  622.        NK=K+K0
  623.        NKG=1+(1-IKG)*(NK-1)
  624.        RGX(KP)=RGE(NKG,1)
  625.        RGY(KP)=RGE(NKG,2)
  626.        RGZ(KP)=RGE(NKG,3)
  627. 80024  CONTINUE
  628.  
  629.        IF(IPG.EQ.0)THEN
  630.        DO 81092 I=1,NP
  631.        DO 80065 K=KDEB,KFIN
  632.        KP=K-KDEB+1
  633.        SAF1(KP,I)=-RGX(KP)*DRR(I,K)
  634.        SAF2(KP,I)=-RGY(KP)*DRR(I,K)
  635.        SAF3(KP,I)=-RGZ(KP)*DRR(I,K)
  636. 80065  CONTINUE
  637. 81092  CONTINUE
  638.        ELSE
  639.        DO 81093 I=1,NP
  640.        DO 81065 K=KDEB,KFIN
  641.        KP=K-KDEB+1
  642.        SAF1(KP,I)=-RGX(KP)*WX(KP,I)
  643.        SAF2(KP,I)=-RGY(KP)*WY(KP,I)
  644.        SAF3(KP,I)=-RGZ(KP)*WZ(KP,I)
  645. 81065  CONTINUE
  646. 81093  CONTINUE
  647.        ENDIF
  648.  
  649.        ENDIF
  650.  
  651.       ENDIF
  652.  
  653. C Le coeur du calcul ...
  654.  
  655.       IF(IKOMP.EQ.0)THEN
  656.  
  657.       DO 81095 I=1,NP
  658.       DO 81094 J= 1,NP
  659.       DO 8014 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.       V2=UMI(KP,1)*HR(K,J,1)+UMI(KP,2)*HR(K,J,2)
  675.      &  +UMI(KP,3)*HR(K,J,3)
  676.  
  677.       SAF1(KP,I)=SAF1(KP,I)+(V2*WX(KP,I)+ZVGGX)*GIX(KP,J)+ZVGT*VIX(KP,J)
  678.       SAF2(KP,I)=SAF2(KP,I)+(V2*WY(KP,I)+ZVGGY)*GIY(KP,J)+ZVGT*VIY(KP,J)
  679.       SAF3(KP,I)=SAF3(KP,I)+(V2*WZ(KP,I)+ZVGGZ)*GIZ(KP,J)+ZVGT*VIZ(KP,J)
  680.  
  681.  8014 CONTINUE
  682. 81094 CONTINUE
  683. 81095 CONTINUE
  684.  
  685.       ELSEIF(IKOMP.EQ.1)THEN
  686.  
  687.       DO 81097 I=1,NP
  688.       DO 81096 J= 1,NP
  689.       DO 8015 K=KDEB,KFIN
  690.       KP=K-KDEB+1
  691.  
  692.       ZVGGX=AIRE(KP)*CHGLPX(KP)*QGGT(J,I)
  693.  
  694.       ZVGGY=AIRE(KP)*CHGLPY(KP)*QGGT(J,I)
  695.  
  696.       ZVGGZ=AIRE(KP)*CHGLPZ(KP)*QGGT(J,I)
  697.  
  698.       ZVGT=AIRE(KP)*(
  699.      &     HR(K,I,1)*HR(K,J,1)*COEF(KP)
  700.      &+    HR(K,I,2)*HR(K,J,2)*COEF(KP)
  701.      &+    HR(K,I,3)*HR(K,J,3)*COEF(KP) )
  702.      &+    CHGLD(KP)*QGGT(J,I)
  703.  
  704.       COEFT3=COEF(KP)/3.D0
  705.       GEO1=0.D0
  706.       ZVGUU=(AIRE(KP)*(HR(K,I,1)*HR(K,J,1))+GEO1)*COEFT3*UIX(KP,J)
  707.       ZVGUV=AIRE(KP)*( HR(K,I,1)*HR(K,J,2))*COEFT3*UIY(KP,J)
  708.       ZVGUW=AIRE(KP)*( HR(K,I,1)*HR(K,J,3))*COEFT3*UIZ(KP,J)
  709.       ZVGVU=AIRE(KP)*( HR(K,I,2)*HR(K,J,1))*COEFT3*UIX(KP,J)
  710.       ZVGVV=(AIRE(KP)*(HR(K,I,2)*HR(K,J,2))+GEO1)*COEFT3*UIY(KP,J)
  711.       ZVGVW=AIRE(KP)*( HR(K,I,2)*HR(K,J,3))*COEFT3*UIZ(KP,J)
  712.       ZVGWU=AIRE(KP)*( HR(K,I,3)*HR(K,J,1))*COEFT3*UIX(KP,J)
  713.       ZVGWV=AIRE(KP)*( HR(K,I,3)*HR(K,J,2))*COEFT3*UIY(KP,J)
  714.       ZVGWW=(AIRE(KP)*(HR(K,I,3)*HR(K,J,3))+GEO1)*COEFT3*UIZ(KP,J)
  715.  
  716.       V2=(UIX(KP,J)*HR(K,J,1)+UIY(KP,J)*HR(K,J,2)+UIZ(KP,J)*HR(K,J,3))
  717.      &   *WZ(KP,I)
  718.  
  719.       SAF1(KP,I)=SAF1(KP,I)+(V2+ZVGGX)*GIX(KP,J)+ZVGT*UIX(KP,J)
  720.      &+ ZVGUU + ZVGUV + ZVGUW
  721.       SAF2(KP,I)=SAF2(KP,I)+(V2+ZVGGY)*GIY(KP,J)+ZVGT*UIY(KP,J)
  722.      &+ ZVGVU + ZVGUV + ZVGVW
  723.       SAF3(KP,I)=SAF3(KP,I)+(V2+ZVGGZ)*GIZ(KP,J)+ZVGT*UIZ(KP,J)
  724.      &+ ZVGWU + ZVGWV + ZVGWW
  725.  
  726.  8015 CONTINUE
  727. 81096 CONTINUE
  728. 81097 CONTINUE
  729.  
  730.       ENDIF
  731.  
  732. C
  733. C     Fin de l'accumulation dans SAF1,SAF2.
  734. C     On ajoute ces incr{ments @ F.
  735. C
  736.       DO 81098 I=1,NP
  737.       DO 8017 K=KDEB,KFIN
  738.       KP=K-KDEB+1
  739.       NF=IPADI(LE(I,K))
  740.       F(NF,1)=F(NF,1)+SAF1(KP,I)
  741.       F(NF,2)=F(NF,2)+SAF2(KP,I)
  742.       F(NF,3)=F(NF,3)+SAF3(KP,I)
  743.  8017 CONTINUE
  744. 81098 CONTINUE
  745.  
  746.  8001 CONTINUE
  747.  
  748. C     WRITE(6,*)' ********** FIN YCVI 3D *****************'
  749.  
  750.       IPAS=1
  751.       RETURN
  752.  1002 FORMAT(10(1X,1PE11.4))
  753.  1001 FORMAT(20(1X,I5))
  754.       END
  755.  
  756.  
  757.  
  758.  
  759.  
  760.  
  761.  
  762.  
  763.  

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