Télécharger maxin4.eso

Retour à la liste

Numérotation des lignes :

maxin4
  1. C MAXIN4 SOURCE PV 21/04/26 21:15:14 10978
  2. SUBROUTINE MAXIN4 (IPEVO,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,
  3. &KGRAND,JGRAND)
  4. ************************************************************************
  5. *
  6. * M A X I N 4
  7. * -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * FOURNIR LA PLUS GRANDE VALEUR D'UNE EVOLUTION
  13. * indice / abscisse / ordonnée
  14. * appelle maxin3
  15. *
  16. ************************************************************************
  17. *
  18. IMPLICIT INTEGER(I-N)
  19. -INC SMEVOLL
  20. -INC SMLREEL
  21. -INC SMLENTI
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. REAL*8 AGRAND,OGRAND
  26.  
  27. MEVOLL = IPEVO
  28. segact mevoll
  29. nevo = ievoll(/1)
  30. jg = nevo
  31. jgok = 0
  32.  
  33. if (nevo.gt.1) then
  34.  
  35. segini mlree1,mlree2,mlenti
  36. c on boucle sur les sous evolutions
  37. do 100 in = 1, nevo
  38. kevoll = ievoll(in)
  39. segact kevoll
  40. c on verifie d'abord qu'il s'agisse bien de listreel-listreel
  41. if(TYPX.ne.'LISTREEL') goto 100
  42. if(TYPY.ne.'LISTREEL') goto 100
  43. jgok=jgok+1
  44. IPRO = IPROGY
  45. CALL MAXIN3 (IPRO, IPLACE,OGRAND,KPLUS,LABSO)
  46. mlree2.prog(jgok) = OGRAND
  47. mlenti.lect(jgok) = IPLACE
  48. mlreel = IPROGX
  49. segact mlreel
  50. AGRAND = prog(IPLACE)
  51. mlree1.prog(jgok) = AGRAND
  52. segdes mlreel
  53. segdes kevoll
  54. 100 continue
  55. KGRAND = mlree1
  56. JGRAND = mlree2
  57. IPLACE = mlenti
  58. if(jgok.ne.jg) then
  59. if(jgok.eq.0) goto 666
  60. write(ioimp,*) 'Seuls les objets EVOLUTION de type LISTREEL-'
  61. & ,'LISTREEL sont conservés'
  62. jg=jgok
  63. segadj,mlree1,mlree2,mlenti
  64. endif
  65. segdes,mlree1,mlree2,mlenti
  66.  
  67. else
  68.  
  69. KGRAND = 0
  70. JGRAND = 0
  71. kevoll = ievoll(1)
  72. segact kevoll
  73. if(TYPX.ne.'LISTREEL') goto 666
  74. if(TYPY.ne.'LISTREEL') goto 666
  75. IPRO = IPROGY
  76. CALL MAXIN3 (IPRO, IPLACE,OGRAND,KPLUS,LABSO)
  77. mlreel = IPROGX
  78. segact mlreel
  79. AGRAND = prog(IPLACE)
  80. segdes mlreel,kevoll
  81.  
  82. endif
  83.  
  84. C PAS D'ERREUR
  85. goto 900
  86.  
  87. c ERREUR
  88. 666 continue
  89. write(ioimp,*) 'L objet EVOLUTION doit etre de type LISTREEL-'
  90. &,'LISTREEL !'
  91. call erreur(21)
  92.  
  93. C FIN NORMALE
  94. 900 continue
  95. segdes mevoll
  96. RETURN
  97. END
  98.  
  99.  
  100.  
  101.  

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