Télécharger la plaquette Cast3M


fr en

Télécharger veridy.eso

Retour à la liste

Numérotation des lignes : 

veridy

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

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