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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. C
  32. IRET=0
  33. MCHEL1 = IPO1
  34. SEGINI,MCHELM=MCHEL1
  35. IRET = MCHELM
  36. NSOUS = IMACHE(/1)
  37. *
  38. DO 72 IA=1,NSOUS
  39. *
  40. MCHAM1=ICHAML(IA)
  41. SEGINI,MCHAML=MCHAM1
  42. ICHAML(IA)=MCHAML
  43. *
  44. DO 75 ICOMP=1,IELVAL(/1)
  45. *
  46. MELVA1 = IELVAL(ICOMP)
  47. SEGINI,MELVAL=MELVA1
  48. IELVAL(ICOMP) = MELVAL
  49. SEGACT MELVA1
  50. *
  51. IF (TYPCHE(ICOMP).EQ.'REAL*8') GOTO 1666
  52. C
  53. GOTO 166
  54. C
  55. 1666 N1PTEL=VELCHE(/1)
  56. N1EL =VELCHE(/2)
  57. GOTO( 1, 2, 3, 4, 5, 6),IEPS
  58. 66 IRET=0
  59. GOTO 666
  60. 1 CONTINUE
  61. C
  62. C CONDUCTIVITE
  63. C
  64. DO 1000 IB=1,N1PTEL
  65. DO 1001 ID=1,N1EL
  66. XX=MELVA1.VELCHE(IB,ID)
  67. XX=XX*T0
  68. VELCHE(IB,ID)=(FBG1(XX))/X0
  69. 1001 CONTINUE
  70. 1000 CONTINUE
  71. GOTO 166
  72. C
  73. C DERIVEE CONDUCTIVITE
  74. C
  75. 2 CONTINUE
  76. DO 20 IB=1,N1PTEL
  77. DO 21 ID=1,N1EL
  78. XX =MELVA1.VELCHE(IB,ID)
  79. XX=XX*T0
  80. VELCHE(IB,ID)=(FBG2(XX))*T0/X0
  81. 21 CONTINUE
  82. 20 CONTINUE
  83. GOTO 166
  84. C
  85. C CAPACITE
  86. C
  87. 3 CONTINUE
  88. DO 60 IB=1,N1PTEL
  89. DO 61 ID=1,N1EL
  90. XX=MELVA1.VELCHE(IB,ID)
  91. XX=XX*T0
  92. VELCHE(IB,ID)=(FBG3(XX))/X0
  93. 61 CONTINUE
  94. 60 CONTINUE
  95. GOTO 166
  96. C
  97. C DERIVEE CAPACITE
  98. C
  99. 4 CONTINUE
  100. DO 70 IB=1,N1PTEL
  101. DO 71 ID=1,N1EL
  102. XX=MELVA1.VELCHE(IB,ID)
  103. XX=XX*T0
  104. VELCHE(IB,ID)=(FBG4(XX))*T0/X0
  105. 71 CONTINUE
  106. 70 CONTINUE
  107. GOTO 166
  108. C
  109. C ENDOMMAGEMENT CHIMIQUE
  110. C
  111. 5 CONTINUE
  112. DO 80 IB=1,N1PTEL
  113. DO 81 ID=1,N1EL
  114. XX=MELVA1.VELCHE(IB,ID)
  115. XX=XX*T0
  116. VELCHE(IB,ID)=FBG5(XX)
  117. 81 CONTINUE
  118. 80 CONTINUE
  119. GOTO 166
  120. C
  121. C DIFFUSIVITE MECANIQUE
  122. C
  123. 6 CONTINUE
  124. DO 90 IB=1,N1PTEL
  125. DO 91 ID=1,N1EL
  126. XX=MELVA1.VELCHE(IB,ID)
  127. XX=XX
  128. VELCHE(IB,ID)=(FBG6(XX))/X0
  129. 91 CONTINUE
  130. 90 CONTINUE
  131. GOTO 166
  132.  
  133. 166 CONTINUE
  134. SEGDES MELVAL
  135. SEGDES MELVA1
  136. *
  137. 75 CONTINUE
  138. SEGDES MCHAML
  139. *
  140. 72 CONTINUE
  141. SEGDES MCHELM
  142. 666 CONTINUE
  143. RETURN
  144. END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  

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