Télécharger la plaquette Cast3M


fr en

Télécharger sqtp.eso

Retour à la liste

Numérotation des lignes : 

sqtp

  1. C SQTP      SOURCE    CB215821  24/04/12    21:17:17     11897          
  2.       SUBROUTINE SQTP
  3. C-----------------------------------------------------------------------
  4. C Calcul de la contribution au systeme en trace de charge d'une force
  5. C volumique dans le cas de la résolution des équations de Darcy par EFMH
  6. C avec le modèle DARCY.
  7. C-----------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Phrase d'appel (GIBIANE) :
  11. C---------------------------
  12. C
  13. C  CHP2 = 'SQTP' MMODEL  RIG1 RIG2 CHP1 ;
  14. C
  15. C------------------------
  16. C Operandes et resultat :
  17. C------------------------
  18. C
  19. C  MMODEL  : Objet modele décrivant la formulation.
  20. C  TABLE1  : TABLE DOMAINE contenant les maillages et les connectivités.
  21. C  RIG1    : Matrices masses hybrides elementaires de sous-type MASSE.
  22. C  RIG2    : Matrices elementaires de type HYBTP
  23. C  CHP1    : CHPO centre de composante FX,FY(,FZ),
  24. C                                  densite de force moyenne par élément.
  25. C
  26. C-----------------------------------------------------------------------
  27. C
  28. C Langage : ESOPE + FORTRAN77
  29. C
  30. C Auteurs : 02/96 L.V.BENET   - Cas permanent
  31. C
  32. C-----------------------------------------------------------------------
  33.       IMPLICIT INTEGER(I-N)
  34.       IMPLICIT REAL*8 (A-H,O-Z)
  35. *
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMCHAML
  40. -INC SMCHPOI
  41. -INC SMELEME
  42. -INC SMMODEL
  43. -INC SMRIGID
  44. -INC SMTABLE
  45. *
  46.       SEGMENT IPMAHY
  47.          INTEGER MAHYBR(NSOUS)
  48. *         CHARACTER*4 NOMTOT(IDIM)
  49.       ENDSEGMENT
  50. *
  51.       LOGICAL LOGRE,LOGIN
  52.       CHARACTER*4 NOMTO3(3)
  53.       CHARACTER*4 NOMTO2(2)
  54.       CHARACTER*6 CHAR6
  55.       CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE,LETYP1,LETYP2
  56. *
  57. * Initialisations
  58. *
  59.       ISOU1  = 0
  60.       IHN1   = 0
  61.       ITPN1  = 0
  62.       IVALIN = 0
  63.       XVALIN = 0.D0
  64.       LOGIN  = .TRUE.
  65.       IOBIN  = 0
  66.       TAPIND = 'MOT     '
  67. *
  68. * Lecture du MMODEL
  69. *
  70.       CALL LIROBJ('MMODEL',IPMODE,1,IRET)
  71.       IF (IERR.NE.0) RETURN
  72.       MMODEL = IPMODE
  73. *
  74. * Lecture de la TABLE domaine
  75. *
  76.       IPTABL = 0
  77.       CALL LEKMOD(IPMODE,IPTABL,IRET)
  78.       IF (IERR.NE.0) RETURN
  79.       CHARIN = 'MAILLAGE'
  80.       TYPOBJ = 'MAILLAGE'
  81.       CALL LEKTAB(IPTABL,CHARIN,IOBRE)
  82.       IF (IERR.NE.0) RETURN
  83.       IPGEOM = IOBRE
  84.       CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  85.       IF (IERR.NE.0) RETURN
  86.       IELTFA = IOBRE
  87.       CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
  88.       IF (IERR.NE.0) RETURN
  89.       ICENTR = IOBRE
  90.       CALL LEKTAB(IPTABL,'FACE',IOBRE)
  91.       IF (IERR.NE.0) RETURN
  92.       IPFACE = IOBRE
  93. *
  94. * Lecture de RIGIDITE
  95. *
  96.       CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET)
  97.       IF (IERR.NE.0) RETURN
  98.       RI1 = IPRIGI
  99. *
  100. * Lecture de RIGIDITE
  101. *
  102.       CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET)
  103.       IF (IERR.NE.0) RETURN
  104.       RI2 = IPRIGI
  105. *
  106. * Lecture du champoint  FORCE
  107. *
  108.       CALL LIROBJ('CHPOINT',IFORC,1,IRET)
  109.       IF (IERR.NE.0) RETURN
  110. *
  111. * récup. MCHAML orientation normale
  112. *
  113.       CALL LEKTAB(IPTABL,'XXNORMAE',IORIE)
  114.       IF (IERR.NE.0) RETURN
  115. *
  116. * récup. CHPO orientation normale
  117. *
  118.       CALL LEKTAB(IPTABL,'XXNORMAF',INORM)
  119.       IF (IERR.NE.0) RETURN
  120. *
  121. * récup. CHPO surface des faces
  122. *
  123.       CALL LEKTAB(IPTABL,'XXSURFAC',ISURF)
  124.       IF (IERR.NE.0) RETURN
  125. *
  126. * Test du CHAMPOINT FORCE de spg CENTRE
  127. *
  128.          NBCOMP    = IDIM
  129.          INDIC     = 1
  130.          IF(IDIM.EQ.2)THEN
  131.             NOMTO2(1) = 'FX'
  132.             NOMTO2(2) = 'FY'
  133.             CALL QUEPOI(IFORC,ICENTR,INDIC,NBCOMP,NOMTO2)
  134.             IF (IERR.NE.0) RETURN
  135.          ELSE IF(IDIM.EQ.3)THEN
  136.             NOMTO3(1) = 'FX'
  137.             NOMTO3(2) = 'FY'
  138.             NOMTO3(3) = 'FZ'
  139.             CALL QUEPOI(IFORC,ICENTR,INDIC,NBCOMP,NOMTO3)
  140.             IF (IERR.NE.0) RETURN
  141.          ENDIF
  142. *
  143. * Test de la formulation
  144. *
  145.       SEGACT MMODEL
  146.       NSOUS  = KMODEL(/1)
  147.       SEGINI IPMAHY
  148.       IDARCY = 0
  149.       IPT1=IPGEOM
  150.       IPT2=IPGEOM
  151.       DO 10 ISOUS=1,NSOUS
  152.          IF(NSOUS.GT.1)THEN
  153.               SEGACT IPT2
  154.               IPT1=IPT2.LISOUS(ISOUS)
  155.               SEGDES IPT2
  156.          ENDIF
  157.          IMODEL = KMODEL(ISOUS)
  158.          SEGACT IMODEL
  159.          LETYPE = FORMOD(1)
  160.          IF (LETYPE.EQ.'DARCY') THEN
  161.             IDARCY = IDARCY + 1
  162.             MAHYBR(ISOUS) = IPT1
  163.          ENDIF
  164.          SEGDES IMODEL
  165.  10   CONTINUE
  166.       SEGDES MMODEL
  167.       IF (IDARCY.EQ.0) THEN
  168.          MOTERR = LETYPE
  169.          CALL ERREUR(193)
  170.          GOTO 100
  171.       ENDIF
  172. *
  173. * Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
  174. *
  175.       MELEME = IELTFA
  176.       SEGACT MELEME
  177.       LZONES = LISOUS(/1)
  178.       IF (LZONES.EQ.0) LZONES = 1
  179.       IPT1   = IPGEOM
  180.       SEGACT IPT1
  181.       DO 30 ISOUS=1,NSOUS
  182.          IMAMEL = MAHYBR(ISOUS)
  183.          IF (IMAMEL.NE.0) THEN
  184.             DO 20 ISZ=1,LZONES
  185.                IF (LZONES.EQ.1) THEN
  186.                   IPT2 = IPT1
  187.                   IPT3 = MELEME
  188.                ELSE
  189.                   IPT2 = IPT1.LISOUS(ISZ)
  190.                   IPT3 = LISOUS(ISZ)
  191.                ENDIF
  192.                IF (IPT2.EQ.IMAMEL) THEN
  193.                   MAHYBR(ISOUS) = IPT3
  194.                   GOTO 30
  195.                ENDIF
  196.  20         CONTINUE
  197.             IF (IMAMEL.EQ.MAHYBR(ISOUS)) THEN
  198.                INTERR(1) = ISOUS
  199.                CALL ERREUR(698)
  200.                SEGDES IPT1
  201.                SEGDES MELEME
  202.                GOTO 100
  203.             ENDIF
  204.          ENDIF
  205.  30   CONTINUE
  206.       SEGDES IPT1
  207.       SEGDES MELEME
  208. *
  209. * Test du sous-type des matrices de rigiditée MASSE et HYBTP récupérées
  210. *
  211.       SEGACT RI1
  212.       LETYP1 =  RI1.MTYMAT
  213.       SEGACT RI2
  214.       LETYP2 =  RI2.MTYMAT
  215.       IF (LETYP1.NE.'MASSE') THEN
  216.         IF (LETYP2.NE.'MASSE') THEN
  217.           MOTERR(1:8)  = 'RIGIDITE'
  218.           MOTERR(9:16) = 'MASSE'
  219.           CALL ERREUR(79)
  220.           SEGDES RI1
  221.           SEGDES RI2
  222.           GOTO 100
  223.         ELSE
  224.           IPFORC=RI2
  225.           IF (LETYP1.NE.'HYBTP') THEN
  226.             MOTERR(1:8)  = 'RIGIDITE'
  227.             MOTERR(9:16) = 'HYBTP'
  228.             CALL ERREUR(79)
  229.             SEGDES RI1
  230.             SEGDES RI2
  231.             GOTO 100
  232.           ELSE
  233.             IPMATP=RI1
  234.           ENDIF
  235.         ENDIF
  236.       ELSE
  237.         IPFORC=RI1
  238.           IF (LETYP2.NE.'HYBTP') THEN
  239.             MOTERR(1:8)  = 'RIGIDITE'
  240.             MOTERR(9:16) = 'HYBTP'
  241.             CALL ERREUR(79)
  242.             SEGDES RI1
  243.             SEGDES RI2
  244.             GOTO 100
  245.           ELSE
  246.             IPMATP=RI2
  247.           ENDIF
  248.       ENDIF
  249. *
  250. * Controle des pointeurs de MELEME des deux rigidités
  251. *
  252.       DO 40 ISOUS=1,NSOUS
  253.          IMAMEL = MAHYBR(ISOUS)
  254.          IF (IMAMEL.NE.0) THEN
  255.             IPTEST = RI1.IRIGEL(1,ISOUS)
  256.             IF (MAHYBR(ISOUS).NE.IPTEST) THEN
  257.                MOTERR(1:8)  = LETYP1
  258.                MOTERR(9:16) = 'ELTFA   '
  259.                INTERR(1)    = ISOUS
  260.                CALL ERREUR(698)
  261.                SEGDES RI1
  262.                GOTO 100
  263.             ENDIF
  264.             IPTEST = RI2.IRIGEL(1,ISOUS)
  265.             IF (MAHYBR(ISOUS).NE.IPTEST) THEN
  266.                MOTERR(1:8)  = LETYP2
  267.                MOTERR(9:16) = 'ELTFA   '
  268.                INTERR(1)    = ISOUS
  269.                CALL ERREUR(698)
  270.                SEGDES RI2
  271.                GOTO 100
  272.             ENDIF
  273.          ENDIF
  274.  40   CONTINUE
  275.       SEGDES RI1
  276.       SEGDES RI2
  277. *
  278. * Construction de MCHPOI
  279. *
  280.       SEGDES IPMAHY
  281.       CALL SQTP1(IPMAHY,IPFACE,IPFORC,IPMATP,IFORC,
  282.      S    IORIE,INORM,ISURF,MCHPOI)
  283. *
  284.       CALL ECROBJ('CHPOINT',MCHPOI)
  285. *
  286. * Ménage
  287. *
  288.  100  CONTINUE
  289.       SEGSUP IPMAHY
  290.       RETURN
  291.       END
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  

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