Télécharger la plaquette Cast3M


fr en

Télécharger hhompo.eso

Retour à la liste

Numérotation des lignes : 

hhompo

  1. C HHOMPO    SOURCE    OF166741  24/05/06    21:15:12     11082          
  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.  

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