Esope source files

   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
  42 :           CALL MAXIN3 (IPRO,  IPLACE,OGRAND,KPLUS,LABSO)
  43 :           mlree2.prog(jgok) = OGRAND
  44 :           mlenti.lect(jgok) = IPLACE                       
  45 :           mlreel = IPROGX
  46 :           segact mlreel
  47 :           AGRAND = prog(IPLACE)
  48 :           mlree1.prog(jgok) = AGRAND
  49 :           segdes mlreel 
  50 :  100    segdes kevoll         
  51 :         IGRAND = mlree1
  52 :         JGRAND = mlree2
  53 :         IPLACE = mlenti
  54 :         if(jgok.ne.jg) then
  55 :           if(jgok.eq.0) goto 666
  56 :           write(ioimp,*) 'Seuls les objets EVOLUTION de type LISTREEL-'
  57 :      &    ,'LISTREEL sont conservés'
  58 :           jg=jgok
  59 :           segadj,mlree1,mlree2,mlenti
  60 :         endif
  61 :         segdes,mlree1,mlree2,mlenti
  62 :         
  63 :       else
  64 :       
  65 :         IGRAND = 0
  66 :         JGRAND = 0
  67 :         kevoll = ievoll(1)
  68 :         segact kevoll
  69 :         if(TYPX.ne.'LISTREEL') goto 666
  70 :         if(TYPY.ne.'LISTREEL') goto 666
  71 :         IPRO = IPROGY
  71 :         CALL MAXIN3 (IPRO,  IPLACE,OGRAND,KPLUS,LABSO)                       
  72 :         mlreel = IPROGX
  73 :         segact mlreel
  74 :         AGRAND = prog(IPLACE)
  75 :         segdes mlreel,kevoll
  76 :         
  77 :       endif
  78 :       
  79 : C     PAS D'ERREUR
  80 :       goto 900
  81 : 
  82 : c     ERREUR
  83 :  666  continue
  84 :       write(ioimp,*) 'L objet EVOLUTION doit etre de type LISTREEL-'
  85 :      &,'LISTREEL !'
  85 :       call erreur(21)
  86 :       
  87 : C     FIN NORMALE
  88 :  900  continue
  89 :       segdes mevoll
  90 :       RETURN
  91 :       END
  92 :  
  93 :