Télécharger chame3.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAME3 SOURCE PV 16/06/24 13:02:13 8985
  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. N1EL=VELCHE(/2)
  72. N2PTEL=0
  73. N2EL =0
  74. SEGINI MELVA1
  75. IPRES=MELVA1
  76. *
  77. * AM 14/4/16 CAS DES JOINTS
  78. *
  79. MELGEO=NUMGEO(MELE)
  80. IF( MELGEO.EQ.12.OR.MELGEO.EQ.13.OR.MELGEO.EQ.29
  81. & .OR.MELGEO.EQ.30.OR.MELGEO.EQ.31) THEN
  82. *
  83. IDECA=0
  84. IF(MELGEO.EQ.29) IDECA=2
  85. IF(MELGEO.EQ.30) IDECA=3
  86. IF(MELGEO.EQ.31) IDECA=4
  87. NBNOU=NBNNE(MELGEO)-IDECA
  88. NBNOV=NBNO - IDECA
  89. *
  90. IF(LENAME.EQ.'P'.OR.LENAME.EQ.'PQ'
  91. & .OR.LENAME.EQ.'TP') THEN
  92.  
  93. NBNOV=NBNO - IDECA
  94. DO 7 IB=1,N1EL
  95. DO 8 IGAU=1,NBPGAU
  96. * DO 9 INBNO=NBNO-IDECA+1,NBNO
  97. DO 9 INBNO=1,IDECA
  98. INBNO1 = NBNOU + INBNO
  99. INBNO2 = NBNOV + INBNO
  100. IGMN=MIN(VELCHE(/1),INBNO1)
  101. MELVA1.VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)+
  102. & VELCHE(IGMN,IB)*SHPTOT(1,INBNO2,IGAU)
  103. 9 CONTINUE
  104. 8 CONTINUE
  105. 7 CONTINUE
  106. ELSE
  107. *
  108. FAC=2.D0
  109. IF((MELGEO.EQ.12.OR.MELGEO.EQ.13).AND.NBNOU.GT.NBNO) THEN
  110. NBNOU=NBNO
  111. FAC=1.D0
  112. ENDIF
  113. *
  114. DO 4 IB=1,N1EL
  115. DO 5 IGAU=1,NBPGAU
  116. DO 6 INBNO=1,NBNOU
  117. IGMN=MIN(VELCHE(/1),INBNO)
  118. MELVA1.VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)+
  119. & VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
  120. 6 CONTINUE
  121. MELVA1.VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)/FAC
  122. 5 CONTINUE
  123. 4 CONTINUE
  124. ENDIF
  125. *
  126. * LES AUTRES CAS
  127. *
  128. ELSE
  129. DO 1 IB=1,N1EL
  130. DO 2 IGAU=1,NBPGAU
  131. DO 3 INBNO=1,NBNO
  132. IGMN=MIN(VELCHE(/1),INBNO)
  133. MELVA1.VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)+
  134. & VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
  135. 3 CONTINUE
  136. 2 CONTINUE
  137. 1 CONTINUE
  138. ENDIF
  139. ENDIF
  140. ENDIF
  141. *
  142. C** SEGDES MELVAL <- Actif en SORTIE
  143. C** SEGDES MINTE <- Actif en SORTIE
  144. *
  145. RETURN
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  

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