Télécharger borne4.eso

Retour à la liste

Numérotation des lignes :

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

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