Télécharger la plaquette Cast3M


fr en

Télécharger exiszo.eso

Retour à la liste

Numérotation des lignes : 

exiszo

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales