Télécharger veridy.eso

Retour à la liste

Numérotation des lignes :

  1. C VERIDY SOURCE CHAT 05/01/13 04:05:32 5004
  2. SUBROUTINE VERIDY(IBO,IPX,ICHA,ITOUS, ILEX,ITYPE)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C POUR OPERATEUR EVOL : POUR UN DYNAMIQUE,
  7. C VERIFIE LA COMPATIBILITE DU MSOLUT ET DU LISTREEL .
  8. C RETOUR :DANS ILEX UN SEGMENT MSOLEN QUI CONTIENT LA LISTE DES CHAMPS
  9. C A PRENDRE.
  10. C :ITYPE ='TEMPS '
  11. C CREATION : 14/10/85
  12. C PROGRAMMEUR : FARVACQUE
  13. C=======================================================================
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMSOLUT
  17. -INC SMLREEL
  18. CHARACTER*8 ITYPE
  19. C
  20. IF(IPX.EQ.0.AND.ITOUS.EQ.0) THEN
  21. MOTERR(1:8)='LISTREEL'
  22. CALL ERREUR(37)
  23. C DYNAMIQUE ON ATTEND UN PROG
  24. GOTO 5000
  25. ENDIF
  26. C
  27. C **** ON VERIFIE D'ABORD QUE LA SUITE IPX EST CROISSANTE
  28. C
  29. IF(IPX.EQ.0) THEN
  30. JG=0
  31. SEGINI MLREEL
  32. IPX=MLREEL
  33. ELSE
  34. MLREEL=IPX
  35. SEGACT MLREEL
  36. LCAS=PROG(/1)
  37. DO 161 I=2,LCAS
  38. IF(PROG(I).GT.PROG(I-1)) GOTO 161
  39. CALL ERREUR(249)
  40. C LA SUITE DE REELS DOIT ETRE CROISSANTE
  41. GOTO 5000
  42. 161 CONTINUE
  43. ENDIF
  44. C
  45. MSOLUT=IBO
  46. SEGACT MSOLUT
  47. MSOLRE=MSOLIS(1)
  48. SEGACT MSOLRE
  49. LTE=SOLRE(/1)
  50. IF (ITOUS.EQ.0) THEN
  51. N=LCAS
  52. ELSE
  53. N=LTE
  54. ENDIF
  55. SEGINI MSOLEN
  56. MSOLE1=MSOLIS(ICHA)
  57. SEGACT MSOLE1
  58. IF(ITOUS.EQ.1) GOTO 10
  59. C
  60. IF(LTE.LT.LCAS.OR.SOLRE(LTE).LT.PROG(LCAS)) GOTO 140
  61. C
  62. JJ1=1
  63. DO 152 I=1,LCAS
  64. T1=PROG(I)
  65. IF(T1.EQ.0.) THEN
  66. IF(SOLRE(1).EQ.0.) THEN
  67. JJ1=2
  68. ISOLEN(1)=MSOLE1.ISOLEN(1)
  69. GOTO 152
  70. ENDIF
  71. GOTO 140
  72. ENDIF
  73. J1=JJ1
  74. DO 153 J=J1,LTE
  75. T2=SOLRE(J)
  76. TR=ABS((T2-T1)/T1)
  77. PRECI = (SOLRE(LTE) - SOLRE(1))/(LTE*1000.)
  78. IF(TR.LT.PRECI) THEN
  79. JJ1=J+1
  80. K=MSOLE1.ISOLEN(J)
  81. IF(K.EQ.0) THEN
  82. GOTO 140
  83. ELSE
  84. ISOLEN(I)=K
  85. ENDIF
  86. GOTO 152
  87. ENDIF
  88. IF(T2.GT.T1) GOTO 140
  89. 153 CONTINUE
  90. 152 CONTINUE
  91. GOTO 11
  92. C
  93. 140 CONTINUE
  94. MOTERR(1:8)='SOLUTION'
  95. MOTERR(9:16)='LISTREEL'
  96. CALL ERREUR(135)
  97. GOTO 5000
  98. C
  99. C ****** CAS ITOUS=1 *************************
  100. C
  101. 10 CONTINUE
  102. II=0
  103. INN=0
  104. DO 1010 J=1,LTE
  105. K=MSOLE1.ISOLEN(J)
  106. IF(K.NE.0) INN=INN+1
  107. 1010 CONTINUE
  108. JG0=PROG(/1)
  109. JG=JG0+INN
  110. SEGADJ MLREEL
  111. INN=1
  112. DO 101 J=1,LTE
  113. K=MSOLE1.ISOLEN(J)
  114. IF(K.EQ.0) GOTO 101
  115. PROG(JG0+INN)=SOLRE(J)
  116. INN=INN+1
  117. II=II+1
  118. ISOLEN(II)=K
  119. 101 CONTINUE
  120. N=II
  121. SEGADJ MSOLEN
  122. C
  123. 11 CONTINUE
  124. ILEX=MSOLEN
  125. SEGDES MSOLRE,MSOLE1,MSOLUT
  126. SEGDES MLREEL,MSOLEN
  127. ITYPE='TEMPS'
  128. 5000 CONTINUE
  129. RETURN
  130. END
  131.  
  132.  

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