Télécharger la plaquette Cast3M


fr en

Télécharger verit3.eso

Retour à la liste

Numérotation des lignes : 

verit3

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

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