Télécharger muchel.eso

Retour à la liste

Numérotation des lignes :

  1. C MUCHEL SOURCE CB215821 16/01/21 21:15:15 8791
  2. SUBROUTINE MUCHEL(IPCHE1,XFLOT,IPCHMU,IEPS)
  3. C_______________________________________________________________________
  4. C
  5. C MULTIPLIE UN CHPS PAR ELMTS PAR XFLO SI IEPS=1
  6. C MULTIPLIE UN CHPS PAR ELMTS PAR 1/XFLO SI IEPS=-1
  7. C LE CHPS RESULTANT VOIT SON POINTEUR STOCKE DANS IRET
  8. C SI L OPERATION N EST PAS POSSIBLE IRET=0
  9. C PAR EXEMPLE SI IEPS=-1 ET XFLOT=0.
  10. C (APPELE PAR OPERMU)
  11. C
  12. C ENTREES :
  13. C ---------
  14. C
  15. C IPCHE1 POINTEUR SUR LE CHAMPS PAR ELEMENT
  16. C XFLOT SCALAIRE
  17. C IEPS = 1 SI MULTIPLICATION
  18. C -1 SI DIVISION
  19. C
  20. C SORTIES :
  21. C ---------
  22. C
  23. C IPCHMU POINTEUR SUR LE CHAMPS*XFLOT**IEPS
  24. C =0 SI OPERATION IMPOSSSIBLE
  25. C
  26. C CODE EBERSOLT JUIN 84
  27. C
  28. C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 29 10 90
  29. C
  30. C_______________________________________________________________________
  31. C
  32. IMPLICIT INTEGER(I-N)
  33. IMPLICIT REAL*8(A-H,O-Z)
  34. C
  35. -INC SMCHAML
  36. -INC CCOPTIO
  37. -INC SMCOORD
  38. -INC SMLREEL
  39. -INC SMEVOLL
  40. C
  41. IPCHMU=0
  42. C
  43. IF(IEPS.EQ.-1.AND.XFLOT.EQ.0.) GOTO 666
  44. C
  45. IF(IEPS.EQ.1) XFLOT1=XFLOT
  46. IF(IEPS.EQ.-1) XFLOT1=1.D0/XFLOT
  47. C
  48. MCHEL1=IPCHE1
  49. SEGACT MCHEL1
  50. SEGINI,MCHELM=MCHEL1
  51. SEGDES MCHEL1
  52. IPCHMU=MCHELM
  53. C
  54. DO 72 ISOUS=1,ICHAML(/1)
  55. MCHAM1=ICHAML(ISOUS)
  56. SEGACT MCHAM1
  57. SEGINI,MCHAML=MCHAM1
  58. SEGDES MCHAM1
  59. ICHAML(ISOUS)=MCHAML
  60. DO 73 ICOMP=1,IELVAL(/1)
  61. MELVA1=IELVAL(ICOMP)
  62. SEGACT MELVA1
  63. SEGINI,MELVAL=MELVA1
  64. SEGDES MELVA1
  65. IELVAL(ICOMP)=MELVAL
  66. N1PTEL=VELCHE(/1)
  67. IF (N1PTEL.NE.0) THEN
  68. N1EL =VELCHE(/2)
  69. DO 74 IGAU=1,N1PTEL
  70. DO 74 IB=1,N1EL
  71. VELCHE(IGAU,IB)=XFLOT1*VELCHE(IGAU,IB)
  72. 74 CONTINUE
  73. ELSE
  74. N2PTEL=IELCHE(/1)
  75. N2EL =IELCHE(/2)
  76. IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN
  77. DO 64 IGAU=1,N2PTEL
  78. DO 64 IB=1,N2EL
  79. ILREE1=IELCHE(IGAU,IB)
  80. CALL MUFLIR(ILREE1,XFLOT1,ILREEL,1)
  81. IELCHE(IGAU,IB)=ILREEL
  82. 64 CONTINUE
  83. ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURPOINT ') THEN
  84. SEGACT,MCOORD
  85. NBNO=XCOOR(/1)/(IDIM+1)
  86. NBNOI=NBNO
  87. NBPTS=NBNO+(N2PTEL*N2EL)
  88. SEGADJ,MCOORD
  89. DO 54 IGAU=1,N2PTEL
  90. DO 54 IB=1,N2EL
  91. IP=IELCHE(IGAU,IB)
  92. IREF=(IP-1)*(IDIM+1)
  93. C
  94. DO 55 IC=1,IDIM
  95. XCOOR(NBNOI*(IDIM+1)+IC)=XCOOR(IREF+IC)*XFLOT1
  96. 55 CONTINUE
  97. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  98. IELCHE(IGAU,IB)=NBNOI+1
  99. NBNOI=NBNOI+1
  100. 54 CONTINUE
  101. ELSE IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') THEN
  102. DO 65 IGAU=1,N2PTEL
  103. DO 65 IB=1,N2EL
  104. IEVOL1=IELCHE(IGAU,IB)
  105. CALL MUFLEV(IEVOL1,XFLOT,IEVOL2,IEPS)
  106. IELCHE(IGAU,IB)=IEVOL2
  107. 65 CONTINUE
  108. ELSE
  109. C
  110. C NOM DE COMPOSANTE NON RECONNU
  111. C
  112. MOTERR(1:4)=NOMCHE(ICOMP)
  113. CALL ERREUR(197)
  114. SEGSUP MELVAL
  115. SEGSUP MCHAML
  116. SEGSUP MCHELM
  117. IPCHMU=0
  118. RETURN
  119. ENDIF
  120. ENDIF
  121. SEGDES MELVAL
  122. C
  123. 73 CONTINUE
  124. SEGDES MCHAML
  125. C
  126. 72 CONTINUE
  127. SEGDES MCHELM
  128. C
  129. 666 CONTINUE
  130. RETURN
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  

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