Télécharger hhompo.eso

Retour à la liste

Numérotation des lignes :

hhompo
  1. C HHOMPO SOURCE OF166741 24/06/19 21:15:08 11942
  2. C HHOMPO SOURCE
  3.  
  4. C Maillage des points supports des ddls :
  5. C - des cellules a partir de la liste des cellules et du maillage MPFHHO
  6. C - des faces a partir de la liste des faces et du maillage MPOHHO
  7. C Liste inverse des points supports dans la liste des faces
  8.  
  9. SUBROUTINE HHOMPO (chaopt,lfaHHO, ipsHHO)
  10.  
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.  
  17. -INC CCHHOPA
  18. -INC CCHHOPR
  19.  
  20. -INC SMCOORD
  21. -INC SMELEME
  22. -INC SMLENTI
  23.  
  24. CHARACTER*(*) chaopt
  25.  
  26. ipsHHO = 0
  27.  
  28. mlenti = lfaHHO
  29. c segact,mlenti
  30. c-dbg write(ioimp,*)
  31. c-dbg write(ioimp,*) 'HHOMPO - ',lect(/1)
  32. c-dbg write(ioimp,*) (lect(i),i=1,lect(/1))
  33.  
  34. IF (chaopt(1:4).EQ.'FACE') THEN
  35. ipt2 = MPFHHO
  36. segact,ipt2
  37. nbnn = 1
  38. nbelem = mlenti.lect(/1) / 2
  39. nbsous = 0
  40. nbref = 0
  41. SEGINI,ipt1
  42. ipt1.itypel = 1
  43. DO i = 1, nbelem
  44. je = mlenti.lect(2*i-1)
  45. ip = ABS(mlenti.lect(2*i))
  46. c-dbg if (ip.eq.0) write(ioimp,*) 'HHOMPO FACE: Bizarre...',i,je,ip
  47. jp = ip + NBFHHO(je-1)
  48. ipt1.num(1,i) = ipt2.num(1,jp)
  49. c-dbg write(ioimp,*) 'HHOMPO FACE:',i,je,ip,jp,nbelem
  50. END DO
  51. c SEGDES,ipt1
  52. ipsHHO = ipt1
  53.  
  54. ELSE IF (chaopt(1:4).EQ.'CELL') THEN
  55. ipt2 = MPCHHO
  56. segact,ipt2
  57. nbnn = 1
  58. nbelem = mlenti.lect(/1) / 2
  59. nbsous = 0
  60. nbref = 0
  61. SEGINI,ipt1
  62. ipt1.itypel = 1
  63. DO i = 1, nbelem
  64. je = mlenti.lect(2*i-1)
  65. ip = ABS(mlenti.lect(2*i))
  66. c-dbg if (ip.eq.0) write(ioimp,*) 'HHOMPO CELL: Bizarre...',i,je,ip
  67. jp = ip + NBCHHO(je-1)
  68. ipt1.num(1,i) = ipt2.num(1,jp)
  69. c-dbg write(ioimp,*) 'HHOMPO CELL:',i,je,ip,jp,nbelem
  70. END DO
  71. c SEGDES,ipt1
  72. ipsHHO = ipt1
  73.  
  74. ELSE IF (chaopt(1:4).EQ.'LGFA') THEN
  75. ipt2 = MPFHHO
  76. segact,ipt2
  77. JG = NBPTS
  78. SEGINI,mlent1
  79. nbelem = mlenti.lect(/1) / 2
  80. DO i = 1, nbelem
  81. je = mlenti.lect(2*i-1)
  82. ip = ABS(mlenti.lect(2*i))
  83. c-dbg if (ip.eq.0) write(ioimp,*) 'HHOMPO LGFA: Bizarre...',i,je,ip
  84. jp = ip + NBFHHO(je-1)
  85. kp = ipt2.num(1,jp)
  86. mlent1.lect(kp) = i
  87. c-dbg write(ioimp,*) 'HHOMPO LGFA:',i,je,ip,jp,kp,nbelem
  88. END DO
  89. ipsHHO = mlent1
  90.  
  91. ELSE
  92. write(ioimp,*) 'HHOMPO: ',chaopt(1:4),' option unknown'
  93. call erreur(5)
  94. return
  95. END IF
  96.  
  97. RETURN
  98. END
  99.  
  100.  
  101.  
  102.  

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