Télécharger chglim.eso

Retour à la liste

Numérotation des lignes :

  1. C CHGLIM SOURCE CHAT 05/01/12 21:56:40 5004
  2. SUBROUTINE CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N,IP,
  3. * IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCOPTIO
  7. -INC SMLREEL
  8. -INC SMTABLE
  9. -INC CCREEL
  10. POINTEUR MLREE4.MLREEL
  11. *
  12. * CALCUL DES VALEURS L(I,J) & U(I,J)
  13. *
  14. * en sortie ivmin et ivmax contiennent les nouvelles bornes de x
  15. * c'est a dire les anciens ivxmin et ivxmax
  16. *
  17. * methode normale avec t0
  18. *
  19. IF(IMETH.EQ.1) THEN
  20. MLREEL=IVX0
  21. MLREE1=IVLL
  22. MLREE2=IT0
  23. SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  24. NN=PROG(/1)
  25. DO 1 K=1,NN-1
  26. MLREE1.PROG(K)=MLREE2.PROG(K)*PROG(K)
  27. 1 CONTINUE
  28. MLREE1.PROG(NN)=0.00
  29. IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE1.PROG(K),K=1,N)
  30. 11 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5))
  31. MLREE1=IVUL
  32. SEGACT MLREE1*MOD
  33. DO 2 K=1,NN-1
  34. MLREE1.PROG(K)=PROG(K)/MLREE2.PROG(K)
  35. 2 CONTINUE
  36. MLREE1.PROG(NN)=XSMAX+1.
  37. IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE1.PROG(K),K=1,N)
  38. 12 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5))
  39. *
  40. * methode MOVLIM sur s0
  41. *
  42. ELSEIF(IMETH.EQ.2) THEN
  43. IF(IP.LT.3) THEN
  44. MLREEL=IVX0
  45. MLREE1=IVXMAX
  46. MLREE2=IVXMIN
  47. MLREE3=IVLL
  48. SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
  49. DO 20 K=1,N-1
  50. MLREE3.PROG(K)=PROG(K)* 0.7
  51. 20 CONTINUE
  52. MLREE3.PROG(N)=0.00
  53. IF(IIMPI.EQ.1799) WRITE(IOIMP,31)(MLREE3.PROG(K),K=1,N)
  54. 31 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5))
  55. MLREE3=IVUL
  56. SEGACT MLREE3*MOD
  57. DO 22 K=1,N
  58. MLREE3.PROG(K)=MLREE1.PROG(K)-MLREE2.PROG(K)
  59. MLREE3.PROG(K)=PROG(K)+MLREE3.PROG(K)
  60. MLREE3.PROG(K)=PROG(K)/ 0.7
  61. 22 CONTINUE
  62. MLREE3.PROG(N)=XSMAX +1.
  63. IF(IIMPI.EQ.1799) WRITE(IOIMP,32)(MLREE3.PROG(K),K=1,N)
  64. 32 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5))
  65. ELSE
  66. MLREEL=IVX0
  67. MLREE1=IVXPR1
  68. MLREE2=IVXPR2
  69. MLREE4=IS0
  70. SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE4*MOD
  71. JG=N
  72. SEGINI MLREE3
  73. DO 23 K=1,N-1
  74. OSCIL=(PROG(K)-MLREE1.PROG(K))*(MLREE1.PROG(K)-MLREE2.PROG(K))
  75. IF(OSCIL.LT.0) THEN
  76. MLREE3.PROG(K)=MLREE4.PROG(K)
  77. ELSE
  78. MLREE3.PROG(K)=1./MLREE4.PROG(K)
  79. ENDIF
  80. 23 CONTINUE
  81. MLREE1=IVLL
  82. MLREE2=IVXPR1
  83. SEGACT MLREE1*MOD,MLREE2*MOD
  84. DO 24 K=1,N-1
  85. MLREE1.PROG(K)=PROG(K) - MLREE3.PROG(K)*
  86. * (MLREE2.PROG(K)-MLREE1.PROG(K))
  87. 24 CONTINUE
  88. MLREE1.PROG(N)=0.00
  89. MLREE1=IVUL
  90. MLREE2=IVXPR1
  91. SEGACT MLREE1*MOD,MLREE2*MOD
  92. DO 25 K=1,N-1
  93. MLREE1.PROG(K)=PROG(K) + MLREE3.PROG(K)*
  94. * (MLREE1.PROG(K)-MLREE2.PROG(K))
  95. 25 CONTINUE
  96. MLREE1.PROG(N)=XSMAX + 1.
  97. SEGSUP MLREE3
  98. ENDIF
  99. *
  100. * methode lineaire
  101. *
  102. ELSEIF(IMETH.EQ.3) THEN
  103. MLREEL=IVLL
  104. MLREE1=IVUL
  105. MLREE2=IVX0
  106. SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  107. NN1 = MLREE2.PROG(/1)-1
  108. DO 41 K=1,NN1
  109. PROG(K)=0.
  110. MLREE1.PROG(K)=1000.*MLREE2.PROG(K)
  111. 41 CONTINUE
  112. PROG(N)=0.D0
  113. MLREE1.PROG(N)=XSMAX+1.
  114. IF(IIMPI.EQ.1799) WRITE(IOIMP,51)(PROG(K),K=1,N)
  115. 51 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5))
  116. IF(IIMPI.EQ.1799) WRITE(IOIMP,52)(MLREE1.PROG(K),K=1,N)
  117. 52 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5))
  118. ENDIF
  119. *
  120. * partie commune au trois methode : calcul de bornes inf et sup
  121. *
  122. MLREEL=IVX0
  123. MLREE1=IVLL
  124. MLREE3=IVXMIN
  125. SEGACT MLREEL*MOD,MLREE1*MOD,MLREE3*MOD
  126. JG=N
  127. SEGINI MLREE2
  128. IVMIN=MLREE2
  129. DO 3 K=1,N
  130. MLREE2.PROG(K)=MLREE3.PROG(K)
  131. CTE=0.95*MLREE1.PROG(K) + 0.05* PROG(K)
  132. IF( MLREE2.PROG(K).LE.CTE) MLREE2.PROG(K)=CTE
  133. 3 CONTINUE
  134. MLREE2.PROG(N)=1.
  135. MLREE1=IVUL
  136. MLREE3=IVXMAX
  137. SEGACT MLREE1*MOD,MLREE3*MOD
  138. JG=N
  139. SEGINI MLREE2
  140. IVMAX=MLREE2
  141. DO 4 K=1,N
  142. CTE=0.95*MLREE1.PROG(K) + 0.05 *PROG(K)
  143. MLREE2.PROG(K)=MLREE3.PROG(K)
  144. IF(MLREE2.PROG(K).GE.CTE) MLREE2.PROG(K)=CTE
  145. 4 CONTINUE
  146. MLREEL=IVMIN
  147. MLREE1=IVXMIN
  148. SEGACT MLREEL*MOD,MLREE1*MOD
  149. DO 6 K=1,N
  150. IF(MLREE1.PROG(K).GT.PROG(K))PROG(K)=MLREE1.PROG(K)
  151. 6 CONTINUE
  152. MLREEL=IVMAX
  153. MLREE1=IVXMAX
  154. SEGACT MLREEL*MOD,MLREE1*MOD
  155. DO 7 K=1,N
  156. IF(MLREE1.PROG(K).LT.PROG(K))PROG(K)=MLREE1.PROG(K)
  157. 7 CONTINUE
  158. RETURN
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  

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