Télécharger cadgfa.eso

Retour à la liste

Numérotation des lignes :

  1. C CADGFA SOURCE MAGN 10/05/18 21:15:00 6675
  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. -INC CCOPTIO
  25. -INC SMELEME
  26. -INC SMTABLE
  27. POINTEUR MTABD.MTABLE
  28. -INC SMCOORD
  29. -INC SMLENTI
  30. POINTEUR IZIPAD.MLENTI
  31. -INC SMCHPOI
  32. -INC SIZFFB
  33. CHARACTER*8 NOM0,CHAI,LISMO(1),TYPE,TYPC
  34. DATA LISMO/'IMPR '/
  35. C ***************************************************************
  36.  
  37. IMPR=0
  38. IAXI=0
  39. IF(IFOMOD.EQ.0)IAXI=2
  40.  
  41. CALL LITABS('DOMAINE ',MTABD,1,1,IRET)
  42. IF(IRET.EQ.0)THEN
  43. WRITE(6,*)' On attend une table de soustype DOMAINE'
  44. RETURN
  45. ENDIF
  46. SEGACT MTABD
  47. TYPE=' '
  48. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  49. IF(TYPE.NE.'MAILLAGE')RETURN
  50. TYPE=' '
  51. CALL ACMO(MTABD,'FACE',TYPE,MELEMF)
  52. IF(TYPE.NE.'MAILLAGE')RETURN
  53. TYPE=' '
  54. CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  55. IF(TYPE.NE.'MAILLAGE')RETURN
  56. CALL LEKTAB(MTABD,'FACEL',MELEME)
  57. IF(MELEME.EQ.0)RETURN
  58. CALL LEKTAB(MTABD,'XXVOLUM',MCHPO1)
  59. IF(MCHPO1.EQ.0)RETURN
  60.  
  61. 19 CONTINUE
  62. CALL LIRCHA(CHAI,0,IRET)
  63. IF(IRET.EQ.0)GO TO 20
  64. CALL OPTLI(IP,LISMO,CHAI,1)
  65. IF(IP.EQ.0)THEN
  66. WRITE(6,*)' On attend le mot cle IMPR '
  67. RETURN
  68. ENDIF
  69. IMPR=1
  70. GO TO 19
  71.  
  72. 20 CONTINUE
  73.  
  74. CALL KRIPAD(MELEMC,MLENT1)
  75. CALL KRIPAD(MELEMF,MLENT2)
  76.  
  77. C CREATION DE LA DIAGONALE
  78. CALL CRCHPT('FACE',MELEMF,1,MCHPOI)
  79. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  80. CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM)
  81. SEGACT MELEME
  82. C
  83. C BOUCLE SUR LES TYPES D'ELEMENTS ET CALCUL
  84. C
  85. NBEL=NUM(/2)
  86. DO 1 K=1,NBEL
  87. I1=NUM(1,K)
  88. I2=NUM(2,K)
  89. I3=NUM(3,K)
  90. I1=MLENT1.LECT(I1)
  91. I2=MLENT2.LECT(I2)
  92. I3=MLENT1.LECT(I3)
  93. V=(MPOVA1.VPOCHA(I1,1)+MPOVA1.VPOCHA(I3,1) )*0.5D0
  94. VPOCHA(I2,1)=V
  95. 1 CONTINUE
  96.  
  97. IF(IMPR.NE.0)THEN
  98. WRITE(6,*)' SUB CADGFA : CALCUL DE LA DIAGONALE'
  99. WRITE(6,1003)(I,VPOCHA(I,1),I=1,VPOCHA(/1))
  100. WRITE(6,*)' FIN DE CADGFA'
  101. ENDIF
  102.  
  103. SEGDES MELEME
  104. SEGDES MTABD
  105. SEGSUP MLENT1,MLENT2
  106. SEGDES MCHPOI,MPOVAL
  107. CALL ECROBJ('CHPOINT',MCHPOI)
  108. RETURN
  109. 1001 FORMAT(20(1X,I5))
  110. 1002 FORMAT(10(1X,1PE11.4))
  111. 1003 FORMAT(6(1X,I7,1X,1PE11.4))
  112. END
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  

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