Esope source files

   1 : C EXISZO    SOURCE    KICH      12/08/06    21:15:25     7460           
   2 :       SUBROUTINE EXISZO(IVAL,IRET)                                 
   3 : C----------------------------------------------------------------------         
   4 : C    EXISTENCE D'UNE ZONE UN MCHAML                    
   5 : C----------------------------------------------------------------------         
   6 :       IMPLICIT INTEGER(I-N)
   7 : -INC CCOPTIO                                                                    
   8 : -INC SMCHAML    
   9 : -INC SMELEME
  10 : -INC SMMODEL
  11 :       LOGICAL IRET,dmai2   
  12 :       character*(LCONMO) consu 
  13 :  
  14 : 
  15 :       iret = .false.
  16 : 
  16 :       call lirobj('MAILLAGE',ipma,0,iret1)
  17 :       if (ierr.ne.0) return
  18 :       if (iret1.eq.0) then
  18 :         call lirobj('MMODEL  ',ipma,0,iret2)
  19 :         if (ierr.ne.0) return
  20 :         if (iret2.eq.0) return
  21 :         if (iret2.ne.0) goto 700
  22 :       endif
  23 : 
  24 :       ipt2 = ipma
  25 :       segact ipt2
  26 :       lisou = ipt2.lisous(/1)
  27 :       dmai2 = .false.
  28 :       if (lisou.gt.0) dmai2 = .true.
  29 : 
  30 :  600  CONTINUE                                                                  
  31 :       MCHELM=IVAL                                                               
  32 :       SEGACT MCHELM                                                             
  33 :       NSOUS=IMACHE(/1)                                                          
  34 : C                                                                               
  35 : C     BOUCLE SUR LES SOUS PAQUETS DE MCHELM                                     
  36 : C                                                                               
  37 :       DO 100 IA=1,NSOUS                                                         
  38 :       iptu = IMACHE(IA)        
  39 :       if (dmai2) then
  40 :        do isou = 1,lisou
  41 :        if (iptu.eq.ipt2.lisous(isou)) then
  42 :          iret = .true.
  43 :          goto 120
  44 :        endif 
  45 :        enddo
  46 :       else 
  47 :        if (iptu.eq.ipt2) then
  48 :          iret = .true.
  49 :          goto 120
  50 :        endif 
  51 :       endif                                                
  52 :  100  CONTINUE                                           
  53 :  120  CONTINUE                                                                  
  54 :          segdes ipt2
  55 :       SEGDES MCHELM                                                             
  56 :       RETURN
  57 : 
  58 :  700  CONTINUE
  59 :       mmode1 = ipma
  60 :       segact mmode1
  61 :       n1 = mmode1.kmodel(/1)
  62 :       MCHELM=IVAL                                                               
  63 :       SEGACT MCHELM                                                             
  64 :       NSOUS=IMACHE(/1)                                                          
  65 : C                                                                               
  66 : C     BOUCLE SUR LES SOUS PAQUETS DE MCHELM                                     
  67 : C                                                                               
  68 :       DO 800 IA=1,NSOUS
  69 :        iptu = IMACHE(IA)   
  70 :        consu = conche(ia)     
  71 :        do 750 in1 = 1,n1
  72 :          imode1= mmode1.kmodel(in1)
  73 :          segact imode1
  74 :          if (imode1.imamod.eq.iptu.and.
  75 :      &imode1.conmod.eq.consu) then
  76 :            iret = .true.
  77 :            goto 810
  78 :          endif 
  79 :  750   continue
  80 :                                                          
  81 :  800  CONTINUE    
  82 :  810  CONTINUE                                       
  83 :        do 850 in1 = 1,n1
  84 :          imode1= mmode1.kmodel(in1)
  85 :          segdes imode1
  86 :  850   continue
  87 : 
  88 :          segdes mmode1
  89 :       SEGDES MCHELM                                                             
  90 :       RETURN
  91 : 
  92 :       END
  93 :