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.  
  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