Télécharger la plaquette Cast3M


fr en

Télécharger cadgfa.eso

Retour à la liste

Numérotation des lignes : 

cadgfa

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

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