Télécharger chame3.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAME3 SOURCE CB215821 18/09/13 21:15:09 9917
  2.  
  3. SUBROUTINE CHAME3(IPMELV,IPMINT,IPRES,IPORE,LENAME,MELE)
  4.  
  5. *_______________________________________________________________________
  6. *
  7. * CALCUL DES MELVALS AU SUPPORT DE IPMINT
  8. * IDENTIQUE A VALMEL AVEC EN SUPPLEMENT IPORE
  9. *
  10. * IPMELV POINTEUR SUR UN SEGMENT MELVAL A RECALCULER
  11. * (SUPPOSE ACTIF)
  12. *
  13. * IPMINT POINTEUR SUR LE SEGMENT D'INTEGRATION DU SUPPORT OU L'ON
  14. * SOUHAITE PROJETER LE MELVAL
  15. * LE POINTEUR IPMINT DOIT ETRE ACTIF EN ENTREE DE CHAME3
  16. * ET SON ETAT N'EST PAS MODIFIE DANS CHAME3.
  17. *
  18. * IPRES POINTEUR SUR LE MELVAL RESULTAT
  19. * (ACTIF EN SORTIE)
  20. *
  21. * IPORE 0 SAUF POUR MILIEU POREUX ( NBRE DE NOEUDS )
  22. *
  23. * CAMPENON JM LE 02/91
  24. *
  25. *_______________________________________________________________________
  26. *
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. *
  30. -INC CCOPTIO
  31. -INC CCGEOME
  32. -INC SMCHAML
  33. -INC SMINTE
  34. *
  35. CHARACTER*8 LENAME
  36. *
  37. MELVAL=IPMELV
  38. N1PTEL=VELCHE(/1)
  39. N2PTEL=IELCHE(/1)
  40. IF(N2PTEL.NE.0)THEN
  41. IF(N2PTEL.EQ.1)THEN
  42. SEGINI,MELVA1=MELVAL
  43. IPRES=MELVA1
  44. RETURN
  45. ELSE
  46. MOTERR(1:8)=' '
  47. CALL ERREUR(124)
  48. IPRES=IPMELV
  49. RETURN
  50. ENDIF
  51. ELSE
  52. *
  53. IF (N1PTEL.EQ.1) THEN
  54. SEGINI,MELVA1=MELVAL
  55. IPRES=MELVA1
  56. RETURN
  57. ELSE
  58. *
  59. * ON RECUPERE LE NOMBRE DE POINTS SUPPORT
  60. *
  61. MINTE=IPMINT
  62. C** SEGACT MINTE <- Actif en ENTREE
  63. NBPGAU=SHPTOT(/3)
  64. IF(IPORE.EQ.0) THEN
  65. NBNO =SHPTOT(/2)
  66. ELSE
  67. NBNO =IPORE
  68. ENDIF
  69. *
  70. N1PTEL=NBPGAU
  71. IVEL=VELCHE(/1)
  72. N1EL=VELCHE(/2)
  73. N2PTEL=0
  74. N2EL =0
  75. SEGINI MELVA1
  76. IPRES= MELVA1
  77. *
  78. * AM 14/4/16 CAS DES JOINTS
  79. *
  80. MELGEO=NUMGEO(MELE)
  81. IF( MELGEO.EQ.12.OR.MELGEO.EQ.13.OR.MELGEO.EQ.29
  82. & .OR.MELGEO.EQ.30.OR.MELGEO.EQ.31) THEN
  83. *
  84. IDECA=0
  85. IF(MELGEO.EQ.29) IDECA=2
  86. IF(MELGEO.EQ.30) IDECA=3
  87. IF(MELGEO.EQ.31) IDECA=4
  88. NBNOU=NBNNE(MELGEO)-IDECA
  89. NBNOV=NBNO - IDECA
  90. *
  91. IF(LENAME.EQ.'P '.OR.LENAME.EQ.'PQ '
  92. & .OR.LENAME.EQ.'TP ') THEN
  93.  
  94. NBNOV=NBNO - IDECA
  95. DO 7 IB=1,N1EL
  96. DO 8 IGAU=1,NBPGAU
  97. XVAL1=0.D0
  98. * DO 9 INBNO=NBNO-IDECA+1,NBNO
  99. DO 9 INBNO=1,IDECA
  100. INBNO1 = NBNOU + INBNO
  101. INBNO2 = NBNOV + INBNO
  102. IGMN = MIN(IVEL,INBNO1)
  103. XVAL1=XVAL1+VELCHE(IGMN,IB)*SHPTOT(1,INBNO2,IGAU)
  104. 9 CONTINUE
  105. MELVA1.VELCHE(IGAU,IB)=XVAL1
  106. 8 CONTINUE
  107. 7 CONTINUE
  108.  
  109. ELSE
  110. FAC=2.D0
  111. IF((MELGEO.EQ.12.OR.MELGEO.EQ.13).AND.NBNOU.GT.NBNO) THEN
  112. NBNOU=NBNO
  113. FAC=1.D0
  114. ENDIF
  115.  
  116. DO 4 IB=1,N1EL
  117. DO 5 IGAU=1,NBPGAU
  118. XVAL1=0.D0
  119. DO 6 INBNO=1,NBNOU
  120. IGMN=MIN(IVEL,INBNO)
  121. XVAL1=XVAL1+ VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
  122. 6 CONTINUE
  123. MELVA1.VELCHE(IGAU,IB)=XVAL1/FAC
  124. 5 CONTINUE
  125. 4 CONTINUE
  126. ENDIF
  127. *
  128. * LES AUTRES CAS
  129. *
  130. ELSE
  131. DO 1 IB=1,N1EL
  132. DO 2 IGAU=1,NBPGAU
  133. XVAL1=0.D0
  134. DO 3 INBNO=1,NBNO
  135. IGMN=MIN(IVEL,INBNO)
  136. XVAL1=XVAL1+VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
  137. 3 CONTINUE
  138. MELVA1.VELCHE(IGAU,IB)=XVAL1
  139. 2 CONTINUE
  140. 1 CONTINUE
  141. ENDIF
  142. ENDIF
  143. ENDIF
  144. *
  145. C** SEGDES MELVAL <- Actif en SORTIE
  146. C** SEGDES MINTE <- Actif en SORTIE
  147. *
  148. RETURN
  149. END
  150.  
  151.  
  152.  

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