Télécharger bgchel.eso

Retour à la liste

Numérotation des lignes :

  1. C BGCHEL SOURCE PV 14/01/30 21:15:05 7931
  2.  
  3. C=====================================================================
  4. C=====================================================================
  5. C BGCHEL SOURCE MARINO ARROYO 99/05/21
  6. SUBROUTINE BGCHEL(IPO1,IEPS,T0,X0,IRET)
  7. C=====================================================================
  8. C
  9. C EFFECTUE DIVERSES OPERATIONS SUR DES MCHAML
  10. C ENTREES
  11. C IPO1=POINTEUR SUR LE CHAMPS PAR ELEMENT
  12. C IEPS= 1 CONDUCTIVITE
  13. C = 2 DERIVEE CONDUCTIVITE
  14. C = 3 CAPACITE
  15. C = 4 DERIVEE CAPACITE
  16. C T0= 1 TEMPERATURE DE REFERENCE
  17. C X0= CARACTERISTIQUE DE REFERENCE
  18. C SORTIES
  19. C IRET=POINTEUR SUR LE CHAMP RESULTANT
  20. C =0 SI OPERATION IMPOSSSIBLE
  21. C
  22. C=====================================================================
  23. C
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. C
  27. -INC SMCHAML
  28. -INC CCOPTIO
  29. C
  30. IRET=0
  31. MCHEL1 = IPO1
  32. SEGINI,MCHELM=MCHEL1
  33. IRET = MCHELM
  34. NSOUS = IMACHE(/1)
  35. *
  36. DO 72 IA=1,NSOUS
  37. *
  38. MCHAM1=ICHAML(IA)
  39. SEGINI,MCHAML=MCHAM1
  40. ICHAML(IA)=MCHAML
  41. *
  42. DO 75 ICOMP=1,IELVAL(/1)
  43. *
  44. MELVA1 = IELVAL(ICOMP)
  45. SEGINI,MELVAL=MELVA1
  46. IELVAL(ICOMP) = MELVAL
  47. SEGACT MELVA1
  48. *
  49. IF (TYPCHE(ICOMP).EQ.'REAL*8') GOTO 1666
  50. C
  51. GOTO 166
  52. C
  53. 1666 N1PTEL=VELCHE(/1)
  54. N1EL =VELCHE(/2)
  55. GOTO( 1, 2, 3, 4, 5, 6),IEPS
  56. 66 IRET=0
  57. GOTO 666
  58. 1 CONTINUE
  59. C
  60. C CONDUCTIVITE
  61. C
  62. DO 1000 IB=1,N1PTEL
  63. DO 1001 ID=1,N1EL
  64. XX=MELVA1.VELCHE(IB,ID)
  65. XX=XX*T0
  66. VELCHE(IB,ID)=(FBG1(XX))/X0
  67. 1001 CONTINUE
  68. 1000 CONTINUE
  69. GOTO 166
  70. C
  71. C DERIVEE CONDUCTIVITE
  72. C
  73. 2 CONTINUE
  74. DO 20 IB=1,N1PTEL
  75. DO 21 ID=1,N1EL
  76. XX =MELVA1.VELCHE(IB,ID)
  77. XX=XX*T0
  78. VELCHE(IB,ID)=(FBG2(XX))*T0/X0
  79. 21 CONTINUE
  80. 20 CONTINUE
  81. GOTO 166
  82. C
  83. C CAPACITE
  84. C
  85. 3 CONTINUE
  86. DO 60 IB=1,N1PTEL
  87. DO 61 ID=1,N1EL
  88. XX=MELVA1.VELCHE(IB,ID)
  89. XX=XX*T0
  90. VELCHE(IB,ID)=(FBG3(XX))/X0
  91. 61 CONTINUE
  92. 60 CONTINUE
  93. GOTO 166
  94. C
  95. C DERIVEE CAPACITE
  96. C
  97. 4 CONTINUE
  98. DO 70 IB=1,N1PTEL
  99. DO 71 ID=1,N1EL
  100. XX=MELVA1.VELCHE(IB,ID)
  101. XX=XX*T0
  102. VELCHE(IB,ID)=(FBG4(XX))*T0/X0
  103. 71 CONTINUE
  104. 70 CONTINUE
  105. GOTO 166
  106. C
  107. C ENDOMMAGEMENT CHIMIQUE
  108. C
  109. 5 CONTINUE
  110. DO 80 IB=1,N1PTEL
  111. DO 81 ID=1,N1EL
  112. XX=MELVA1.VELCHE(IB,ID)
  113. XX=XX*T0
  114. VELCHE(IB,ID)=FBG5(XX)
  115. 81 CONTINUE
  116. 80 CONTINUE
  117. GOTO 166
  118. C
  119. C DIFFUSIVITE MECANIQUE
  120. C
  121. 6 CONTINUE
  122. DO 90 IB=1,N1PTEL
  123. DO 91 ID=1,N1EL
  124. XX=MELVA1.VELCHE(IB,ID)
  125. XX=XX
  126. VELCHE(IB,ID)=(FBG6(XX))/X0
  127. 91 CONTINUE
  128. 90 CONTINUE
  129. GOTO 166
  130.  
  131. 166 CONTINUE
  132. SEGDES MELVAL
  133. SEGDES MELVA1
  134. *
  135. 75 CONTINUE
  136. SEGDES MCHAML
  137. *
  138. 72 CONTINUE
  139. SEGDES MCHELM
  140. 666 CONTINUE
  141. RETURN
  142. END
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  

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