Télécharger verit3.eso

Retour à la liste

Numérotation des lignes :

  1. C VERIT3 SOURCE BP208322 17/07/25 21:15:22 9518
  2. C
  3. SUBROUTINE VERIT3(ITABO,IPX,ITOUS,ILEX,ITYPE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C=======================================================================
  7. C POUR OPERATEUR EVOL RECO "TABLE_RESULTAT_DYNE"
  8. C VERIFIE LA COMPATIBILITE DU CONTENU DE LA TABLE ET DU LISTREEL IPX
  9. C RETOUR :DANS ILEX UN SEGMENT MLENTI QUI CONTIENT LA LISTE DES CHAMPS
  10. C A PRENDRE.
  11. C :ITYPE ='TEMPS '
  12. C CREATION : bp,2017-07-20 fortement inspire de VERITA.eso
  13. C=======================================================================
  14. CHARACTER*8 ITYPE,ICHA2,MOMO,MOE,MOT,CHARRE
  15. CHARACTER*15 ICHAI
  16. CHARACTER*4 MCHA
  17. LOGICAL L0,L1
  18. -INC CCOPTIO
  19. -INC SMELEME
  20. -INC SMTABLE
  21. -INC SMLENTI
  22. -INC SMSOLUT
  23. -INC SMLREEL
  24. DATA MOT /'MOT '/
  25. DATA MOE /'ENTIER '/
  26. DATA ICHAI /'TEMPS_DE_SORTIE'/
  27. C======================================================================
  28.  
  29. c----------------------------------------------------------------------
  30. C SI ITOUS=0, ON DOIT AVOIR UN IPX EN DONNEE, SINON ERREUR
  31. c----------------------------------------------------------------------
  32. IF(IPX.EQ.0.AND.ITOUS.EQ.0) THEN
  33. MOTERR(1:8)='LISTREEL'
  34. CALL ERREUR(37)
  35. RETURN
  36. ENDIF
  37.  
  38. C --- ON RECUPERE LE POINTEUR SUR LA LISTE DES PAS DE SORTIE
  39. LBO=0
  40. CALL ACCTAB(ITABO,MOT,I0,X0,ICHAI,L0,IRET0,
  41. 1 'LISTREEL',I1,X1,ICHA2,L1,LBO)
  42. MLREEL=LBO
  43. SEGACT MLREEL
  44. LTE =PROG(/1)
  45. SEGDES MLREEL
  46. IDEPAR=0
  47.  
  48. c----------------------------------------------------------------------
  49. C si TOUS LES PAS DE TEMPS SONT DEMANDES
  50. c----------------------------------------------------------------------
  51. IF (ITOUS.NE.0) GOTO 10
  52.  
  53. c----------------------------------------------------------------------
  54. c CAS OU UNE LISTE IPX EST FOURNIE
  55. c----------------------------------------------------------------------
  56.  
  57. MLREE1=IPX
  58. SEGACT MLREE1
  59. LCAS=MLREE1.PROG(/1)
  60.  
  61. C --- ON VERIFIE D'ABORD QUE LA SUITE IPX EST CROISSANTE
  62. DO 161 I=2,LCAS
  63. IF(MLREE1.PROG(I).GT.MLREE1.PROG(I-1)) GOTO 161
  64. CALL ERREUR(249)
  65. C LA SUITE DE REELS DOIT ETRE CROISSANTE
  66. RETURN
  67. 161 CONTINUE
  68.  
  69. C --- ON VA CREER LA TABLE DES INDICES A PRENDRE
  70. JG=LCAS
  71. SEGINI MLENTI
  72. C
  73. MLREEL=LBO
  74. SEGACT MLREEL
  75. LTE =PROG(/1)
  76. PRECI = (PROG(LTE)-PROG(1))/(LTE*100)
  77. * PRECI = 1.E-3
  78. c rem bp : heureusement que DYNE fonctionne a pas de temps constant !
  79. c sinon il faudrait revoir la def de PRECI !!!
  80. ITOS=1
  81. DO 152 KJ=1,LCAS
  82. TSEAR = MLREE1.PROG(KJ)
  83. CALL PLACE3 (PROG,ITOS,LTE,TSEAR,IPOS,AR)
  84. IF (AR.LE.PRECI) THEN
  85. GO TO 149
  86. ELSE
  87. RAR=ABS(1.-AR)
  88. IF (RAR.LE.PRECI) THEN
  89. IPOS=IPOS+1
  90. GO TO 149
  91. ELSE
  92. MOTERR(1:8) = 'TABLE '
  93. MOTERR(9:16) ='LISTREEL'
  94. CALL ERREUR(135)
  95. RETURN
  96. ENDIF
  97. ENDIF
  98. 149 LECT(KJ) = IPOS
  99. ITOS=IPOS
  100. 152 CONTINUE
  101. SEGDES,MLREE1,MLREEL,MLENTI
  102. ILEX=MLENTI
  103. GOTO 5001
  104. C
  105. c----------------------------------------------------------------------
  106. C CAS ITOUS = 1 (TOUS LES PAS DE TEMPS SONT DEMANDES)
  107. c----------------------------------------------------------------------
  108. C
  109. 10 CONTINUE
  110. C
  111. CALL COPIE4 (LBO, IPX)
  112. JG=LTE
  113. SEGINI MLENTI
  114. DO 1110 I=1,LTE
  115. LECT(I)=I
  116. 1110 CONTINUE
  117. SEGDES MLENTI
  118. ILEX=MLENTI
  119.  
  120. c----------------------------------------------------------------------
  121. C FIN NORMALE
  122. c----------------------------------------------------------------------
  123.  
  124. 5001 ITYPE='TEMPS'
  125.  
  126. RETURN
  127. END
  128.  
  129.  
  130.  
  131.  
  132.  

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