C EXISZO SOURCE KICH 12/08/06 21:15:25 7460 SUBROUTINE EXISZO(IVAL,IRET) C---------------------------------------------------------------------- C EXISTENCE D'UNE ZONE UN MCHAML C---------------------------------------------------------------------- IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMELEME -INC SMMODEL LOGICAL IRET,dmai2 character*(LCONMO) consu iret = .false. call lirobj('MAILLAGE',ipma,0,iret1) if (ierr.ne.0) return if (iret1.eq.0) then call lirobj('MMODEL ',ipma,0,iret2) if (ierr.ne.0) return if (iret2.eq.0) return if (iret2.ne.0) goto 700 endif ipt2 = ipma segact ipt2 lisou = ipt2.lisous(/1) dmai2 = .false. if (lisou.gt.0) dmai2 = .true. 600 CONTINUE MCHELM=IVAL SEGACT MCHELM NSOUS=IMACHE(/1) C C BOUCLE SUR LES SOUS PAQUETS DE MCHELM C DO 100 IA=1,NSOUS iptu = IMACHE(IA) if (dmai2) then do isou = 1,lisou if (iptu.eq.ipt2.lisous(isou)) then iret = .true. goto 120 endif enddo else if (iptu.eq.ipt2) then iret = .true. goto 120 endif endif 100 CONTINUE 120 CONTINUE segdes ipt2 SEGDES MCHELM RETURN 700 CONTINUE mmode1 = ipma segact mmode1 n1 = mmode1.kmodel(/1) MCHELM=IVAL SEGACT MCHELM NSOUS=IMACHE(/1) C C BOUCLE SUR LES SOUS PAQUETS DE MCHELM C DO 800 IA=1,NSOUS iptu = IMACHE(IA) consu = conche(ia) do 750 in1 = 1,n1 imode1= mmode1.kmodel(in1) segact imode1 if (imode1.imamod.eq.iptu.and. &imode1.conmod.eq.consu) then iret = .true. goto 810 endif 750 continue 800 CONTINUE 810 CONTINUE do 850 in1 = 1,n1 imode1= mmode1.kmodel(in1) segdes imode1 850 continue segdes mmode1 SEGDES MCHELM RETURN END