Télécharger exiszo.eso

Retour à la liste

Numérotation des lignes :

  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.  
  17. call lirobj('MAILLAGE',ipma,0,iret1)
  18. if (ierr.ne.0) return
  19. if (iret1.eq.0) then
  20. call lirobj('MMODEL ',ipma,0,iret2)
  21. if (ierr.ne.0) return
  22. if (iret2.eq.0) return
  23. if (iret2.ne.0) goto 700
  24. endif
  25.  
  26. ipt2 = ipma
  27. segact ipt2
  28. lisou = ipt2.lisous(/1)
  29. dmai2 = .false.
  30. if (lisou.gt.0) dmai2 = .true.
  31.  
  32. 600 CONTINUE
  33. MCHELM=IVAL
  34. SEGACT MCHELM
  35. NSOUS=IMACHE(/1)
  36. C
  37. C BOUCLE SUR LES SOUS PAQUETS DE MCHELM
  38. C
  39. DO 100 IA=1,NSOUS
  40. iptu = IMACHE(IA)
  41. if (dmai2) then
  42. do isou = 1,lisou
  43. if (iptu.eq.ipt2.lisous(isou)) then
  44. iret = .true.
  45. goto 120
  46. endif
  47. enddo
  48. else
  49. if (iptu.eq.ipt2) then
  50. iret = .true.
  51. goto 120
  52. endif
  53. endif
  54. 100 CONTINUE
  55. 120 CONTINUE
  56. segdes ipt2
  57. SEGDES MCHELM
  58. RETURN
  59.  
  60. 700 CONTINUE
  61. mmode1 = ipma
  62. segact mmode1
  63. n1 = mmode1.kmodel(/1)
  64. MCHELM=IVAL
  65. SEGACT MCHELM
  66. NSOUS=IMACHE(/1)
  67. C
  68. C BOUCLE SUR LES SOUS PAQUETS DE MCHELM
  69. C
  70. DO 800 IA=1,NSOUS
  71. iptu = IMACHE(IA)
  72. consu = conche(ia)
  73. do 750 in1 = 1,n1
  74. imode1= mmode1.kmodel(in1)
  75. segact imode1
  76. if (imode1.imamod.eq.iptu.and.
  77. &imode1.conmod.eq.consu) then
  78. iret = .true.
  79. goto 810
  80. endif
  81. 750 continue
  82.  
  83. 800 CONTINUE
  84. 810 CONTINUE
  85. do 850 in1 = 1,n1
  86. imode1= mmode1.kmodel(in1)
  87. segdes imode1
  88. 850 continue
  89.  
  90. segdes mmode1
  91. SEGDES MCHELM
  92. RETURN
  93.  
  94. END
  95.  
  96.  

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