Télécharger cadgfa.eso

Retour à la liste

Numérotation des lignes :

cadgfa
  1. C CADGFA SOURCE CB215821 20/11/25 13:19:01 10792
  2. SUBROUTINE CADGFA
  3. C************************************************************************
  4. C
  5. C OBJET :
  6. C
  7. C CALCUL DE LA MATRICE MASSE DIAGONALE POUR LES FACES
  8. C ---> Creation d'un CHAMPOIN
  9. C D0=NI ( MASSE LUMPE )
  10. C
  11. C SYNTAXE :
  12. C
  13. C RES = DGSI OBJ1 <'AXI' i> <'IMPR'> ;
  14. C
  15. C OBJ1 : Table DOMAINE
  16. C
  17. C AXI : Calcule en coordonee cylindrique 2D
  18. C i=2 axe de symetrie oy
  19. C
  20. C
  21. C************************************************************************
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMELEME
  28. -INC SMTABLE
  29. POINTEUR MTABD.MTABLE
  30. -INC SMCOORD
  31. -INC SMLENTI
  32. POINTEUR IZIPAD.MLENTI
  33. -INC SMCHPOI
  34. -INC SIZFFB
  35. CHARACTER*8 NOM0,CHAI,LISMO(1),TYPE,TYPC
  36. DATA LISMO/'IMPR '/
  37. C ***************************************************************
  38.  
  39. IMPR=0
  40. IAXI=0
  41. IF(IFOMOD.EQ.0)IAXI=2
  42.  
  43. CALL LITABS('DOMAINE ',MTABD,1,1,IRET)
  44. IF(IRET.EQ.0)THEN
  45. WRITE(6,*)' On attend une table de soustype DOMAINE'
  46. RETURN
  47. ENDIF
  48. SEGACT MTABD
  49. TYPE=' '
  50. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  51. IF(TYPE.NE.'MAILLAGE')RETURN
  52. TYPE=' '
  53. CALL ACMO(MTABD,'FACE',TYPE,MELEMF)
  54. IF(TYPE.NE.'MAILLAGE')RETURN
  55. TYPE=' '
  56. CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  57. IF(TYPE.NE.'MAILLAGE')RETURN
  58. CALL LEKTAB(MTABD,'FACEL',MELEME)
  59. IF(MELEME.EQ.0)RETURN
  60. CALL LEKTAB(MTABD,'XXVOLUM',MCHPO1)
  61. IF(MCHPO1.EQ.0)RETURN
  62.  
  63. 19 CONTINUE
  64. CALL LIRCHA(CHAI,0,IRET)
  65. IF(IRET.EQ.0)GO TO 20
  66. CALL OPTLI(IP,LISMO,CHAI,1)
  67. IF(IP.EQ.0)THEN
  68. WRITE(6,*)' On attend le mot cle IMPR '
  69. RETURN
  70. ENDIF
  71. IMPR=1
  72. GO TO 19
  73.  
  74. 20 CONTINUE
  75.  
  76. CALL KRIPAD(MELEMC,MLENT1)
  77. CALL KRIPAD(MELEMF,MLENT2)
  78.  
  79. C CREATION DE LA DIAGONALE
  80. CALL CRCHPT('FACE',MELEMF,1,MCHPOI)
  81. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  82. CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM)
  83. SEGACT MELEME
  84. C
  85. C BOUCLE SUR LES TYPES D'ELEMENTS ET CALCUL
  86. C
  87. NBEL=NUM(/2)
  88. DO 1 K=1,NBEL
  89. I1=NUM(1,K)
  90. I2=NUM(2,K)
  91. I3=NUM(3,K)
  92. I1=MLENT1.LECT(I1)
  93. I2=MLENT2.LECT(I2)
  94. I3=MLENT1.LECT(I3)
  95. V=(MPOVA1.VPOCHA(I1,1)+MPOVA1.VPOCHA(I3,1) )*0.5D0
  96. VPOCHA(I2,1)=V
  97. 1 CONTINUE
  98.  
  99. IF(IMPR.NE.0)THEN
  100. WRITE(6,*)' SUB CADGFA : CALCUL DE LA DIAGONALE'
  101. WRITE(6,1003)(I,VPOCHA(I,1),I=1,VPOCHA(/1))
  102. WRITE(6,*)' FIN DE CADGFA'
  103. ENDIF
  104.  
  105. SEGDES MTABD
  106. SEGSUP MLENT1,MLENT2
  107. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  108. CALL ECROBJ('CHPOINT ',MCHPOI)
  109. RETURN
  110.  
  111. 1001 FORMAT(20(1X,I5))
  112. 1002 FORMAT(10(1X,1PE11.4))
  113. 1003 FORMAT(6(1X,I7,1X,1PE11.4))
  114. END
  115.  
  116.  
  117.  
  118.  

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