Télécharger la plaquette Cast3M


fr en

Télécharger locimp.eso

Retour à la liste

Numérotation des lignes : 

locimp

  1. C LOCIMP    SOURCE    CHAT      05/01/13    01:24:46     5004
  2.  
  3.       SUBROUTINE LOCIMP(NDIM,JFACE,XDEP2
  4.      $     ,PT1,PT2,PT3,PT4,IPT9,JREBO,XIREB,XNREB,IEL1,IELTFA)
  5. *************************************************************************
  6. *** SP 'LOCIMP' : a partir d'un n° de face permet de dire s'il s'agit
  7. *** d'une face impermeable. renvoie alors les caracteristiques de cette
  8. *** face.
  9. ***
  10. *** E = 'NDIM' dimension de l'espace
  11. ***     'JFACE' face ou se situe la particule
  12. ***     'XDEP2' position initiale de la particule
  13. ***     'PT1', 'PT2', 'PT3', 'PT4' noeuds appartenant à element considéré
  14. ***     'IPT9' pteur sur maillage faces impermeables
  15. ***     'IEL1' numero de l'element dans lequel on se trouve
  16. ***     'IELTFA' pointeur du maillage des connectivités elements->face
  17. ***
  18. *** S = 'JREBO' n° local face impermeable ou se trouve particule, -1 sinon
  19. ***     'XIREB' pt d'impact sur la face impermeable
  20. ***     'XNREB' vecteur normal à la face impermeable
  21. ***
  22. ***  Auteur   CYRIL NOU
  23. *************************************************************************
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC SMCOORD
  30. -INC SMELEME
  31.       SEGMENT IZSH
  32.           REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  33.       ENDSEGMENT
  34.       DIMENSION XIMP(3),XDEP2(3),XIREB(3),XNREB(3)
  35.       DIMENSION PT1(3),PT2(3),PT3(3),PT4(3),XN1(3),XN2(3),XN3(3),XINT(3)
  36.       JREBO=-1
  37.       DO 30 I=1,3
  38.          XIREB(I)=0.D0
  39.          XNREB(I)=0.D0
  40.  30   CONTINUE
  41. ***   sortie de programme s'il n'y a pas de face impermeable
  42.       IF (IPT9.LE.0) RETURN
  43. ***   recuperation dimensions des tableaux du maillage faces impermeables
  44.       NBSOUS=IPT9.LISOUS(/1)
  45.       NBNOEU=IPT9.NUM(/1)
  46. ***   On a verifié plus haut que NBNOEU=1
  47.       NBELE=IPT9.NUM(/2)
  48. ***   Recherche du numero de la face JFACE dans le maillage general
  49.       CALL MELNEL(IEL1,IELTFA,IPT2,NEL2,1)
  50.       NF=IPT2.NUM(JFACE,IEL1-NEL2)
  51. ***   boucle sur les elements du maillage faces impermeables
  52.       DO 10 IELL2=1,NBELE
  53.          NFI=IPT9.NUM(1,IELL2)
  54.          IF(NF.EQ.NFI)THEN
  55. ***      recuperation de la position reelle du pt face impermeable
  56.                CALL DOXE(XCOOR,NDIM,NBNOEU,IPT9.NUM,IELL2,XIMP)
  57. ***            recuperation n°face, intersection, normale si face imper
  58.                CALL FACTR1(NDIM,PT1,PT2,PT3
  59.      $              ,XIMP,XIMP,XN1,XN2,XN3,XINT,KTEST)
  60.                JREBO=JFACE
  61.                DO 20 I=1,NDIM
  62.                   XIREB(I)=XDEP2(I)
  63.                   XNREB(I)=XN1(I)
  64.  20            CONTINUE
  65.                RETURN
  66.          ENDIF
  67.  10   CONTINUE
  68.       RETURN
  69.       END
  70.  
  71.  
  72.  

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