Télécharger la plaquette Cast3M


fr en

Télécharger kdom4c.eso

Retour à la liste

Numérotation des lignes : 

kdom4c

  1. C KDOM4C    SOURCE    OF166741  24/12/13    21:16:03     12097          
  2.       SUBROUTINE KDOM4C(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  KDOM4C
  9. C                      Subroutine called by KDOM4A
  10. C                      Axial-symmetric case, TRI7 and QUA8
  11. C                      We compute
  12. C                      MTAB . 'XXSURFAC'
  13. C                      MTAB . 'XXNORMAF'
  14. C                      MTAB . 'MATROT'
  15. C                      and we change the position for the central points
  16. C                      of MELEMQ
  17. C
  18. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  21. C
  22. C
  23. C************************************************************************
  24. C
  25. C INPUTS :
  26. C
  27. C MELF   : meleme 'FACE'
  28. C MELFL  : meleme 'FACEL'
  29. C MELFP  : meleme 'FACEP'
  30. C
  31. C OUTPUTS :
  32. C
  33. C MCHPSU : mchpoi 'XXSURFAC'
  34. C MCHPNO : mchpoi 'XXNORMAF'
  35. C MCHPMR : mchpoi 'MATROT'
  36. C
  37. C***********************************************************
  38. C
  39. C Created the 24/02/04
  40. C
  41.       IMPLICIT INTEGER(I-N)
  42.       INTEGER IGEOM, MCHPSU, MCHPNO,  MCHPMR
  43.      &     ,JGN, JGM, NP, NEL, IEL, NLCF
  44.      &     , NF, IP1, IP2
  45.       REAL*8 X1,X2,Y1,Y2,SURF,XF,YF,DX,DY,DVAL,DNX,DNY,DTX,DTY,ORIENT
  46.       CHARACTER*8 TYPE
  47.  
  48.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. -INC SMELEME
  52.       POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
  53. -INC SMCHPOI
  54.       POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
  55. -INC SMLENTI
  56. -INC SMLMOTS
  57. -INC SMCOORD
  58. C
  59. C**** Corresp. FACE
  60. C
  61.       CALL KRIPAD(MELF,MLENTI)
  62. C     SEGINI MLENTI
  63. C
  64. C**** Champoint surfaces
  65. C
  66.       JGN=4
  67.       JGM=1
  68.       SEGINI MLMOTS
  69.       MLMOTS.MOTS(1)='SCAL'
  70.       TYPE='FACE    '
  71.       CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
  72.       IF(IERR.NE.0)GOTO 9999
  73.       CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
  74.       IF(IERR.NE.0)GOTO 9999
  75. C     SEGACT MPOVSU
  76.       SEGSUP MLMOTS
  77. C
  78. C**** Champoint normales
  79. C
  80.       JGN=4
  81.       JGM=IDIM
  82.       SEGINI MLMOTS
  83.       MLMOTS.MOTS(1)='UX'
  84.       MLMOTS.MOTS(2)='UY'
  85.       TYPE='FACE    '
  86.       CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
  87.       IF(IERR.NE.0)GOTO 9999
  88.       CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
  89.       IF(IERR.NE.0)GOTO 9999
  90. C     SEGACT MPOVNO
  91.       SEGSUP MLMOTS
  92. C
  93. C**** Champoint matrice de rotation
  94. C
  95.       JGN=4
  96.       JGM=IDIM*IDIM
  97.       SEGINI MLMOTS
  98. C      IF(IDIM.EQ.2)THEN
  99.          MLMOTS.MOTS(1)='RX'
  100.          MLMOTS.MOTS(2)='RY'
  101.          MLMOTS.MOTS(3)='MX'
  102.          MLMOTS.MOTS(4)='MY'
  103. *        Normale en M
  104. *        vect(M,U) = z
  105. C      ENDIF
  106.       CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
  107.       IF(IERR.NE.0)GOTO 9999
  108.       CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
  109.       IF(IERR.NE.0)GOTO 9999
  110. C     SEGACT MPOVMR
  111. C
  112.       SEGACT MELFP
  113. C     In the case 2D,  NBSOUS=1
  114.       SEGACT MELFL
  115. C
  116.       NP=MELFP.NUM(/1)-1
  117.       NEL=MELFP.NUM(/2)
  118.       IF(NP .NE. 2)THEN
  119.          WRITE(IOIMP,*) 'Subroutine kdom4c.eso'
  120.          CALL ERREUR(5)
  121.       ENDIF
  122. C
  123.       DO IEL=1,NEL,1
  124. C       X1,Y1,X2,Y2,XF,YF
  125.          NF=MELFP.NUM(NP+1,IEL)
  126.          IP1=MELFP.NUM(1,IEL)
  127.          IP2=MELFP.NUM(2,IEL)
  128.          X1=XCOOR((IP1-1)*(IDIM+1)+1)
  129.          Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  130.          X2=XCOOR((IP2-1)*(IDIM+1)+1)
  131.          Y2=XCOOR((IP2-1)*(IDIM+1)+2)
  132.          CALL KDOM3B(X1,Y1,X2,Y2,SURF,XF,YF)
  133.          XCOOR((NF-1)*(IDIM+1)+1)=XF
  134.          XCOOR((NF-1)*(IDIM+1)+2)=YF
  135.          NLCF=MLENTI.LECT(NF)
  136.          MPOVSU.VPOCHA(NLCF,1)=SURF
  137.          DX=X1-XF
  138.          DY=Y1-YF
  139.          DVAL=((DX*DX)+(DY*DY))**0.5D0
  140.          DNX=DY/DVAL
  141.          DNY=-1.0D0*DX/DVAL
  142.          DTX=DX/DVAL
  143.          DTY=DY/DVAL
  144. C
  145. C******* Orientation selon FACEL
  146. C
  147.          IP1=MELFL.NUM(1,NLCF)
  148.          X1=XCOOR((IP1-1)*(IDIM+1)+1)
  149.          Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  150.          DX=XF-X1
  151.          DY=YF-Y1
  152.          ORIENT=SIGN(1.0D0,((DNX*DX)+(DNY*DY)))
  153. C
  154.          MPOVNO.VPOCHA(NLCF,1)=DNX*ORIENT
  155.          MPOVNO.VPOCHA(NLCF,2)=DNY*ORIENT
  156. C
  157.          MPOVMR.VPOCHA(NLCF,3)=DNX*ORIENT
  158.          MPOVMR.VPOCHA(NLCF,4)=DNY*ORIENT
  159.          MPOVMR.VPOCHA(NLCF,1)=DTX*ORIENT
  160.          MPOVMR.VPOCHA(NLCF,2)=DTY*ORIENT
  161. C
  162.       ENDDO
  163. C
  164.       SEGDES MPOVSU
  165.       SEGDES MPOVNO
  166.       SEGDES MPOVMR
  167.       SEGDES MELFP
  168. C
  169.       SEGDES MELFL
  170.       SEGSUP MLENTI
  171. C
  172.  9999 RETURN
  173.       END
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  

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