Télécharger verimo.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMSOLUT
  17. -INC SMLREEL
  18. -INC SMLENTI
  19. CHARACTER*8 ITYPE
  20. C
  21. IF(IBONTI.EQ.0.AND.ITOUS.EQ.0) THEN
  22. MOTERR(1:8)='LISTENTI'
  23. CALL ERREUR(37 )
  24. C MODE ON ATTEND UN LECT
  25. GOTO 5000
  26. ENDIF
  27. C
  28. C **** ON VERIFIE D'ABORD QUE LA SUITE MLENTI EST CROISSANTE
  29. C
  30. IF(IBONTI.NE.0) THEN
  31. MLENTI=IBONTI
  32. SEGACT MLENTI
  33. LCAS=LECT(/1)
  34. DO 161 I=2,LCAS
  35. IF(LECT(I).LE.LECT(I-1)) GOTO 140
  36. 161 CONTINUE
  37. ENDIF
  38. C
  39. MSOLUT=IBOS
  40. SEGACT MSOLUT
  41. MSOLE1=MSOLIS(ICHA)
  42. SEGACT MSOLE1
  43. LTE=MSOLE1.ISOLEN(/1)
  44. IF (ITOUS.EQ.0) THEN
  45. N=LCAS
  46. ELSE
  47. N=LTE
  48. ENDIF
  49. SEGINI MSOLEN
  50. ILEX=MSOLEN
  51. JG=0
  52. SEGINI MLREEL
  53. IPX=MLREEL
  54. IF(ITOUS.EQ.1) GOTO 10
  55. C
  56. IF(LTE.LT.LCAS.OR.LTE.LT.LECT(LCAS)) GOTO 140
  57. C
  58. INN=0
  59. DO 1520 I=1,LCAS
  60. K=MSOLE1.ISOLEN(LECT(I))
  61. IF(K.NE.0) INN=INN+1
  62. 1520 CONTINUE
  63. JG0 = PROG(/1)
  64. JG=JG0 + INN
  65. SEGADJ MLREEL
  66. INN=1
  67. DO 152 I=1,LCAS
  68. K=MSOLE1.ISOLEN(LECT(I))
  69. IF(K.EQ.0) GOTO 140
  70. ISOLEN(I)=K
  71. PROG(JG0+INN)=LECT(I)
  72. INN=INN+1
  73. 152 CONTINUE
  74. SEGDES MLENTI
  75. GOTO 11
  76. C
  77. 140 CONTINUE
  78. MOTERR(1:8)='SOLUTION'
  79. MOTERR(9:16)='LISTENTI'
  80. CALL ERREUR(135)
  81. GOTO 5000
  82. C
  83. C ****** CAS ITOUS=1 *************************
  84. C
  85. 10 CONTINUE
  86. INN=0
  87. DO 1010 J=1,LTE
  88. K=MSOLE1.ISOLEN(J)
  89. IF(K.NE.0) INN=INN+1
  90. 1010 CONTINUE
  91. JG0= PROG(/1)
  92. JG=JG0+INN
  93. SEGADJ MLREEL
  94. II=0
  95. DO 101 J=1,LTE
  96. K=MSOLE1.ISOLEN(J)
  97. IF(K.EQ.0) GOTO 101
  98. II=II+1
  99. PROG(JG0+II)=J
  100. ISOLEN(II)=K
  101. 101 CONTINUE
  102. N=II
  103. SEGADJ MSOLEN
  104. C
  105. 11 CONTINUE
  106. SEGDES MSOLE1
  107. SEGDES MLREEL,MSOLEN
  108. ITYPE=ITYSOL
  109. SEGDES MSOLUT
  110. 5000 CONTINUE
  111. RETURN
  112. END
  113.  
  114.  

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