Télécharger borne5.eso

Retour à la liste

Numérotation des lignes :

  1. C BORNE5 SOURCE PV 11/03/07 21:15:13 6885
  2.  
  3. SUBROUTINE BORNE5 (IPCHME,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHMS)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC CCOPTIO
  9. -INC SMCHAML
  10. -INC SMLENTI
  11. -INC SMLMOTS
  12. -INC SMLREEL
  13. POINTEUR MLREE4.MLREEL
  14.  
  15. CHARACTER*4 mot4
  16.  
  17. IPCHMS = 0
  18. IRETS = 0
  19. MCHEL1 = IPCHME
  20. SEGINI,MCHELM=MCHEL1
  21.  
  22. C- Quelques verifications
  23. MLMOTS = MLCOMP
  24. C* SEGACT,MLMOTS
  25. DO i = 1, MOTS(/2)
  26. mot4 = MOTS(i)
  27. DO j = 1, i-1
  28. IF (mot4.EQ.MOTS(j)) MOTS(j) = ' '
  29. ENDDO
  30. ENDDO
  31. NCOMP = 0
  32. DO i = 1, MOTS(/2)
  33. IF (MOTS(i).NE.' ') NCOMP = NCOMP+1
  34. ENDDO
  35. IF (NCOMP.EQ.0) CALL ERREUR(5)
  36.  
  37. MLENTI = MLIOPE
  38. C* SEGACT,MLENTI
  39. MLREE1 = MLBMIN
  40. C* SEGACT,MLREE1
  41. MLREE2 = MLBMAX
  42. C* SEGACT,MLREE2
  43.  
  44. C- Realisation du bornage des champs par element
  45. N1 = ICHAML(/1)
  46. N3 = INFCHE(/2)
  47. DO i = 1, N1
  48.  
  49. MCHAM1 = ICHAML(i)
  50. SEGACT,MCHAM1
  51. NCOMP = MCHAM1.NOMCHE(/2)
  52. SEGINI,MCHAML=MCHAM1
  53. N2 = 0
  54. DO icour = 1, NCOMP
  55. mot4 = MCHAM1.NOMCHE(icour)
  56. C* IF (mot4.EQ.' ') GOTO 100
  57. CALL PLACE(MOTS,MOTS(/2),ncour,mot4)
  58. IF (ncour.NE.0) THEN
  59. N2 = N2+1
  60. NOMCHE(N2) = mot4
  61. TYPCHE(N2) = MCHAM1.TYPCHE(icour)
  62. MELVA1 = MCHAM1.IELVAL(icour)
  63. SEGINI,MELVAL=MELVA1
  64. IELVAL(N2) = MELVAL
  65. INDOPE = MLENTI.LECT(ncour)
  66. XBMIN = MLREE1.PROG(ncour)
  67. XBMAX = MLREE2.PROG(ncour)
  68. IF (TYPCHE(N2).EQ.'REAL*8') THEN
  69. N1PTEL = VELCHE(/1)
  70. N1EL = VELCHE(/2)
  71. C- BORNER 'MAXIMUM' :
  72. IF (INDOPE.EQ.1) THEN
  73. DO iel = 1, N1EL
  74. DO igau = 1, N1PTEL
  75. VELCHE(igau,iel) = MIN( VELCHE(igau,iel), XBMAX)
  76. ENDDO
  77. ENDDO
  78. C- BORNER 'MINIMUM' :
  79. ELSE IF (INDOPE.EQ.2) THEN
  80. DO iel = 1, N1EL
  81. DO igau = 1, N1PTEL
  82. VELCHE(igau,iel) = MAX( VELCHE(igau,iel), XBMIN)
  83. ENDDO
  84. ENDDO
  85. C- BORNER 'COMPRIS' :
  86. ELSE IF (INDOPE.EQ.3) THEN
  87. DO iel = 1, N1EL
  88. DO igau = 1, N1PTEL
  89. x = MIN( VELCHE(igau,iel), XBMAX)
  90. VELCHE(igau,iel) = MAX( x, XBMIN)
  91. ENDDO
  92. ENDDO
  93. ELSE
  94. CALL ERREUR(5)
  95. ENDIF
  96. ELSE IF (TYPCHE(N2).EQ.'POINTEURLISTREEL') THEN
  97. N2PTEL = IELCHE(/1)
  98. N2EL = IELCHE(/2)
  99. DO iel = 1, N2EL
  100. DO igau = 1, N2PTEL
  101. ILREEE = IELCHE(igau,iel)
  102. CALL BORNE2(ILREEE,INDOPE,XBMIN,XBMAX, ILREES)
  103. IELCHE(igau,iel) = ILREES
  104. ENDDO
  105. ENDDO
  106. ELSE IF (TYPCHE(N2).EQ.'POINTEUREVOLUTIO') THEN
  107. N2PTEL = IELCHE(/1)
  108. N2EL = IELCHE(/2)
  109. JG = 1
  110. SEGINI,MLENT2,MLENT3,MLREE3,MLREE4
  111. MLENT2.LECT(1) = 1
  112. MLENT3.LECT(1) = INDOPE
  113. MLREE3.PROG(1) = XBMIN
  114. MLREE4.PROG(1) = XBMAX
  115. DO iel = 1, N2EL
  116. DO igau = 1, N2PTEL
  117. IEVOLE = IELCHE(igau,iel)
  118. CALL BORNE3(IEVOLE,MLENT2,MLENT3,MLREE3,MLREE4,IEVOLS)
  119. IELCHE(igau,iel) = IEVOLS
  120. IF (IEVOLS.EQ.0) IRETS = -1
  121. ENDDO
  122. ENDDO
  123. SEGSUP,MLENT2,MLENT3,MLREE3,MLREE4
  124. ELSE IF (TYPCHE(N2).EQ.'POINTEURLISTENTI') THEN
  125. N2PTEL = IELCHE(/1)
  126. N2EL = IELCHE(/2)
  127. IBMIN = nint(XBMIN)
  128. IBMAX = nint(XBMAX)
  129. DO iel = 1, N2EL
  130. DO igau = 1, N2PTEL
  131. ILENTE = IELCHE(igau,iel)
  132. CALL BORNE1(ILENTE,INDOPE,IBMIN,IBMAX, ILENTS)
  133. IELCHE(igau,iel) = ILENTS
  134. ENDDO
  135. ENDDO
  136. ELSE
  137. MOTERR(1:8)=MCHAM1.NOMCHE(icour)
  138. CALL ERREUR(679)
  139. IRETS = -1
  140. ENDIF
  141. SEGDES,MELVAL
  142. ENDIF
  143. C*100 CONTINUE
  144. ENDDO
  145. IF (IRETS.NE.-1) THEN
  146. IF (N2.NE.0) THEN
  147. IRETS = IRETS + 1
  148. IF (N2.NE.NCOMP) THEN
  149. SEGADJ,MCHAML
  150. ENDIF
  151. SEGDES,MCHAML
  152. ICHAML(IRETS) = MCHAML
  153. IF (IRETS.NE.i) THEN
  154. CONCHE(IRETS) = CONCHE(i)
  155. IMACHE(IRETS) = IMACHE(i)
  156. DO j = 1, N3
  157. INFCHE(IRETS,j) = INFCHE(i,j)
  158. ENDDO
  159. ENDIF
  160. ELSE
  161. SEGSUP,MCHAML
  162. ENDIF
  163. ENDIF
  164. SEGDES,MCHAM1
  165. ENDDO
  166.  
  167. IF (IRETS.GT.0) THEN
  168. IF (IRETS.NE.N1) THEN
  169. N1 = IRETS
  170. L1 = TITCHE(/1)
  171. SEGADJ,MCHELM
  172. ENDIF
  173. IPCHMS = MCHELM
  174. ELSE IF (IRETS.EQ.0) THEN
  175. CALL ERREUR(280)
  176. ENDIF
  177.  
  178. 900 CONTINUE
  179. IF (IPCHMS.NE.0) THEN
  180. SEGDES,MCHELM
  181. ELSE
  182. SEGSUP,MCHELM
  183. ENDIF
  184.  
  185. RETURN
  186. END
  187.  
  188.  
  189.  
  190.  

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