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. -INC CCOPTIO
  23. REAL*8 AGRAND,OGRAND
  24.  
  25. MEVOLL = IPEVO
  26. segact mevoll
  27. nevo = ievoll(/1)
  28. jg = nevo
  29. jgok = 0
  30.  
  31. if (nevo.gt.1) then
  32.  
  33. segini mlree1,mlree2,mlenti
  34. c on boucle sur les sous evolutions
  35. do 100 in = 1, nevo
  36. kevoll = ievoll(in)
  37. segact kevoll
  38. c on verifie d'abord qu'il s'agisse bien de listreel-listreel
  39. if(TYPX.ne.'LISTREEL') goto 100
  40. if(TYPY.ne.'LISTREEL') goto 100
  41. jgok=jgok+1
  42. IPRO = IPROGY
  43. CALL MAXIN3 (IPRO, IPLACE,OGRAND,KPLUS,LABSO)
  44. mlree2.prog(jgok) = OGRAND
  45. mlenti.lect(jgok) = IPLACE
  46. mlreel = IPROGX
  47. segact mlreel
  48. AGRAND = prog(IPLACE)
  49. mlree1.prog(jgok) = AGRAND
  50. segdes mlreel
  51. 100 segdes kevoll
  52. IGRAND = mlree1
  53. JGRAND = mlree2
  54. IPLACE = mlenti
  55. if(jgok.ne.jg) then
  56. if(jgok.eq.0) goto 666
  57. write(ioimp,*) 'Seuls les objets EVOLUTION de type LISTREEL-'
  58. & ,'LISTREEL sont conservés'
  59. jg=jgok
  60. segadj,mlree1,mlree2,mlenti
  61. endif
  62. segdes,mlree1,mlree2,mlenti
  63.  
  64. else
  65.  
  66. IGRAND = 0
  67. JGRAND = 0
  68. kevoll = ievoll(1)
  69. segact kevoll
  70. if(TYPX.ne.'LISTREEL') goto 666
  71. if(TYPY.ne.'LISTREEL') goto 666
  72. IPRO = IPROGY
  73. CALL MAXIN3 (IPRO, IPLACE,OGRAND,KPLUS,LABSO)
  74. mlreel = IPROGX
  75. segact mlreel
  76. AGRAND = prog(IPLACE)
  77. segdes mlreel,kevoll
  78.  
  79. endif
  80.  
  81. C PAS D'ERREUR
  82. goto 900
  83.  
  84. c ERREUR
  85. 666 continue
  86. write(ioimp,*) 'L objet EVOLUTION doit etre de type LISTREEL-'
  87. &,'LISTREEL !'
  88. call erreur(21)
  89.  
  90. C FIN NORMALE
  91. 900 continue
  92. segdes mevoll
  93. RETURN
  94. END
  95.  
  96.  
  97.  

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