Télécharger maxin4.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIN4 SOURCE BP208322 13/06/12 21:15:01 7776
  2. SUBROUTINE MAXIN4 (IPEVO,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,
  3. &IGRAND,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. 100 segdes kevoll
  54. IGRAND = mlree1
  55. JGRAND = mlree2
  56. IPLACE = mlenti
  57. if(jgok.ne.jg) then
  58. if(jgok.eq.0) goto 666
  59. write(ioimp,*) 'Seuls les objets EVOLUTION de type LISTREEL-'
  60. & ,'LISTREEL sont conservés'
  61. jg=jgok
  62. segadj,mlree1,mlree2,mlenti
  63. endif
  64. segdes,mlree1,mlree2,mlenti
  65.  
  66. else
  67.  
  68. IGRAND = 0
  69. JGRAND = 0
  70. kevoll = ievoll(1)
  71. segact kevoll
  72. if(TYPX.ne.'LISTREEL') goto 666
  73. if(TYPY.ne.'LISTREEL') goto 666
  74. IPRO = IPROGY
  75. CALL MAXIN3 (IPRO, IPLACE,OGRAND,KPLUS,LABSO)
  76. mlreel = IPROGX
  77. segact mlreel
  78. AGRAND = prog(IPLACE)
  79. segdes mlreel,kevoll
  80.  
  81. endif
  82.  
  83. C PAS D'ERREUR
  84. goto 900
  85.  
  86. c ERREUR
  87. 666 continue
  88. write(ioimp,*) 'L objet EVOLUTION doit etre de type LISTREEL-'
  89. &,'LISTREEL !'
  90. call erreur(21)
  91.  
  92. C FIN NORMALE
  93. 900 continue
  94. segdes mevoll
  95. RETURN
  96. END
  97.  
  98.  
  99.  

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