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

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