Télécharger la plaquette Cast3M


fr en

Télécharger verimo.eso

Retour à la liste

Numérotation des lignes : 

verimo

  1. C VERIMO    SOURCE    CHAT      05/01/13    04:05:38     5004
  2.       SUBROUTINE VERIMO(IBOS,IBONTI,ICHA,ITOUS,ILEX,IPX,ITYPE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C   POUR OPERATEUR EVOL : POUR UN MODE OU UN SOLSSTA,VERIFIE LA
  7. C   COMPATIBILITE DU MSOLUT ET DU LISTENTI .
  8. C   RETOUR :DANS ILEX UN SEGMENT MSOLEN QUI CONTIENT LA LISTE DES CHAMPS
  9. C           A PRENDRE, DANS IPX UN LISTREEL A METTRE DANS LE MEVOLL
  10. C          :ITYPE ='ITYSOL '
  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. -INC SMLENTI
  21.       CHARACTER*8 ITYPE
  22. C
  23.       IF(IBONTI.EQ.0.AND.ITOUS.EQ.0) THEN
  24.           MOTERR(1:8)='LISTENTI'
  25.           CALL ERREUR(37 )
  26. C         MODE ON ATTEND UN LECT
  27.           GOTO 5000
  28.       ENDIF
  29. C
  30. C **** ON VERIFIE D'ABORD QUE LA SUITE MLENTI EST CROISSANTE
  31. C
  32.       IF(IBONTI.NE.0) THEN
  33.          MLENTI=IBONTI
  34.          SEGACT MLENTI
  35.          LCAS=LECT(/1)
  36.          DO 161 I=2,LCAS
  37.          IF(LECT(I).LE.LECT(I-1)) GOTO 140
  38.   161    CONTINUE
  39.       ENDIF
  40. C
  41.       MSOLUT=IBOS
  42.       SEGACT MSOLUT
  43.       MSOLE1=MSOLIS(ICHA)
  44.       SEGACT MSOLE1
  45.       LTE=MSOLE1.ISOLEN(/1)
  46.       IF (ITOUS.EQ.0) THEN
  47.         N=LCAS
  48.       ELSE
  49.         N=LTE
  50.       ENDIF
  51.       SEGINI MSOLEN
  52.       ILEX=MSOLEN
  53.       JG=0
  54.       SEGINI MLREEL
  55.       IPX=MLREEL
  56.       IF(ITOUS.EQ.1) GOTO 10
  57. C
  58.       IF(LTE.LT.LCAS.OR.LTE.LT.LECT(LCAS)) GOTO 140
  59. C
  60.       INN=0
  61.       DO 1520 I=1,LCAS
  62.       K=MSOLE1.ISOLEN(LECT(I))
  63.       IF(K.NE.0) INN=INN+1
  64.  1520 CONTINUE
  65.       JG0 = PROG(/1)
  66.       JG=JG0 + INN
  67.       SEGADJ MLREEL
  68.       INN=1
  69.       DO 152 I=1,LCAS
  70.       K=MSOLE1.ISOLEN(LECT(I))
  71.       IF(K.EQ.0) GOTO 140
  72.       ISOLEN(I)=K
  73.       PROG(JG0+INN)=LECT(I)
  74.       INN=INN+1
  75.   152 CONTINUE
  76.       SEGDES MLENTI
  77.       GOTO 11
  78. C
  79.   140 CONTINUE
  80.       MOTERR(1:8)='SOLUTION'
  81.       MOTERR(9:16)='LISTENTI'
  82.       CALL ERREUR(135)
  83.       GOTO 5000
  84. C
  85. C  ****** CAS ITOUS=1 *************************
  86. C
  87.    10 CONTINUE
  88.       INN=0
  89.       DO 1010 J=1,LTE
  90.       K=MSOLE1.ISOLEN(J)
  91.       IF(K.NE.0) INN=INN+1
  92. 1010  CONTINUE
  93.       JG0= PROG(/1)
  94.       JG=JG0+INN
  95.       SEGADJ MLREEL
  96.       II=0
  97.       DO 101 J=1,LTE
  98.       K=MSOLE1.ISOLEN(J)
  99.       IF(K.EQ.0) GOTO 101
  100.       II=II+1
  101.       PROG(JG0+II)=J
  102.       ISOLEN(II)=K
  103.   101 CONTINUE
  104.       N=II
  105.       SEGADJ MSOLEN
  106. C
  107.   11  CONTINUE
  108.       SEGDES MSOLE1
  109.       SEGDES MLREEL,MSOLEN
  110.       ITYPE=ITYSOL
  111.       SEGDES MSOLUT
  112.  5000 CONTINUE
  113.       RETURN
  114.       END
  115.  
  116.  

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