Esope source files

   1 : C QUIDAN    SOURCE    CHAT      05/01/13    02:42:19     5004           
   2 : C  METS DANS ISGTR TOUS LES OBJETS DE ITLAC DONS LES NOEUDS SONT                
   3 : C  INFERIEURS A IMAX                                                            
   4 : C                                                                               
   5 :       SUBROUTINE QUIDAN(ISGTR,ITLAC,IMAX)                                       
   6 :       IMPLICIT INTEGER(I-N)
   7 : -INC SMELEME                                                                    
   8 :       SEGMENT ITLAC(0)                                                          
   9 :       SEGMENT ISGTR(0)                                                          
  10 :       DO 1 II=1,ITLAC(/1)                                                       
  11 :       IPT1=ITLAC(II)                                                            
  12 :       SEGACT IPT1                                                               
  13 :       IPT2=IPT1                                                                 
  14 :       DO 11 JJ=1,MAX(1,IPT2.LISOUS(/1))                                         
  15 :       IF (IPT2.LISOUS(/1).NE.0) THEN                                            
  16 :        IPT1=IPT2.LISOUS(JJ)                                                     
  17 :        SEGACT IPT1                                                              
  18 :       ENDIF                                                                     
  19 :       IF(IPT1.NUM(/1).EQ.0) GO TO 15                                            
  20 :       IF(IPT1.NUM(/2).EQ.0) GO TO 15                                            
  21 :       DO 2 I=1,IPT1.NUM(/1)                                                     
  22 :       DO 2 J=1,IPT1.NUM(/2)                                                     
  23 :       IF (IPT1.NUM(I,J).GT.IMAX) GOTO 15                                        
  24 :    2  CONTINUE                                                                  
  25 :       IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT1                                     
  26 :   11  CONTINUE                                                                  
  27 :       SEGDES IPT2                                                               
  28 :       ISGTR(**)=IPT2                                                            
  29 :   15  SEGDES IPT1,IPT2                                                          
  30 :    1  CONTINUE                                                                  
  31 :       RETURN                                                                    
  32 :       END                                                                       
  33 :