Télécharger la plaquette Cast3M


fr en

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