Download maxin6.eso

Back to the list

   1 : C MAXIN6    SOURCE    CHAT      11/11/09    21:15:07     7187           
   2 :       subroutine maxin6(ipoin1,ipoin2,ipoin3,montyp,kplus)
   3 : C   min max entre 2 listreel ou 2 listenti
   4 :       implicit real*8(a-h,o-z)
   5 :       implicit integer (i-n)
   6 :       character*(8) montyp
   7 : -INC CCOPTIO
   8 : -INC SMLREEL
   9 : -INC SMLENTI
  10 :       if( MONTYP.eq.'LISTENTI') then
  11 : * cas des listenti
  12 :     1   continue
  13 :         mlenti=ipoin1
  14 :         mlent1=ipoin2
  15 :         segact mlenti,mlent1
  16 :         jg=lect(/1)
  17 :         if( mlent1.lect(/1).ne.jg) then
  17 :           call erreur(217)
  18 :           return
  19 :         endif
  20 :         segini mlent2
  21 :         ipoin3=mlent2
  22 :         if( kplus.eq.1) then
  23 :           do i=1,jg
  24 :             mlent2.lect(i)= max(lect(i),mlent1.lect(i))
  25 :           enddo
  26 :         else
  27 :           do i=1,jg
  28 :             mlent2.lect(i)= min(lect(i),mlent1.lect(i))
  29 :           enddo 
  30 :         endif
  31 :         segdes mlenti,mlent1,mlent2
  32 :         mlenti=mlent2
  32 :         call lirobj(montyp,ipoin2,0,iretou)
  33 :         if(iretou.ne.0) go to 1  
  34 :       else       
  35 : * cas des listreels
  36 :     2   continue
  37 :         mlreel=ipoin1
  38 :         mlree1=ipoin2
  39 :         segact mlreel,mlree1
  40 :         jg=prog(/1)
  41 :         if( mlree1.prog(/1).ne.jg) then
  41 :           call erreur(217)
  42 :           return
  43 :         endif
  44 :         segini mlree2
  45 :         ipoin3=mlree2
  46 :         if( kplus.eq.1) then
  47 :           do i=1,jg
  48 :             mlree2.prog(i)= max(prog(i),mlree1.prog(i))
  49 :           enddo
  50 :         else
  51 :           do i=1,jg
  52 :             mlree2.prog(i)= min(prog(i),mlree1.prog(i))
  53 :           enddo 
  54 :         endif
  55 :         segdes mlreel,mlree1,mlree2
  56 :         mlreel=mlree2
  56 :         call lirobj(montyp,ipoin2,0,iretou)
  57 :         if(iretou.ne.0) go to 2  
  58 :       endif    
  59 :       return 
  60 :       end
  61 :                
  62 :  

© Cast3M 2003 - All rights reserved.
Disclaimer