Télécharger borne4.eso

Retour à la liste

Numérotation des lignes :

  1. C BORNE4 SOURCE PASCAL 20/07/06 21:15:01 10645
  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*4 mot4
  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. mot4 = MOTS(i)
  37. DO j = 1, i-1
  38. IF (mot4.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. mot4 = MSOUP1.NOCOMP(icour)
  68. C* IF (mot4.EQ.' ') GOTO 100
  69. CALL PLACE(MOTS,MOTS(/2),ncour,mot4)
  70. IF (ncour.NE.0) THEN
  71. NC = NC+1
  72. NOCOMP(NC) = mot4
  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. SEGDES,MPOVA1,MSOUP1
  101. IF (NC.NE.0) THEN
  102. IRETS = IRETS + 1
  103. IF (NC.NE.NCOMP) THEN
  104. SEGADJ,MPOVAL,MSOUPO
  105. ENDIF
  106. IPCHP(IRETS) = MSOUPO
  107. IPOVAL = MPOVAL
  108. SEGDES,MPOVAL,MSOUPO
  109. ELSE
  110. SEGSUP,MPOVAL,MSOUPO
  111. ENDIF
  112. ENDDO
  113.  
  114. IF (IRETS.GT.0) THEN
  115. IF (IRETS.NE.NSOUPO) THEN
  116. NSOUPO = IRETS
  117. NAT = JATTRI(/1)
  118. SEGADJ,MCHPOI
  119. ENDIF
  120. IPCHPS = MCHPOI
  121. ELSE
  122. CALL ERREUR(280)
  123. ENDIF
  124.  
  125. 900 CONTINUE
  126. IF (IPCHPS.NE.0) THEN
  127. SEGDES,MCHPOI
  128. ELSE
  129. SEGSUP,MCHPOI
  130. ENDIF
  131.  
  132. RETURN
  133. END
  134.  
  135.  
  136.  
  137.  

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