Télécharger la plaquette Cast3M


fr en

Télécharger linlin.eso

Retour à la liste

Numérotation des lignes : 

linlin

  1. C LINLIN    SOURCE    GOUNAND   21/06/02    21:17:10     11022          
  2.       SUBROUTINE LINLIN(PGCOUR,
  3.      $     FVPR,FVDU,FCPR,FCDU,
  4.      $     KDERPR,KDERDU,
  5.      $     JDTJAC,NBELEM,LERF,IESREF,
  6.      $     JMTLIN,
  7.      $     IMPR,IRET)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       IMPLICIT INTEGER (I-N)
  10. C***********************************************************************
  11. C NOM         : LINLIN
  12. C DESCRIPTION : Calcul de la matrice.
  13. C
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : LINLI1 (calcul de JMTLIN (fortran 77))
  20. C APPELE PAR       : NLIN
  21. C***********************************************************************
  22. C ENTREES            : * PGCOUR (type POGAU)  : méthode d'intégration pour
  23. C                        le maillage élémentaire courant.
  24. C                      * FFGPR (type MCHEVA) : valeurs des fonctions
  25. C                        d'interpolation aux points de gauss sur
  26. C                        l'élément de référence pour la variable
  27. C                        primale.
  28. C                        Structure (cf.include SMCHAEL) :
  29. C                        (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1)
  30. C                      * DFFGPR (type MCHEVA) : valeurs des dérivées
  31. C                        premières des fonctions d'interpolation
  32. C                        primales aux points de gauss sur l'élément
  33. C                        réel.
  34. C                        Structure (cf.include SMCHAEL) :
  35. C                        (1, nb. ddl pri., 1, dim.esp.réel,
  36. C                         nb. poi. gauss, nb. élém.)
  37. C                      * FFGDU (type MCHEVA) : valeurs des fonctions
  38. C                        d'interpolation aux points de gauss sur
  39. C                        l'élément de référence pour la variable
  40. C                        duale.
  41. C                        Structure (cf.include SMCHAEL) :
  42. C                        (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1)
  43. C                      * DFFGDU (type MCHEVA) : valeurs des dérivées
  44. C                        premières des fonctions d'interpolation
  45. C                        duales aux points de gauss sur l'élément
  46. C                        réel.
  47. C                        Structure (cf.include SMCHAEL) :
  48. C                        (1, nb. ddl dua., 1, dim.esp.réel,
  49. C                         nb. poi. gauss, nb. élém.)
  50. C                      * CFGPR (type MCHEVA) : valeurs du coefficient
  51. C                        aux points de Gauss sur le maillage
  52. C                        élémentaire pour la variable primale.
  53. C                        Structure (cf.include SMCHAEL) :
  54. C                        (1, 1, 1, 1,
  55. C                         nb. poi. gauss, nb. éléments)
  56. C                      * CFGDU (type MCHEVA) : valeurs du coefficient
  57. C                        aux points de Gauss sur le maillage
  58. C                        élémentaire pour la variable duale.
  59. C                        Structure (cf.include SMCHAEL) :
  60. C                        (1, 1, 1, 1,
  61. C                         nb. poi. gauss, nb. éléments)
  62. C                      * KDERPR (type ENTIER) : dérivation sur la
  63. C                        variable primale.
  64. C                      * KDERDU(type ENTIER) : dérivation sur la
  65. C                        variable duale.
  66. C                      * JDTJAC (type MCHEVA) : valeurs du déterminant
  67. C                        de la matrice jacobienne aux points de Gauss
  68. C                        sur le maillage élémentaire.
  69. C                        Structure (cf.include SMCHAEL) :
  70. C                        (1, 1, 1, 1, nb. poi. gauss, nb. éléments)
  71. C                      * NBELEM (type entier) : nombre d'éléments du
  72. C                        maillage élémentaire courant.
  73. C ENTREES/SORTIES    : * JMTLIN (type MCHEVA) : valeurs de la matrice
  74. C                        moindres carrés sur le maillage élémentaire.
  75. C                        Structure (cf.include SMCHAEL) :
  76. C                        (nb. ddl dual, nb. ddl primal,
  77. C                         1, 1,
  78. C                         1, nb. éléments)
  79. C SORTIES            : -
  80. C TRAVAIL            : * NDDLDU (type entier) : nb. de ddl de la
  81. C                        variable duale par élément.
  82. C                      * NDDLPR (type entier) : nb. de ddl de la
  83. C                        variable primale par élément.
  84. C                      * IESREL (type entier) : dimension de l'espace
  85. C                        réel (i.e. géométrique).
  86. C                      * NBPOGO (type entier) : nombre de points
  87. C                        d'intégration.
  88. C                      * NLDFPR (type entier) : nombre d'éléments de
  89. C                        DFFGPR.
  90. C                      * NLDFDU (type entier) : nombre d'éléments de
  91. C                        DFFGDU.
  92. C                      * NLCPR (type entier) : nombre d'éléments de
  93. C                        CFGPR.
  94. C                      * NLCDU (type entier) : nombre d'éléments de
  95. C                        CFGDU.
  96. C                      * NLDTJ  (type entier) : nombre d'éléments de
  97. C                        JDTJAC.
  98. C       Les nombres d'éléments ci-dessus valent :
  99. C       - soit NBELEM ;
  100. C       - soit 1 si le champ par élément est constant sur le maillage
  101. C         élémentaire courant.
  102. C                      * NLMLIN (type entier) : nombre d'éléments de
  103. C                        JMTLIN.
  104. C***********************************************************************
  105. C VERSION    : v3.1, 30/07/04, possiblité de travailler
  106. C                              dans l'espace de référence
  107. C VERSION    : v1, 11/05/04, version initiale
  108. C HISTORIQUE : v1, 11/05/04, création
  109. C HISTORIQUE :
  110. C HISTORIQUE :
  111. C***********************************************************************
  112. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  113. C en cas de modification de ce sous-programme afin de faciliter
  114. C la maintenance !
  115. C***********************************************************************
  116.  
  117. -INC PPARAM
  118. -INC CCOPTIO
  119. -INC TNLIN      
  120. *-INC SPOGAU
  121.       POINTEUR PGCOUR.POGAU
  122. *-INC SMCHAEL
  123.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  124.       POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  125.       POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  126.       POINTEUR JDTJAC.MCHEVA
  127.       POINTEUR JMTLIN.MCHEVA
  128. *
  129.       INTEGER KDERPR,KDERDU
  130.       INTEGER NBELEM
  131.       INTEGER LERF
  132.       INTEGER IMPR,IRET
  133. *
  134.       INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  135.       INTEGER NLDTJ,NLMLIN
  136.       INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO
  137. *
  138. * Executable statements
  139. *
  140.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linlin'
  141. *
  142.       IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN
  143.          WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR
  144.          GOTO 9999
  145.       ENDIF
  146. *
  147.       IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN
  148.          WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU
  149.          GOTO 9999
  150.       ENDIF
  151. *
  152.       IESREL=IDIM
  153.       IF (LERF.NE.0) THEN
  154.          IESDER=IESREF
  155.       ELSE
  156.          IESDER=IESREL
  157.       ENDIF
  158. *
  159.       SEGACT PGCOUR
  160.       NBPOGO=PGCOUR.XPOPG(/1)
  161. *
  162. *      SEGPRT,FVPR
  163.       SEGACT FVPR
  164.       NDLIG=FVPR.WELCHE(/1)
  165.       NDCOL=FVPR.WELCHE(/2)
  166.       N2DLIG=FVPR.WELCHE(/3)
  167.       N2DCOL=FVPR.WELCHE(/4)
  168.       NDNOEU=FVPR.WELCHE(/5)
  169.       NDELM=FVPR.WELCHE(/6)
  170.       IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  171.      $     ((N2DCOL.NE.1.AND.KDERPR.EQ.0)
  172.      $      .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0))
  173.      $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  174.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  175.          WRITE(IOIMP,*) 'Erreur dims FVPR'
  176.          GOTO 9999
  177.       ENDIF
  178.       NDDLPR=NDCOL
  179.       N2FVPR=N2DCOL
  180.       NPFVPR=NDNOEU
  181.       NLFVPR=NDELM
  182. *
  183. *      SEGPRT,FVDU
  184.       SEGACT FVDU
  185.       NDLIG=FVDU.WELCHE(/1)
  186.       NDCOL=FVDU.WELCHE(/2)
  187.       N2DLIG=FVDU.WELCHE(/3)
  188.       N2DCOL=FVDU.WELCHE(/4)
  189.       NDNOEU=FVDU.WELCHE(/5)
  190.       NDELM=FVDU.WELCHE(/6)
  191.       IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  192.      $     ((N2DCOL.NE.1.AND.KDERDU.EQ.0)
  193.      $      .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0))
  194.      $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  195.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  196.          WRITE(IOIMP,*) 'Erreur dims FVDU'
  197.          GOTO 9999
  198.       ENDIF
  199.       NDDLDU=NDCOL
  200.       N2FVDU=N2DCOL
  201.       NPFVDU=NDNOEU
  202.       NLFVDU=NDELM
  203. *
  204. *      SEGPRT,FCPR
  205.       SEGACT FCPR
  206.       NDLIG =FCPR.WELCHE(/1)
  207.       NDCOL =FCPR.WELCHE(/2)
  208.       N2DLIG=FCPR.WELCHE(/3)
  209.       N2DCOL=FCPR.WELCHE(/4)
  210.       NDNOEU=FCPR.WELCHE(/5)
  211.       NDELM =FCPR.WELCHE(/6)
  212.       IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  213.      $     N2DCOL.NE.1
  214.      $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  215.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  216.          WRITE(IOIMP,*) 'Erreur dims FCPR'
  217.          GOTO 9999
  218.       ENDIF
  219.       NPFCPR=NDNOEU
  220.       NLFCPR=NDELM
  221. *
  222. *      SEGPRT,FCDU
  223.       SEGACT FCDU
  224.       NDLIG =FCDU.WELCHE(/1)
  225.       NDCOL =FCDU.WELCHE(/2)
  226.       N2DLIG=FCDU.WELCHE(/3)
  227.       N2DCOL=FCDU.WELCHE(/4)
  228.       NDNOEU=FCDU.WELCHE(/5)
  229.       NDELM =FCDU.WELCHE(/6)
  230.       IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  231.      $     N2DCOL.NE.1
  232.      $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  233.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  234.          WRITE(IOIMP,*) 'Erreur dims FCDU'
  235.          GOTO 9999
  236.       ENDIF
  237.       NPFCDU=NDNOEU
  238.       NLFCDU=NDELM
  239. *
  240.       SEGACT JDTJAC
  241.       NDLIG=JDTJAC.WELCHE(/1)
  242.       NDCOL=JDTJAC.WELCHE(/2)
  243.       N2DLIG=JDTJAC.WELCHE(/3)
  244.       N2DCOL=JDTJAC.WELCHE(/4)
  245.       NDNOEU=JDTJAC.WELCHE(/5)
  246.       NDELM=JDTJAC.WELCHE(/6)
  247.       IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
  248.      $     .OR.N2DCOL.NE.1
  249.      $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  250.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  251.          WRITE(IOIMP,*) 'Erreur dims JDTJAC'
  252.          GOTO 9999
  253.       ENDIF
  254.       NPDTJ=NDNOEU
  255.       NLDTJ=NDELM
  256. *
  257.       IF (JMTLIN.EQ.0) THEN
  258.          NBLIG=NDDLDU
  259.          NBCOL=NDDLPR
  260.          N2LIG=1
  261.          N2COL=1
  262.          NBPOI=1
  263.          NBELM=NBELEM
  264. * On pourrait aussi envisager de renvoyer une seule matrice pour le cas
  265. * où NLCFG=NLFPRG=NLFDUG=NLDTJ=1
  266.          SEGINI JMTLIN
  267.          NLMLIN=NBELM
  268.       ELSE
  269.          SEGACT JMTLIN*MOD
  270.          NDLIG=JMTLIN.WELCHE(/1)
  271.          NDCOL=JMTLIN.WELCHE(/2)
  272.          N2DLIG=JMTLIN.WELCHE(/3)
  273.          N2DCOL=JMTLIN.WELCHE(/4)
  274.          NDNOEU=JMTLIN.WELCHE(/5)
  275.          NDELM=JMTLIN.WELCHE(/6)
  276.          IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1
  277.      $        .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  278.      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  279.             WRITE(IOIMP,*) 'Erreur dims JMTLIN'
  280.             GOTO 9999
  281.          ENDIF
  282.          NLMLIN=NDELM
  283.       ENDIF
  284. *
  285.       KDFRPR=MAX(1,KDERPR)
  286.       KDFRDU=MAX(1,KDERDU)
  287. *
  288. * On effectue le calcul de la matrice de moindres carrés
  289. *
  290.       CALL LINLI1(NDDLPR,NDDLDU,NBPOGO,
  291.      $     N2FVPR,N2FVDU,
  292.      $     NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  293.      $     NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN,
  294.      $     KDFRPR,KDFRDU,
  295.      $     PGCOUR.XPOPG,
  296.      $     FVPR.WELCHE,FVDU.WELCHE,FCPR.WELCHE,FCDU.WELCHE,
  297.      $     JDTJAC.WELCHE,LERF,JMTLIN.WELCHE,
  298.      $     IMPR,IRET)
  299.       IF (IRET.NE.0) GOTO 9999
  300. *      SEGDES JMTLIN
  301.       SEGDES JMTLIN
  302. *      IMPR=6
  303.       IF (IMPR.GT.3) THEN
  304.          WRITE(IOIMP,*) 'On a créé',
  305.      $        ' JMTLIN(élément ,1 ,1 ,1 ,',
  306.      $        ' ddl.pri , ddl.dua)'
  307.          CALL PRCHVA(JMTLIN,IMPR,IRET)
  308.          IF (IRET.NE.0) GOTO 9999
  309.       ENDIF
  310. *      IMPR=0
  311.       SEGDES JDTJAC
  312.       SEGDES FCDU
  313.       SEGDES FCPR
  314.       SEGDES FVDU
  315.       SEGDES FVPR
  316.       SEGDES PGCOUR
  317. *
  318. * Normal termination
  319. *
  320.       IRET=0
  321.       RETURN
  322. *
  323. * Format handling
  324. *
  325. *
  326. * Error handling
  327. *
  328.  9999 CONTINUE
  329.       IRET=1
  330.       WRITE(IOIMP,*) 'An error was detected in subroutine linlin'
  331.       RETURN
  332. *
  333. * End of subroutine LINLIN
  334. *
  335.       END
  336.  
  337.  
  338.  
  339.  

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