Télécharger borne4.eso

Retour à la liste

Numérotation des lignes :

borne4
  1. C BORNE4 SOURCE CB215821 20/11/25 13:18:43 10792
  2.  
  3. SUBROUTINE BORNE4 (IPCHPE,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHPS)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. C*
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMLENTI
  13. -INC SMLMOTS
  14. -INC SMLREEL
  15.  
  16. CHARACTER*(LOCOMP) mocomp
  17.  
  18. IPCHPS = 0
  19. IRETS = 0
  20. MCHPO1 = IPCHPE
  21.  
  22. C Si CHPOINT vide en entree
  23. segact,MCHPO1
  24. NS1 = MCHPO1.IPCHP(/1)
  25. IF (NS1.EQ.0) THEN
  26. IPCHPS = IPCHPE
  27. RETURN
  28. ENDIF
  29.  
  30. SEGINI,MCHPOI=MCHPO1
  31.  
  32. C- Quelques verifications
  33. MLMOTS = MLCOMP
  34. C* SEGACT,MLMOTS
  35. DO i = 1, MOTS(/2)
  36. mocomp = MOTS(i)
  37. DO j = 1, i-1
  38. IF (mocomp.EQ.MOTS(j)) MOTS(j) = ' '
  39. ENDDO
  40. ENDDO
  41. NCOMP = 0
  42. DO i = 1, MOTS(/2)
  43. IF (MOTS(i).NE.' ') NCOMP = NCOMP+1
  44. ENDDO
  45. IF (NCOMP.EQ.0) CALL ERREUR(5)
  46.  
  47. MLENT1 = MLIOPE
  48. C* SEGACT,MLENT1
  49. MLREE1 = MLBMIN
  50. C* SEGACT,MLREE1
  51. MLREE2 = MLBMAX
  52. C* SEGACT,MLREE2
  53.  
  54. C- Realisation du bornage des champs par point
  55. NSOUPO = IPCHP(/1)
  56. DO i = 1, NSOUPO
  57. MSOUP1 = IPCHP(i)
  58. SEGACT,MSOUP1
  59. MPOVA1 = MSOUP1.IPOVAL
  60. SEGACT,MPOVA1
  61. N = MPOVA1.VPOCHA(/1)
  62. NCOMP = MPOVA1.VPOCHA(/2)
  63. SEGINI,MSOUPO=MSOUP1
  64. SEGINI,MPOVAL=MPOVA1
  65. NC = 0
  66. DO icour = 1, NCOMP
  67. mocomp = MSOUP1.NOCOMP(icour)
  68. C* IF (mocomp.EQ.' ') GOTO 100
  69. CALL PLACE(MOTS,MOTS(/2),ncour,mocomp)
  70. IF (ncour.NE.0) THEN
  71. NC = NC+1
  72. NOCOMP(NC) = mocomp
  73. NOCONS(NC) = MSOUP1.NOCONS(icour)
  74. NOHARM(NC) = MSOUP1.NOHARM(icour)
  75. INDOPE = MLENT1.LECT(ncour)
  76. XBMIN = MLREE1.PROG(ncour)
  77. XBMAX = MLREE2.PROG(ncour)
  78. C- BORNER 'MAXIMUM' :
  79. IF (INDOPE.EQ.1) THEN
  80. DO j = 1, N
  81. VPOCHA(j,NC) = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  82. ENDDO
  83. C- BORNER 'MINIMUM' :
  84. ELSE IF (INDOPE.EQ.2) THEN
  85. DO j = 1, N
  86. VPOCHA(j,NC) = MAX( MPOVA1.VPOCHA(j,icour), XBMIN)
  87. ENDDO
  88. C- BORNER 'COMPRIS' :
  89. ELSE IF (INDOPE.EQ.3) THEN
  90. DO j = 1, N
  91. x = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  92. VPOCHA(j,NC) = MAX( x, XBMIN)
  93. ENDDO
  94. ELSE
  95. CALL ERREUR(5)
  96. ENDIF
  97. ENDIF
  98. C*100 CONTINUE
  99. ENDDO
  100. IF (NC.NE.0) THEN
  101. IRETS = IRETS + 1
  102. IF (NC.NE.NCOMP) THEN
  103. SEGADJ,MPOVAL,MSOUPO
  104. ENDIF
  105. IPCHP(IRETS) = MSOUPO
  106. IPOVAL = MPOVAL
  107. ELSE
  108. SEGSUP,MPOVAL,MSOUPO
  109. ENDIF
  110. ENDDO
  111.  
  112. IF (IRETS.GT.0) THEN
  113. IF (IRETS.NE.NSOUPO) THEN
  114. NSOUPO = IRETS
  115. NAT = JATTRI(/1)
  116. SEGADJ,MCHPOI
  117. ENDIF
  118. IPCHPS = MCHPOI
  119. ELSE
  120. CALL ERREUR(280)
  121. ENDIF
  122.  
  123. 900 CONTINUE
  124. IF (IPCHPS.EQ.0) SEGSUP,MCHPOI
  125.  
  126. RETURN
  127. END
  128.  
  129.  

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