Télécharger impp1.eso

Retour à la liste

Numérotation des lignes :

  1. C IMPP1 SOURCE CB215821 19/02/25 21:16:10 10119
  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. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCOORD
  17.  
  18. SEGMENT ICPR1(NODE)
  19. SEGMENT ICPR2(NODE)
  20. SEGMENT ISEGDE(0)
  21. SEGMENT ISEG(0)
  22. * +--------------------------------------------------------------------+
  23.  
  24. SEGACT,IPT1
  25.  
  26. IDIM1= IDIM +1
  27. NODE = XCOOR(/1)/(IDIM+1)
  28. NUMSOU= MAX(IPT1.LISOUS(/1),1)
  29. SEGINI,ICPR1,ICPR2
  30.  
  31. C On procede au comptage
  32. NA = 0
  33. DO ISOU=1,NUMSOU
  34. IF(NUMSOU .EQ. 1)THEN
  35. MELEME=IPT1
  36. ELSE
  37. MELEME=IPT1.LISOUS(ISOU)
  38. SEGACT,MELEME
  39. ENDIF
  40. NBELEM=0
  41. DO J=1,MELEME.NUM(/2)
  42. DO K = 1,MELEME.NUM(/1)
  43. inum=MELEME.NUM(K,J)
  44. IF(ICPR1(inum) .EQ. 0)THEN
  45. NBELEM = NBELEM + 1
  46. NA = NA + 1
  47. ICPR1(inum) = NBELEM
  48. ICPR2(inum) = NA
  49. ENDIF
  50. ENDDO
  51. ENDDO
  52. ENDDO
  53. NBNN = 2
  54. NBSOUS= 0
  55. NBREF = 0
  56. SEGINI,IPT2,ISEGDE
  57. ISEGDE(**)=IPT2
  58. IPT2.ITYPEL=22
  59.  
  60. SEGACT,MCOORD*MOD
  61. ISEGDE(**)= MCOORD
  62. NBPTS = NODE + NA
  63. SEGADJ,MCOORD
  64.  
  65. C Remplissage des segments MELEME & Creation des nouveaux NOEUDS
  66. DO 5 i=1,NODE
  67. i_EL=ICPR1(i)
  68. IF(i_EL .EQ. 0) GOTO 5
  69. i_LX=ICPR2(i) + NODE
  70. C Noeud 1 : 'LX'
  71. C Noeud 2 : 'Inconnues classiques'
  72. IPT2.NUM(1,i_EL)= i_LX
  73. IPT2.NUM(2,i_EL)= i
  74.  
  75. IP_LX =(i_LX - 1) * IDIM1 + 1
  76. IP_INCO =(i - 1) * IDIM1 + 1
  77.  
  78. DO jj=1,IDIM
  79. XCOOR(IP_LX + jj - 1) = XCOOR(IP_INCO + jj - 1)
  80. ENDDO
  81. 5 continue
  82.  
  83. C On enleve le *MOD
  84. DO ii=1,ISEGDE(/1)
  85. ISEG=ISEGDE(ii)
  86. SEGACT,ISEG*NOMOD
  87. ENDDO
  88. SEGSUP,ICPR1,ICPR2
  89.  
  90. END
  91.  
  92.  

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