Télécharger xconv.eso

Retour à la liste

Numérotation des lignes :

  1. C XCONV SOURCE CB215821 18/07/03 21:15:05 9868
  2. C
  3. SUBROUTINE XCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG,AJ,
  4. & NES,IDIM,NP,NPG,IAXI,AG,AD,IDIV,CMD,IKOMP,LRV,
  5. & WT,WS,HK,PGSK,RPGK,AIRE,AJK,UIL,DUIL,COEFK,ANUK,
  6. & COEF,IKR,UN,NPTU,IPADU,AMU,IKM,
  7. & LE,NBEL,K0,XCOOR,
  8. & AF1,AF2,AF3,AS1,AS2,AS3,NINC,IDCEN,DTM1,
  9. & TN,NPT,IPADT)
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8 (A-H,O-Z)
  12. C************************************************************************
  13. C
  14. C CALCUL DE LA MATRICE ELEMENTAIRE DE CONVECTION
  15. C
  16. C
  17. C************************************************************************
  18. DIMENSION FN(NP,NPG),GR(IDIM,NP,NPG),PG(NPG),XYZ(IDIM,NP)
  19. DIMENSION HR(IDIM,NP,NPG),PGSQ(NPG),RPG(NPG),AJ(IDIM,IDIM,NPG)
  20. DIMENSION LE(NP,NBEL),IPADU(*),IPADT(*)
  21. DIMENSION AF1(NBEL,NP,NP),AS1(NBEL,NP,NP)
  22. DIMENSION AF2(NBEL,NP,NP),AS2(NBEL,NP,NP)
  23. DIMENSION AF3(NBEL,NP,NP),AS3(NBEL,NP,NP)
  24. DIMENSION XCOOR(*)
  25. DIMENSION COEF(1),UN(NPTU,IDIM),AMU(1),TN(NPT,NINC)
  26.  
  27. C PARAMETER (LRV1=64,NPX=9,NPGX=9)
  28. DIMENSION WT(LRV,NP,NPG,*),WS(LRV,NP,NPG,*)
  29. DIMENSION HK(LRV,IDIM,NP,NPG)
  30. DIMENSION UIL(LRV,IDIM,NPG),DUIL(LRV,IDIM,NPG)
  31. DIMENSION PGSK(LRV,NPG),RPGK(LRV,NPG),AIRE(LRV)
  32. DIMENSION COEFK(LRV),ANUK(LRV)
  33. DIMENSION AJK(LRV,IDIM,IDIM,NPG)
  34. -INC CCREEL
  35. C***
  36. C WRITE(6,*)' DEBUT XCONV ',npt,idim,iaxi
  37. C
  38. C
  39. C write(6,*)' IDIV=',IDIV
  40.  
  41. DEUPI=1.D0
  42. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  43.  
  44. C Calcul du nombre de paquets de LRV éléments
  45. C
  46. NNN=MOD(NBEL,LRV)
  47. IF(NNN.EQ.0) THEN
  48. NPACK=NBEL/LRV
  49. ELSE
  50. NPACK=1+(NBEL-NNN)/LRV
  51. ENDIF
  52. KPACKD=1
  53. KPACKF=NPACK
  54. C
  55. C ******* BOUCLE SUR LES PAQUETS DE LRV ELEMENTS **********
  56. C
  57. DO 7001 KPACK=KPACKD,KPACKF
  58. C
  59. C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  60. C
  61. C 1. Calcul des limites du paquet courant.
  62. KDEB=1+(KPACK-1)*LRV
  63. KFIN=MIN(NBEL,KDEB+LRV-1)
  64. C
  65. DO 7002 K=KDEB,KFIN
  66. KP=K-KDEB+1
  67. NK=K+K0
  68. NKR=(1-IKR)*(NK-1)+1
  69. NKM=(1-IKM)*(NK-1)+1
  70. COEFK(KP)=COEF(NKR)
  71. ANUK(KP)=AMU(NKM)/COEF(NKR)
  72. 7002 CONTINUE
  73.  
  74. C CB215821 : DT n'est pas utilise mais doit etre initialise sinon NAN
  75. DT=0.D0
  76.  
  77. IF(IDCEN.EQ.2)THEN
  78. DO 7006 NC=1,NINC
  79. CALL SUPGEF(FN,GR,PG,XYZ,HR,PGSQ,RPG,AJ,
  80. & NES,NP,NPG,IAXI,XCOOR,
  81. & LE,KDEB,KFIN,LRV,IDCEN,CMD,IKOMP,
  82. & TN(1,NC),IPADT,UN,IPADU,NPTU,ANUK,
  83. & WT(1,1,1,NC),WS(1,1,1,NC),HK,PGSK,RPGK,AJK,AIRE,UIL,DUIL,
  84. & DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  85. 7006 CONTINUE
  86.  
  87. ELSE
  88. CALL SUPGEF(FN,GR,PG,XYZ,HR,PGSQ,RPG,AJ,
  89. & NES,NP,NPG,IAXI,XCOOR,
  90. & LE,KDEB,KFIN,LRV,IDCEN,CMD,IKOMP,
  91. & TN,IPADU,UN,IPADU,NPTU,ANUK,
  92. & WT(1,1,1,1),WS(1,1,1,1),HK,PGSK,RPGK,AJK,AIRE,UIL,DUIL,
  93. & DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  94. ENDIF
  95.  
  96. CDIV=0.5D0
  97. IF(IDIV.EQ.0.OR.IKOMP.EQ.1)CDIV=0.D0
  98.  
  99. DO 7005 NC=1,NINC
  100. N1=1
  101. IF(IDCEN.EQ.2)N1=NC
  102.  
  103. DO 7003 K=KDEB,KFIN
  104. KP=K-KDEB+1
  105.  
  106. DO 4 I=1,NP
  107. DO 41 J=1,NP
  108. S1=0.D0
  109. S2=0.D0
  110. DO 5 L=1,NPG
  111. DUL=0.D0
  112. DO 51 N=1,IDIM
  113. DUL=DUL+DUIL(KP,N,L)
  114. 51 CONTINUE
  115.  
  116. SN=0.D0
  117. DO 52 N=1,IDIM
  118. SN=SN+(UIL(KP,N,L)*HK(KP,N,J,L))
  119. 52 CONTINUE
  120. SN=(SN+CDIV*FN(J,L)*DUL)*PGSK(KP,L)*DEUPI*RPGK(KP,L)
  121. S1=S1+SN*WT(KP,I,L,N1)
  122. S2=S2+SN*WS(KP,I,L,N1)
  123.  
  124. 5 CONTINUE
  125. IF(NC.EQ.1)THEN
  126. AF1(K,J,I)=S1*COEFK(KP)*AG
  127. AS1(K,J,I)=S2*COEFK(KP)*AD
  128. ELSEIF(NC.EQ.2)THEN
  129. AF2(K,J,I)=S1*COEFK(KP)*AG
  130. AS2(K,J,I)=S2*COEFK(KP)*AD
  131. ELSEIF(NC.EQ.3)THEN
  132. AF3(K,J,I)=S1*COEFK(KP)*AG
  133. AS3(K,J,I)=S2*COEFK(KP)*AD
  134. ENDIF
  135.  
  136. 41 CONTINUE
  137. 4 CONTINUE
  138. 7003 CONTINUE
  139.  
  140. IF(IKOMP.EQ.1)THEN
  141.  
  142. DO 7004 K=KDEB,KFIN
  143. KP=K-KDEB+1
  144.  
  145. DO 6 I=1,NP
  146. DO 61 J=1,NP
  147. S1=0.D0
  148. S2=0.D0
  149. DO 7 L=1,NPG
  150. DUL=0.D0
  151. DO 71 N=1,IDIM
  152. DUL=DUL+DUIL(KP,N,L)
  153. 71 CONTINUE
  154.  
  155. S1=S1+WT(KP,I,L,N1)*FN(J,L)*DUL
  156. $ *PGSK(KP,L)*DEUPI*RPGK(KP,L)
  157. S2=S2+WS(KP,I,L,N1)*FN(J,L)*DUL
  158. $ *PGSK(KP,L)*DEUPI*RPGK(KP,L)
  159. IF(IAXI.NE.0)THEN
  160. S1=S1+WT(KP,I,L,N1)*FN(J,L)*UIL(KP,1,L)*PGSK(KP,L)*DEUPI
  161. S2=S2+WS(KP,I,L,N1)*FN(J,L)*UIL(KP,1,L)*PGSK(KP,L)*DEUPI
  162. ENDIF
  163.  
  164.  
  165.  
  166. 7 CONTINUE
  167. IF(NC.EQ.1)THEN
  168. AF1(K,J,I)=AF1(K,J,I)+S1*COEFK(KP)*AG
  169. AS1(K,J,I)=AS1(K,J,I)+S2*COEFK(KP)*AD
  170. ELSEIF(NC.EQ.2)THEN
  171. AF2(K,J,I)=AF2(K,J,I)+S1*COEFK(KP)*AG
  172. AS2(K,J,I)=AS2(K,J,I)+S2*COEFK(KP)*AD
  173. ELSEIF(NC.EQ.3)THEN
  174. AF3(K,J,I)=AF3(K,J,I)+S1*COEFK(KP)*AG
  175. AS3(K,J,I)=AS3(K,J,I)+S2*COEFK(KP)*AD
  176. ENDIF
  177. 61 CONTINUE
  178. 6 CONTINUE
  179. 7004 CONTINUE
  180.  
  181. ENDIF
  182. 7005 CONTINUE
  183. C
  184. C WRITE(6,*)' FIN XCONV '
  185. 7001 CONTINUE
  186. RETURN
  187. 1002 FORMAT(10(1X,1PE11.4))
  188. END
  189.  
  190.  
  191.  
  192.  
  193.  

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