Télécharger xcnef0.eso

Retour à la liste

Numérotation des lignes :

xcnef0
  1. C XCNEF0 SOURCE PV 09/03/12 21:37:09 6325
  2. SUBROUTINE XCNEF0(NBEL,NP,MP,AF1,RO,VITESS,DCENTR
  3. & ,NPT,IDIM,IDCEN,XYZ,NUTOEL,XCOOR,LTOG,
  4. & IPADL,AF2,AF3,
  5. & FN,GR,PG,HR,PGSQ,RPG,NES,NPG,IAXI,DRR,
  6. & NBME,AMU,COTE,NELZ,IKR,IKU,IKM,TN,AIMPL,IPADL2,DT,
  7. & MELEMC)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Z)
  10.  
  11. -INC SMCHAML
  12. -INC SMELEME
  13. POINTEUR MELEMC.MELEME
  14.  
  15. DIMENSION FN(MP,NPG),GR(IDIM,MP,NPG),PG(NPG)
  16. DIMENSION HR(IDIM,MP,NPG),PGSQ(NPG),RPG(NPG)
  17. DIMENSION AF1(NBEL,NP,MP),AF2(NBEL,NP,MP)
  18. DIMENSION AF3(NBEL,NP,MP),RO(1)
  19. DIMENSION VITESS(NPT,IDIM),TN(*)
  20. DIMENSION DCENTR(1),XYZ(IDIM,MP)
  21. DIMENSION XCOOR(*),DRR(MP,NBEL),IPADL2(*)
  22. DIMENSION LTOG(MP,NBEL),IPADL(*),AMU(1),COTE(NELZ,*)
  23.  
  24. C=============================================
  25. C Cette routine calcules les matrices C
  26. C Elementaires associees a l'operateur C
  27. C KONV en EFM0 C
  28. C=============================================
  29. PARAMETER (LRV=64,NPX=9,NPGX=9)
  30. DIMENSION WT(LRV,NPX,NPGX),WS(LRV,NPX,NPGX),HK(LRV,3,NPX,NPGX)
  31. DIMENSION PGSK(LRV,NPGX),RPGK(LRV,NPGX),AIRE(LRV)
  32. DIMENSION UMJ(LRV,3,NPGX),DUMJ(LRV,3,NPGX)
  33. DIMENSION COEFK(LRV),ANUK(LRV)
  34. DIMENSION AL(LRV),AH(LRV),AP(LRV)
  35. DIMENSION UAM(9,9)
  36. -INC CCREEL
  37.  
  38. INTEGER I,J,K,NUMAUX
  39. REAL*8 UMOY(3),RESW,CT
  40.  
  41. C ===================================
  42. C Calcul du nombre de paquets de LRV éléments
  43. C
  44. NNN=MOD(NBEL,LRV)
  45. IF(NNN.EQ.0) NPACK=NBEL/LRV
  46. IF(NNN.NE.0) NPACK=1+(NBEL-NNN)/LRV
  47. KPACKD=1
  48. KPACKF=NPACK
  49. CT=0.0D0
  50.  
  51. C====================================
  52.  
  53. C Boucle sur les paquets de LRV elements
  54.  
  55. c WRITE(6,*) 'IDCEN=' , IDCEN
  56. DO KPACK=KPACKD,KPACKF
  57.  
  58. C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  59. C
  60. C 1. Calcul des limites du paquet courant.
  61. KDEB=1+(KPACK-1)*LRV
  62. KFIN=MIN(NBEL,KDEB+LRV-1)
  63. C
  64. C On rempli le tableau de COEFK sur chaque
  65. C element du paquet
  66. DO K=KDEB,KFIN
  67. KP=K-KDEB+1
  68. NK=K+NUTOEL
  69. NKR=(1-IKR)*(NK-1)+1
  70. NKM=(1-IKM)*(NK-1)+1
  71. COEFK(KP)=RO(NKR)
  72. ANUK(KP)=AMU(NKM)/RO(NKR)
  73. AL(KP)=COTE(NK,1)
  74. AH(KP)=COTE(NK,2)
  75. END DO
  76.  
  77. CALL KSUPG(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  78. & NES,MP,NPG,IAXI,XCOOR,
  79. & WT,WS,HK,PGSK,RPGK,AIRE,
  80. & UMJ,DUMJ,KDEB,KFIN,LRV,NPX,NPGX,
  81. & TN,IPADL,VITESS,IPADL,NPT,NELZ,ANUK,
  82. & IDCEN,LTOG,
  83. & AL,AH,AP,
  84. & DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  85.  
  86. DO K=KDEB,KFIN
  87. KP=K-KDEB+1
  88. CT=CT+TN(IPADL2(MELEMC.NUM(1,K)))*
  89. & AIRE(KP)
  90. DO I=1,MP
  91.  
  92. IF (NBME.GT.0) AF1(K,1,I)=0.0D0
  93. IF (NBME.GT.1) AF2(K,1,I)=0.0D0
  94. IF (NBME.GT.2) AF3(K,1,I)=0.0D0
  95.  
  96. DO J=1,MP
  97. UAM(I,J)=0.0D0
  98. DO L=1,NPG
  99. UAM(I,J)=UAM(I,J)+
  100. & FN(I,L)*WT(KP,J,L)*PGSK(KP,L)
  101. END DO
  102. END DO
  103. END DO
  104.  
  105.  
  106. DO I=1,MP
  107. DO J=1,MP
  108. IF (NBME.GT.0) THEN
  109. AF1(K,1,I)=AF1(K,1,I)+UAM(I,J)*
  110. & VITESS(IPADL(LTOG(J,K)),1)
  111. & *COEFK(KP)
  112. END IF
  113. IF (NBME.GT.1) THEN
  114. AF2(K,1,I)=AF2(K,1,I)+UAM(I,J)*
  115. & VITESS(IPADL(LTOG(J,K)),2)
  116. & *COEFK(KP)
  117. END IF
  118. IF (NBME.GT.2) THEN
  119. AF3(K,1,I)=AF3(K,1,I)+UAM(I,J)*
  120. & VITESS(IPADL(LTOG(J,K)),3)
  121. & *COEFK(KP)
  122. END IF
  123. END DO
  124. END DO
  125.  
  126. END DO
  127. END DO
  128. C WRITE(6,*) 'Int Ct=',CT
  129. RETURN
  130.  
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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