Télécharger la plaquette Cast3M


fr en

Télécharger sqtp1.eso

Retour à la liste

Numérotation des lignes : 

sqtp1

  1. C SQTP1     SOURCE    FANDEUR   22/01/03    21:15:47     11136          
  2.       SUBROUTINE SQTP1(IPMAHY,IPFACE,IPFORC,IPMATP,
  3.      S                 IFORC,IORIE,INORM,ISURF,MCHPOI)
  4. C-----------------------------------------------------------------------
  5. C Calcul de la contribution au systeme en trace de charge d'une force
  6. C volumique dans le cas de la résolution des équations de Darcy par EFMH
  7. C avec le modèle DARCY.
  8. C-----------------------------------------------------------------------
  9. C
  10. C---------------------------
  11. C Parametres Entree/Sortie :
  12. C---------------------------
  13. C
  14. C E/  IPMAHY  : Segment contenant le pointeur vers le meleme des
  15. C               connectivites elements/faces pour les zones du MMODEL
  16. C               ou on a defini DARCY.
  17. C E/  IPFACE  : MELEME de type POI1 des faces
  18. C E/  IPFORC  : RIGIDITE de sous type 'MASSE'
  19. C E/  IPMATP  : RIGIDITE de sous type 'HYBTP'
  20. C E/  IFORC   : CHPO centre des sources de composantes FX, FY, (FZ)
  21. C E/  IORIE   : MCHAML orientation des normales
  22. C E/  INORM   : CHPO face des normales
  23. C E/  ISURF   : CHPO face des surfaces
  24. C  /S MCHPOI  : CHPOINT face de composante FLUX
  25. C
  26. C----------------------
  27. C Variables en COMMON :
  28. C----------------------
  29. C
  30. C E/  IFOMOD  : cf CCOPTIO
  31. C E/  NIFOUR  : cf CCOPTIO
  32. C E/  IDIM    : cf CCOPTIO
  33. C
  34. C
  35. C-----------------------------------------------------------------------
  36. C
  37. C Langage : ESOPE + FORTRAN77
  38. C
  39. C Auteurs : 02/96 L.V.BENET   - Cas permanent
  40. C
  41. C-----------------------------------------------------------------------
  42.       IMPLICIT INTEGER(I-N)
  43.       IMPLICIT REAL*8 (A-H,O-Z)
  44. *
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC CCHAMP
  49. -INC SMCOORD
  50. -INC SMCHPOI
  51. -INC SMCHAML
  52. -INC SMELEME
  53. -INC SMRIGID
  54. *
  55.       SEGMENT IPMAHY
  56.          INTEGER MAHYBR(NSOUS)
  57.       ENDSEGMENT
  58.       SEGMENT ICCPR
  59.          INTEGER ICPR(NNGOT)
  60.       ENDSEGMENT
  61.       SEGMENT MTRAV
  62.          REAL*8  RLIGN1(NBDDL),RLIGN2(NBDDL)
  63.       ENDSEGMENT
  64. *
  65. *- Initialisations
  66. *
  67.       MCHPOI = 0
  68. *- Creation du tableau ICPR pour le MELEME POI1 IPFACE
  69. *
  70.       IK     = 0
  71.       NNGOT  = nbpts
  72.       SEGINI ICCPR
  73.       MELEME = IPFACE
  74.       SEGACT MELEME
  75.       N2 = NUM(/2)
  76.       DO 10 I2=1,N2
  77.          K = NUM(1,I2)
  78.          IF (ICPR(K).EQ.0) THEN
  79.             IK      = IK + 1
  80.             ICPR(K) = IK
  81.          ENDIF
  82.   10  CONTINUE
  83.       SEGDES MELEME
  84. *
  85. *- Creation du CHAMPOINT face - On laisse actif le MPOVAL du CHPOINT
  86. *
  87.       NSOUPO = 1
  88.       NAT    = 1
  89.       SEGINI MCHPOI
  90.       IRET      = MCHPOI
  91.       MTYPOI    = 'FACE    '
  92.       IFOPOI    = IFOUR
  93.       JATTRI(1) = 2
  94.       NC        = 1
  95.       SEGINI MSOUPO
  96.       IPCHP(1)  = MSOUPO
  97.       SEGDES MCHPOI
  98.       NOHARM(1) = NIFOUR
  99.       IGEOC     = IPFACE
  100.       NOCOMP(1) = 'FLUX'
  101.       N         = N2
  102.       SEGINI MPOVAL
  103.       IPOVAL    = MPOVAL
  104.       SEGDES MSOUPO
  105. *
  106. *- Recuperation du nombre de zone NBMAIL du MMODEL a partir IPMAHY
  107. *
  108.       SEGACT IPMAHY
  109.       NBMAIL = MAHYBR(/1)
  110. *
  111. *- Activation des segments RIGIDITE masse hybride et MATP
  112. *
  113.       RI1 = IPFORC
  114.       SEGACT RI1
  115.       RI2 = IPMATP
  116.       SEGACT RI2
  117. *
  118. *- Activation du segment MPOVAL du CHAMPOINT centre de composantes FX FY FZ
  119. *
  120.       MCHPO1 = IFORC
  121.       SEGACT MCHPO1
  122.       MSOUP1 = MCHPO1.IPCHP(1)
  123.       SEGDES MCHPO1
  124.       SEGACT MSOUP1
  125.       MPOVA1 = MSOUP1.IPOVAL
  126.       SEGDES MSOUP1
  127.       SEGACT MPOVA1
  128. *
  129. * Activation du MCHAML d'orientation des normales
  130. *
  131.       MCHEL1 = IORIE
  132.       SEGACT MCHEL1
  133.  
  134. *
  135. * Activation du CHPO des vecteurs normales
  136. *
  137.       MCHPO2 = INORM
  138.       SEGACT MCHPO2
  139.       MSOUP2 = MCHPO2.IPCHP(1)
  140.       SEGDES MCHPO2
  141.       SEGACT MSOUP2
  142.       MPOVA2 = MSOUP2.IPOVAL
  143.       SEGDES MSOUP2
  144.       SEGACT MPOVA2
  145. *
  146. * Activation du CHPO des surfaces
  147. *
  148.       MCHPO3 = ISURF
  149.       SEGACT MCHPO3
  150.       MSOUP3 = MCHPO3.IPCHP(1)
  151.       SEGDES MCHPO3
  152.       SEGACT MSOUP3
  153.       MPOVA3 = MSOUP3.IPOVAL
  154.       SEGDES MSOUP3
  155.       SEGACT MPOVA3
  156. *
  157. *--------------------------------------------------
  158. *= BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL
  159. *--------------------------------------------------
  160. *
  161. *      WRITE(*,*)' NBMAIL ',NBMAIL
  162.       ITELEM = 0
  163.       DO 110 IMAIL=1,NBMAIL
  164. C
  165. C- Activation de l'objet maillage ELTFA pour la zone IMAIL
  166. C
  167.          MELEME = MAHYBR(IMAIL)
  168.          IF (MELEME.EQ.0) GOTO 110
  169.          SEGACT MELEME
  170. *
  171. *- Recuperation des caracteristiques de RIGIDITE de sous type MASSE
  172. *- pour la zone IMAIL en cours de traitement
  173. *
  174.          xMATR1 = RI1.IRIGEL(4,IMAIL)
  175.          SEGACT xMATR1
  176.          NBELEM = xMATR1.re(/3)
  177.          NELRIG = NBELEM
  178. *         XMATR1 = IMATR1.IMATTT(1)
  179. *         SEGACT XMATR1
  180.          NBDDL  = XMATR1.RE(/1)
  181.          NLIGRP = NBDDL
  182.          NLIGRD = NBDDL
  183. *         SEGDES XMATR1
  184. *
  185. *- Recuperation des caracteristiques de RIGIDITE de sous type HYBTP
  186. *- pour la zone IMAIL en cours de traitement
  187. *
  188.          xMATR2 = RI2.IRIGEL(4,IMAIL)
  189.          SEGACT xMATR2
  190.          NBELEM = xMATR2.re(/3)
  191.          NELRIG = NBELEM
  192. *         XMATR2 = IMATR2.IMATTT(1)
  193. *         SEGACT XMATR2
  194.          NBDDL  = XMATR2.RE(/1)
  195.          NLIGRP = NBDDL
  196.          NLIGRD = NBDDL
  197. *         SEGDES XMATR2
  198.          SEGINI MTRAV
  199. *
  200. * Activation du segment contenant les valeurs du MCHAML d'orientation
  201. * des normales par face pour la zone IMAIL
  202. *
  203.          MCHAM1 = MCHEL1.ICHAML(IMAIL)
  204.          SEGACT MCHAM1
  205.          MELVA1 = MCHAM1.IELVAL(1)
  206.          SEGDES MCHAM1
  207.          SEGACT MELVA1
  208. *
  209. *-------------------------------------------------------
  210. * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  211. *-------------------------------------------------------
  212. *
  213.          DO 100 IEL=1,NBELEM
  214.             ITELEM = ITELEM + 1
  215. *
  216. *- calcul des flux de forces aux faces de l'element
  217. *
  218.             DO 35 IDDL=1,NBDDL
  219.               RLIGN1(IDDL)= 0.D0
  220.               IPOPTS = ICPR(NUM(IDDL,IEL))
  221.               DO 40 I=1,IDIM
  222.                 RLIGN1(IDDL) = RLIGN1(IDDL) + MPOVA2.VPOCHA(IPOPTS,I) *
  223.      S MELVA1.VELCHE(IDDL,IEL) * MPOVA1.VPOCHA(ITELEM,I) *
  224.      S MPOVA3.VPOCHA(IPOPTS,1)
  225.   40              CONTINUE
  226.   35            CONTINUE
  227. *
  228. *- Construction du tableau aux faces M.FORCE
  229. *
  230. *            XMATR1 = IMATR1.IMATTT(IEL)
  231. *            SEGACT XMATR1
  232.             DO 45 I=1,NBDDL
  233.                 RLIGN2(I)= 0.D0
  234.                 DO 50 J=1,NBDDL
  235.                    RLIGN2(I)= RLIGN2(I) + XMATR1.RE(I,J,iel)*RLIGN1(J)
  236.   50            CONTINUE
  237.   45        CONTINUE
  238. *            SEGDES XMATR1
  239. *
  240. *- Construction du CHPOINT aux faces HYBTP.(M.FORCE)
  241. *
  242. *            XMATR2 = IMATR2.IMATTT(IEL)
  243. *            SEGACT XMATR2
  244.             DO 55 I=1,NBDDL
  245.                IPOPTS = ICPR(NUM(I,IEL))
  246.                DO 60 J=1,NBDDL
  247.                  VPOCHA(IPOPTS,1)=VPOCHA(IPOPTS,1) +
  248.      S XMATR2.RE(I,J,iel)*RLIGN2(J)
  249.   60                 CONTINUE
  250.   55              CONTINUE
  251. *            SEGDES XMATR2
  252.  100     CONTINUE
  253.          SEGDES xMATR1 , xMATR2
  254.          SEGDES MELEME
  255.          SEGDES MELVA1
  256.          SEGSUP MTRAV
  257.  110  CONTINUE
  258. *
  259. *- Desactivation des segments
  260. *
  261.       SEGDES MCHEL1
  262.       SEGDES MPOVAL , MPOVA1 , MPOVA2 , MPOVA3
  263.       SEGDES IPMAHY
  264.       SEGDES RI1 , RI2
  265.       SEGSUP ICCPR
  266.       RETURN
  267.       END
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  

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