Télécharger la plaquette Cast3M


fr en

Télécharger bmtd.eso

Retour à la liste

Numérotation des lignes : 

bmtd

  1. C BMTD      SOURCE    CB215821  24/04/12    21:15:07     11897          
  2.       SUBROUTINE BMTD
  3. C-----------------------------------------------------------------------
  4. C                       -1 t
  5. C  Calcul du produit B M    D  CHPcentre
  6. C         le résultat est un CHPface
  7. C-----------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Phrase d'appel (GIBIANE) :
  11. C---------------------------
  12. C
  13. C  CHP2 = 'BMTD'  MMODEL RIG1  CHP1 ;
  14. C
  15. C------------------------
  16. C Operandes et resultat :
  17. C------------------------
  18. C
  19. C  MMODEL  : MODELE permettant de récuperer la TABLE DOMAINE
  20. C            contenant les maillages et les connectivités.
  21. C            On attend un modèle DARCY
  22. C  RIG1    : Matrices hybrides elementaires de DARCY crees par MHYB.
  23. C  CHP1    : CHPO centre à plusieur composantes.
  24. C  CHP2    : CHPO face à plusieur composantes dont le support géometrique
  25. C            est le maillage de la rigidité les noms des composantes
  26. C            sont ceux de CHP1
  27. C
  28. C-----------------------------------------------------------------------
  29. C
  30. C Langage : ESOPE + FORTRAN77
  31. C
  32. C
  33. C-----------------------------------------------------------------------
  34.       IMPLICIT INTEGER(I-N)
  35.       IMPLICIT REAL*8 (A-H,O-Z)
  36. *
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMCOORD
  41. -INC SMCHPOI
  42. -INC SMELEME
  43. -INC SMRIGID
  44. -INC SMTABLE
  45. -INC SMMODEL
  46. *
  47.       SEGMENT ICCPR
  48.          INTEGER ICPR(NNGOT)
  49.       ENDSEGMENT
  50. *
  51.       LOGICAL LOGRE,LOGIN
  52.       CHARACTER*8 TAPIND,CHARRE,LETYPE
  53.       CHARACTER*4 NOMTOT(1)
  54. *
  55. * Initialisations
  56. *
  57.       IVALIN = 0
  58.       XVALIN = 0.D0
  59.       LOGIN  = .TRUE.
  60.       IOBIN  = 0
  61.       TAPIND = 'MOT     '
  62. *
  63. *
  64. * Lecture du MMODEL
  65. *
  66.       CALL LIROBJ('MMODEL  ',IPMODE,1,IRET)
  67.       CALL ACTOBJ('MMODEL  ',IPMODE,1)
  68.       IF(IERR.NE.0)RETURN
  69.       MMODEL=IPMODE
  70.       SEGACT MMODEL
  71.       N1=KMODEL(/1)
  72.       DO 7 I=1,N1
  73.          IMODEL=KMODEL(I)
  74.          SEGACT IMODEL
  75.          IF(FORMOD(1).NE.'DARCY')THEN
  76.              MOTERR(1:16)  = 'DARCY           '
  77.              CALL ERREUR(719)
  78.              RETURN
  79.          ENDIF
  80.     7 CONTINUE
  81. C  on récupère la table DOMAINE
  82.       IPTABL = 0
  83.       CALL LEKMOD(MMODEL,IPTABL,IRET)
  84.       IF (IERR.NE.0) RETURN
  85. *
  86.       CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  87.       IF (IERR.NE.0) RETURN
  88.       IELTFA = IOBRE
  89.       CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
  90.       IF (IERR.NE.0) RETURN
  91.       ICENTR = IOBRE
  92.       CALL LEKTAB(IPTABL,'FACE',IOBRE)
  93.       IF (IERR.NE.0) RETURN
  94.       IFACE = IOBRE
  95. *
  96. * Lecture de RIGIDITE
  97. *
  98.       CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET)
  99.       IF (IERR.NE.0) RETURN
  100.       MRIGID = IPRIGI
  101. *
  102. *
  103. *
  104. * Test du sous-type de la matrice de rigiditée récupérée
  105. *
  106.       SEGACT MRIGID
  107.       LETYPE = MTYMAT
  108.       IF (LETYPE.NE.'DARCY') THEN
  109.          MOTERR(1:8)  = 'RIGIDITE'
  110.          MOTERR(9:16) = 'DARCY   '
  111.          CALL ERREUR(79)
  112.          SEGDES MRIGID
  113.          GOTO 100
  114.       ENDIF
  115. *
  116. * Controle des pointeurs de MELEME de la rigidité
  117. *
  118.       NRIGEL=IRIGEL(/2)
  119.       MELEME=IELTFA
  120.       SEGACT MELEME
  121.       NBSOUS=LISOUS(/1)
  122.       IF(NBSOUS.EQ.0)THEN
  123.           IF((NRIGEL.NE.1).OR.(IRIGEL(1,1).NE.MELEME))THEN
  124.                MOTERR(1:8)  = 'DARCY   '
  125.                MOTERR(9:16) = 'ELTFA   '
  126.                INTERR(1)    = 1
  127.                CALL ERREUR(698)
  128.                SEGDES MRIGID
  129.                GOTO 100
  130.           ENDIF
  131.       ELSE
  132.           IF(NRIGEL.NE.NBSOUS)THEN
  133.                MOTERR(1:8)  = 'DARCY   '
  134.                MOTERR(9:16) = 'ELTFA   '
  135.                INTERR(1)    = 1
  136.                CALL ERREUR(698)
  137.                SEGDES MRIGID
  138.                GOTO 100
  139.           ENDIF
  140.           DO 10 ISOUS=1,NBSOUS
  141.             IF (LISOUS(ISOUS).NE.IRIGEL(1,ISOUS)) THEN
  142.                MOTERR(1:8)  = 'DARCY   '
  143.                MOTERR(9:16) = 'ELTFA   '
  144.                INTERR(1)    = ISOUS
  145.                CALL ERREUR(698)
  146.                SEGDES MRIGID
  147.                GOTO 100
  148.             ENDIF
  149.  10       CONTINUE
  150.       ENDIF
  151.       CALL LIROBJ('CHPOINT ',IPCHC,1,IRET)
  152.       CALL ACTOBJ('CHPOINT ',IPCHC,1)
  153.       IF(IRET.NE.1) RETURN
  154.       MCHPO1=IPCHC
  155.       NOMTOT(1)='    '
  157.       NBCOMP=-1
  158.       CALL QUEPOI(MCHPO1,ICENTR,INDIC,NBCOMP,NOMTOT)
  159.       IF(IERR.NE.0)RETURN
  160.       SEGACT MCHPO1
  161.       MSOUP1=MCHPO1.IPCHP(1)
  162.       SEGACT MSOUP1
  163.       MPOVA1=MSOUP1.IPOVAL
  164.       SEGACT MPOVA1
  165. *
  166. * Construction de MCHPOI
  167. *
  168. *
  169.       IPT2=IFACE
  170.       SEGACT IPT2
  171.       NPN=IPT2.NUM(/2)
  172.       NSOUPO=1
  173.       NAT=1
  174.       SEGINI MCHPOI
  175.       MTYPOI='        '
  176.       MOCHDE='      CHPOIN CREE PAR BMTD                      '
  177.       IFOPOI=MCHPO1.IFOPOI
  178.       JATTRI(1)=2
  179.       NC=NBCOMP
  180.       SEGINI MSOUPO
  181.       IPCHP(1)=MSOUPO
  182.       DO 5 L=1,NBCOMP
  183.             NOCOMP(L)=MSOUP1.NOCOMP(L)
  184.             NOHARM(L)=MSOUP1.NOHARM(L)
  185.     5 CONTINUE
  186.       IGEOC=IFACE
  187.       N=NPN
  188.       SEGINI MPOVAL
  189.       IPOVAL=MPOVAL
  190.       NB=N*NC
  191.       CALL INITD(VPOCHA,NB,0.D0)
  192. *
  193. *       Creation du tableau ICPR
  194. *
  195.       IK     = 0
  196.       NNGOT  = nbpts
  197.       SEGINI ICCPR
  198. C      MELEME = IFACE
  199. C      SEGACT MELEME
  200.       N2 = IPT2.NUM(/2)
  201.       DO 15 I2=1,N2
  202.          K = IPT2.NUM(1,I2)
  203.          IF (ICPR(K).EQ.0) THEN
  204.             IK      = IK + 1
  205.             ICPR(K) = IK
  206.          ENDIF
  207.   15  CONTINUE
  208.       SEGDES IPT2
  209. C
  210. C     Calcul du produit
  211. C
  212.       ITELEM=0
  213.       MELEME=IELTFA
  214. C     call ecmail(meleme)
  215.       SEGACT MELEME
  216.       IPT1=MELEME
  217.       DO 50 ISOUS=1,NRIGEL
  218.          IF(NRIGEL.NE.1)IPT1= LISOUS(ISOUS)
  219.          SEGACT IPT1
  220.          xMATRI=IRIGEL(4,ISOUS)
  221.          SEGACT xMATRI
  222.          NELRIG=re(/3)
  223.          DO 60 IEL=1,NELRIG
  224.          ITELEM=ITELEM+1
  225. *         XMATRI=IMATTT(IEL)
  226. *         SEGACT XMATRI
  227.          NLIGRD=RE(/1)
  228.          NLIGRP=RE(/2)
  229.          DO 40 I=1,NLIGRD
  230.          RLIGN=0.D0
  231.          DO 30 J=1,NLIGRP
  232.          RLIGN=RLIGN+RE(I,J,iel)
  233.    30    CONTINUE
  234.          IPOPTS=ICPR(IPT1.NUM(I,IEL))
  235.          DO 20 K=1,NBCOMP
  236.               VPOCHA(IPOPTS,K)=VPOCHA(IPOPTS,K)+RLIGN*
  237.      *                   MPOVA1.VPOCHA(ITELEM,K)
  238.    20    CONTINUE
  239.  
  240.    40    CONTINUE
  241. *         SEGDES XMATRI
  242.    60    CONTINUE
  243.          SEGDES xMATRI
  244.          SEGDES IPT1
  245.    50 CONTINUE
  246.       IF(NRIGEL.NE.1)SEGDES MELEME
  247.       SEGDES MRIGID
  248.       CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  249.       CALL ECROBJ('CHPOINT ',MCHPOI)
  250. *
  251. * Ménage
  252. *
  253.       SEGSUP ICCPR
  254.  100  CONTINUE
  255.       END
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  

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