Télécharger impp1.eso

Retour à la liste

Numérotation des lignes :

  1. C IMPP1 SOURCE PV 20/03/24 21:18:07 10554
  2. SUBROUTINE IMPP1(IPT1,IPT2)
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. * +--------------------------------------------------------------------+
  8. * création du maillage support des conditions aux limites de changement
  9. * de phase: création en vue d'un bloquer mini ou d'un bloque maxi.
  10. * C'est a dire que pour chaque point on cree un seul multiplicateur
  11. * les elements crees sont de type 22
  12. * +--------------------------------------------------------------------+
  13.  
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMELEME
  18. -INC SMCOORD
  19.  
  20. SEGMENT ICPR1(NODE)
  21. SEGMENT ICPR2(NODE)
  22. SEGMENT ISEGDE(0)
  23. SEGMENT ISEG(0)
  24. * +--------------------------------------------------------------------+
  25.  
  26. SEGACT,IPT1
  27.  
  28. IDIM1= IDIM +1
  29. segact mcoord*mod
  30. NODE = nbpts
  31. NUMSOU= MAX(IPT1.LISOUS(/1),1)
  32. SEGINI,ICPR1,ICPR2
  33.  
  34. C On procede au comptage
  35. NA = 0
  36. DO ISOU=1,NUMSOU
  37. IF(NUMSOU .EQ. 1)THEN
  38. MELEME=IPT1
  39. ELSE
  40. MELEME=IPT1.LISOUS(ISOU)
  41. SEGACT,MELEME
  42. ENDIF
  43. NBELEM=0
  44. DO J=1,MELEME.NUM(/2)
  45. DO K = 1,MELEME.NUM(/1)
  46. inum=MELEME.NUM(K,J)
  47. IF(ICPR1(inum) .EQ. 0)THEN
  48. NBELEM = NBELEM + 1
  49. NA = NA + 1
  50. ICPR1(inum) = NBELEM
  51. ICPR2(inum) = NA
  52. ENDIF
  53. ENDDO
  54. ENDDO
  55. ENDDO
  56. NBNN = 2
  57. NBSOUS= 0
  58. NBREF = 0
  59. SEGINI,IPT2,ISEGDE
  60. ISEGDE(**)=IPT2
  61. IPT2.ITYPEL=22
  62.  
  63. SEGACT,MCOORD*MOD
  64. ISEGDE(**)= MCOORD
  65. NBPTS = NODE + NA
  66. SEGADJ,MCOORD
  67.  
  68. C Remplissage des segments MELEME & Creation des nouveaux NOEUDS
  69. DO 5 i=1,NODE
  70. i_EL=ICPR1(i)
  71. IF(i_EL .EQ. 0) GOTO 5
  72. i_LX=ICPR2(i) + NODE
  73. C Noeud 1 : 'LX'
  74. C Noeud 2 : 'Inconnues classiques'
  75. IPT2.NUM(1,i_EL)= i_LX
  76. IPT2.NUM(2,i_EL)= i
  77.  
  78. IP_LX =(i_LX - 1) * IDIM1 + 1
  79. IP_INCO =(i - 1) * IDIM1 + 1
  80.  
  81. DO jj=1,IDIM
  82. XCOOR(IP_LX + jj - 1) = XCOOR(IP_INCO + jj - 1)
  83. ENDDO
  84. 5 continue
  85.  
  86. C On enleve le *MOD
  87. DO ii=1,ISEGDE(/1)
  88. ISEG=ISEGDE(ii)
  89. SEGACT,ISEG*NOMOD
  90. ENDDO
  91. SEGSUP,ICPR1,ICPR2
  92.  
  93. END
  94.  
  95.  
  96.  

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