Télécharger la plaquette Cast3M


fr en

Télécharger xlap1c.eso

Retour à la liste

Numérotation des lignes : 

xlap1c

  1. C XLAP1C    SOURCE    CB215821  20/11/25    13:43:12     10792          
  2.       SUBROUTINE XLAP1C(ICOGRV,MPROC,MPVITC,
  3.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  4.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  5.      $     NOMINC,
  6.      $     MPMUC,
  7.      $     IJACO,
  8.      $     IMPR,IRET)
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11. C***********************************************************************
  12. C NOM         : XLAP1C
  13. C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
  14. C               VF 2D.
  15. C               Ici, on ne calcule que les contributions 'simples'
  16. C               à la matrice jacobienne faisant intervenir les
  17. C               coefficients pour le calcul des gradients de vitesse
  18. C               (ICOGRV).
  19. C               (contributions à (d Res_{\rho u} / d var) et (d
  20. C                Res_{\rho v} / d var)
  21. C                var prenant successivement les valeurs :
  22. C                \rho,   \rho u,    \rho v,     \rho e_t )
  23. C
  24. C
  25. C NOTE PERSO  : On pourrait programmer ça plus lisiblement en stockant
  26. C               les contributions dans un tableau de pointeurs (2
  27. C               indices, c'est possible ?) et en effectuant des produits
  28. C               matriciels (coeff. x matrices de dérivées).
  29. C               On n'y coupera pas si on veut regrouper 2D et 3D...
  30. C               On ne va pas le faire.
  31. C
  32. C
  33. C LANGAGE     : ESOPE
  34. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  35. C               mél : gounand@semt2.smts.cea.fr
  36. C***********************************************************************
  37. C APPELES (UTIL)   : AJMTK : ajoute un objet de type MATSIM (non
  38. C                            standard) à un objet de type MATRIK.
  39. C APPELE PAR       : XLAP1A : Calcul de la matrice jacobienne du
  40. C                    résidu du laplacien VF 2D.
  41. C***********************************************************************
  42. C ENTREES            : ICOGRV (type MCHELM) : coefficients pour le
  43. C                        calcul du gradient de la vitesse aux
  44. C                        interfaces.
  45. C                      MPROC (type MPOVAL) : masse volumique par
  46. C                                            élément.
  47. C                      MPVITC (type MPOVAL) : vitesse par élément.
  48. C                      MPVOLU (type MPOVAL) : volume des éléments.
  49. C                      MPNORM (type MPOVAL) : normale aux faces.
  50. C                      MPSURF (type MPOVAL) : surface des faces.
  51. C                      MELEFL (type MELEME) : connectivités face-(centre
  52. C                                             gauche, centre droit).
  53. C                      KRFACE (type MLENTI) : tableau de repérage dans
  54. C                        le maillage des faces des éléments.
  55. C                      KRCENT (type MLENTI) : tableau de repérage dans
  56. C                        le maillage des centres des éléments.
  57. C                      LCLIMV (type logique) : .TRUE. => CL de Dirichlet
  58. C                        sur la vitesse.
  59. C                      KRVIMP (type MLENTI) : tableau de repérage dans
  60. C                        maillage des CL de Dirichlet sur la
  61. C                        vitesse.
  62. C                      LCLITO (type logique) : .TRUE. => CL de Dirichlet
  63. C                        sur le tenseur des contraintes.
  64. C                      KRTOIM (type MLENTI) : tableau de repérage dans
  65. C                        maillage des CL de Dirichlet sur le tenseur des
  66. C                        contraintes
  67. C                      NOMINC (type MLMOTS) : noms des inconnues.
  68. C                      MPMUC (type MPOVAL) : viscosité dynamique (SI).
  69. C ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du
  70. C                        résidu du laplacien VF 2D.
  71. C SORTIES            : -
  72. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  73. C***********************************************************************
  74. C VERSION    : v1, 10/12/2001, version initiale
  75. C HISTORIQUE : v1, 10/12/2001, création
  76. C HISTORIQUE :
  77. C HISTORIQUE :
  78. C***********************************************************************
  79. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  80. C en cas de modification de ce sous-programme afin de faciliter
  81. C la maintenance !
  82. C***********************************************************************
  83.  
  84. -INC PPARAM
  85. -INC CCOPTIO
  86. -INC SMCOORD
  87. -INC SMCHPOI
  88.       POINTEUR MPMUC.MPOVAL
  89.       POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL
  90.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  91. -INC SMCHAML
  92.       POINTEUR ICOGRV.MCHELM,JCOGRV.MCHAML
  93.       POINTEUR KDUNDX.MELVAL,KDUNDY.MELVAL
  94. -INC SMELEME
  95.       POINTEUR MELEFL.MELEME
  96.       POINTEUR MCOGRV.MELEME
  97. -INC SMLENTI
  98.       POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
  99.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  100. -INC SMLMOTS
  101.       POINTEUR NOMINC.MLMOTS
  103.       POINTEUR IJACO.MATRIK
  104. *
  105. * Objet matrice élémentaire simplifié
  106. *
  107.       SEGMENT GMATSI
  108.       INTEGER POIPR1(NPP1,NEL1)
  109.       INTEGER POIDU1(1,NEL1)
  110.       INTEGER POIPR2(NPP2,NEL2)
  111.       INTEGER POIDU2(2,NEL2)
  112.       POINTEUR LMATSI(0).MATSIM
  113.       ENDSEGMENT
  114. *  Contributions simples de la part du gradient de
  115. *  vitesse (CTSGRV)
  116.       POINTEUR CTSGRV.GMATSI
  117.       SEGMENT MATSIM
  118.       CHARACTER*8 NOMPRI,NOMDUA
  119.       REAL*8 VALMA1(1,NPP1,NEL1)
  120.       REAL*8 VALMA2(2,NPP2,NEL2)
  121.       ENDSEGMENT
  122.       POINTEUR ROURHO.MATSIM
  123.       POINTEUR ROVRHO.MATSIM
  124.       POINTEUR ROUROU.MATSIM
  125.       POINTEUR ROUROV.MATSIM
  126.       POINTEUR ROVROU.MATSIM
  127.       POINTEUR ROVROV.MATSIM
  128. *
  129.       REAL*8 MU
  130. *
  131.       INTEGER IMPR,IRET
  132. *
  133.       LOGICAL LCLIMV,LCLITO
  134.       LOGICAL LMUR
  135.       LOGICAL LCTRB1,LCTRB2
  136. *
  137.       INTEGER IELEM,IPD,IPP,ISOUCH,IEL1,IEL2
  138.       INTEGER NELEM,NPD,NPP,NSOUCH,NEL1,NEL2,NPP1,NPP2
  139.       INTEGER NGCDRO,NGCGAU,NGFACE,NPPRIM,NPDUAL
  140.       INTEGER NLCENP,NLCEND,NLFACE,NLCLTO,NLCLV
  141.       INTEGER NPTEL
  142. *
  143.       REAL*8 ALPHAX,ALPHAY,CNX,CNY
  144.       REAL*8 SIGNOR,SURFFA,VOLUEL
  145.       REAL*8 RHOP,UP,VP
  146.       REAL*8 FACTOR
  147.       REAL*8 DUDRHO,DUDROU,DVDRHO,DVDROV
  148.       REAL*8 BROUDU,BROUDV,BROVDU,BROVDV
  149. *
  150.       INTEGER ICOORX,NLCGAU,NLCDRO
  151.       REAL*8 XF,YF,XG,YG,XFMXG,YFMYG,DRG
  152.      &     ,XD,YD,XFMXD,YFMYD,DRD,ALPHA,UMALPH
  153. C
  154. *
  155. * Executable statements
  156. *
  157.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans xlap1c.eso'
  158. *   On calcule les contributions à (d Res_{\rho u} / d var) et (d
  159. *   Res_{\rho v} / d var) ; var prenant successivement les valeurs :
  160. *      \rho,   \rho u,    \rho v,     \rho e_t
  161. *   Note :
  162. *     - (d Res_{\rho u} / d \rho e_t) = 0
  163. *     - (d Res_{\rho v} / d \rho e_t) = 0
  164. *   On dérive les termes : \tens{\tau} \prod \vect{n}
  165. *   Les noms de matrices élémentaires (type MATSIM) associées sont :
  166. *   ROURHO, ROUROU, ROUROV, ROVRHO, ROVROU, ROVROV
  167.       IF (LCLIMV) THEN
  168.          SEGACT KRVIMP
  169.       ENDIF
  170.       IF (LCLITO) THEN
  171.          SEGACT KRTOIM
  172.       ENDIF
  173.       SEGACT NOMINC
  174.       SEGACT KRCENT
  175.       SEGACT KRFACE
  176.       SEGACT MELEFL
  177.       SEGACT MPSURF
  178.       SEGACT MPNORM
  179.       SEGACT MPVOLU
  180.       SEGACT MPMUC
  181.       SEGACT MPROC
  182.       SEGACT MPVITC
  183.       SEGACT ICOGRV
  184.       NSOUCH=ICOGRV.IMACHE(/1)
  185.       DO 1 ISOUCH=1,NSOUCH
  186.          MCOGRV=ICOGRV.IMACHE(ISOUCH)
  187.          JCOGRV=ICOGRV.ICHAML(ISOUCH)
  188.          SEGACT JCOGRV
  189.          KDUNDX=JCOGRV.IELVAL(1)
  190.          KDUNDY=JCOGRV.IELVAL(2)
  191.          SEGDES JCOGRV
  192.          SEGACT KDUNDX
  193.          SEGACT KDUNDY
  194.          SEGACT MCOGRV
  195.          NELEM=MCOGRV.NUM(/2)
  196.          NPTEL=MCOGRV.NUM(/1)
  197.          NPP1=NPTEL-1
  198.          NPP2=NPTEL-1
  199.          NEL1=NELEM
  200.          NEL2=NELEM
  201.          IEL1=1
  202.          IEL2=1
  203.          SEGINI ROURHO
  204.          SEGINI ROVRHO
  205.          SEGINI ROUROU
  206.          SEGINI ROVROU
  207.          SEGINI ROUROV
  208.          SEGINI ROVROV
  209.          SEGINI CTSGRV
  210.          ROURHO.NOMPRI(1:4)=NOMINC.MOTS(1)
  211.          ROURHO.NOMPRI(5:8)='    '
  212.          ROURHO.NOMDUA(1:4)=NOMINC.MOTS(2)
  213.          ROURHO.NOMDUA(5:8)='    '
  214.          ROVRHO.NOMPRI(1:4)=NOMINC.MOTS(1)
  215.          ROVRHO.NOMPRI(5:8)='    '
  216.          ROVRHO.NOMDUA(1:4)=NOMINC.MOTS(3)
  217.          ROVRHO.NOMDUA(5:8)='    '
  218.          ROUROU.NOMPRI(1:4)=NOMINC.MOTS(2)
  219.          ROUROU.NOMPRI(5:8)='    '
  220.          ROUROU.NOMDUA(1:4)=NOMINC.MOTS(2)
  221.          ROUROU.NOMDUA(5:8)='    '
  222.          ROVROU.NOMPRI(1:4)=NOMINC.MOTS(2)
  223.          ROVROU.NOMPRI(5:8)='    '
  224.          ROVROU.NOMDUA(1:4)=NOMINC.MOTS(3)
  225.          ROVROU.NOMDUA(5:8)='    '
  226.          ROUROV.NOMPRI(1:4)=NOMINC.MOTS(3)
  227.          ROUROV.NOMPRI(5:8)='    '
  228.          ROUROV.NOMDUA(1:4)=NOMINC.MOTS(2)
  229.          ROUROV.NOMDUA(5:8)='    '
  230.          ROVROV.NOMPRI(1:4)=NOMINC.MOTS(3)
  231.          ROVROV.NOMPRI(5:8)='    '
  232.          ROVROV.NOMDUA(1:4)=NOMINC.MOTS(3)
  233.          ROVROV.NOMDUA(5:8)='    '
  234.          DO 12 IELEM=1,NELEM
  235. *     Le premier point du support de ICOGRV est un point FACE
  236.             NGFACE=MCOGRV.NUM(1,IELEM)
  237.             NLFACE=KRFACE.LECT(NGFACE)
  238.             IF (NLFACE.EQ.0) THEN
  239.                WRITE(IOIMP,*) 'Erreur de programmation n°1'
  240.                GOTO 9999
  241.             ENDIF
  242. *     On calcule la contribution à la matrice jacobienne IJACO de la face
  243. *     NGFAC (points duaux     : centres à gauche et à droite de la face)
  244. *           (points primaux   : une partie (bicoz conditions aux limites)
  245. *            de ceux du stencil pour le calcul du gradient
  246. *            à la face, ils doivent être des points centres)
  247. *       Si le tenseur des contraintes sur la face est imposé par les
  248. *       conditions aux limites, la contribution de la face à IJACO est
  249. *       nulle.
  250.             LCTRB1=.TRUE.
  251.             IF (LCLITO) THEN
  252.                NLCLTO=KRTOIM.LECT(NGFACE)
  253.                IF (NLCLTO.NE.0) THEN
  254.                   LCTRB1=.FALSE.
  255.                ENDIF
  256.             ENDIF
  257.             IF (LCTRB1) THEN
  258.                NGCGAU=MELEFL.NUM(1,NLFACE)
  259.                NGCDRO=MELEFL.NUM(3,NLFACE)
  260.                NLCGAU=KRCENT.LECT(NGCGAU)
  261.                NLCDRO=KRCENT.LECT(NGCDRO)
  262.                LMUR=(NGCGAU.EQ.NGCDRO)
  263. *     On distingue le cas où la face est un bord du maillage (mur)
  264. *                  du cas où la face est interne au maillage
  265.                IF (.NOT.LMUR) THEN
  266.                   NPD=2
  267.                   ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
  268.                   XF = MCOORD.XCOOR(ICOORX)
  269.                   YF = MCOORD.XCOOR(ICOORX+1)
  270.                   ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
  271.                   XG = MCOORD.XCOOR(ICOORX)
  272.                   YG = MCOORD.XCOOR(ICOORX+1)
  273.                   XFMXG = XF - XG
  274.                   YFMYG = YF - YG
  275.                   DRG=SQRT((XFMXG*XFMXG)+(YFMYG*YFMYG))
  276.                   ICOORX = ((IDIM + 1) * (NGCDRO - 1))+1
  277.                   XD = MCOORD.XCOOR(ICOORX)
  278.                   YD = MCOORD.XCOOR(ICOORX+1)
  279.                   XFMXD = XF - XD
  280.                   YFMYD = YF - YD
  281.                   DRD=SQRT((XFMXD*XFMXD)+(YFMYD*YFMYD))
  282.                   ALPHA=DRG/(DRG+DRD)
  283.                   UMALPH= 1.0D0 - ALPHA
  284.                ELSE
  285.                   NPD=1
  286.                   ALPHA=0.0D0
  287.                   UMALPH=1.0D0
  288.                ENDIF
  289.                MU=UMALPH*MPMUC.VPOCHA(NLCGAU,1) +
  290.      &              ALPHA*MPMUC.VPOCHA(NLCDRO,1)
  291.                NPP=NPTEL-1
  292. *     IPD=1 : point à gauche du point NGFACE
  293. *     IPD=2 : point à droite du point NGFACE
  294.                DO 122 IPD=1,NPD
  295.                   NPDUAL=MELEFL.NUM((2*IPD)-1,NLFACE)
  296.                   IF (.NOT.LMUR) THEN
  297.                      CTSGRV.POIDU2(IPD,IEL2)=NPDUAL
  298.                   ELSE
  299.                      CTSGRV.POIDU1(IPD,IEL1)=NPDUAL
  300.                   ENDIF
  301.                   NLCEND=KRCENT.LECT(NPDUAL)
  302.                   IF (NLCEND.EQ.0) THEN
  303.                      WRITE(IOIMP,*) 'Erreur grave n°1'
  304.                      GOTO 9999
  305.                   ENDIF
  306.                   DO 124 IPP=1,NPP
  307.                      NPPRIM=MCOGRV.NUM(IPP+1,IELEM)
  308.                      LCTRB2=.TRUE.
  309.                      IF (LCLIMV) THEN
  310.                         NLCLV=KRVIMP.LECT(NPPRIM)
  311.                         IF (NLCLV.NE.0) THEN
  312.                            LCTRB2=.FALSE.
  313.                         ENDIF
  314.                      ENDIF
  315.                      IF (.NOT.LCTRB2) THEN
  316. *     Lorsque une contribution est nulle, on fixe artificiellement le
  317. *     point primal égal au point dual.
  318.                         IF (.NOT.LMUR) THEN
  319.                            CTSGRV.POIPR2(IPP,IEL2)=NPDUAL
  320.                            ROURHO.VALMA2(IPD,IPP,IEL2)=0.D0
  321.                            ROVRHO.VALMA2(IPD,IPP,IEL2)=0.D0
  322.                            ROUROU.VALMA2(IPD,IPP,IEL2)=0.D0
  323.                            ROVROU.VALMA2(IPD,IPP,IEL2)=0.D0
  324.                            ROUROV.VALMA2(IPD,IPP,IEL2)=0.D0
  325.                            ROVROV.VALMA2(IPD,IPP,IEL2)=0.D0
  326.                         ELSE
  327.                            CTSGRV.POIPR1(IPP,IEL1)=NPDUAL
  328.                            ROURHO.VALMA1(IPD,IPP,IEL1)=0.D0
  329.                            ROVRHO.VALMA1(IPD,IPP,IEL1)=0.D0
  330.                            ROUROU.VALMA1(IPD,IPP,IEL1)=0.D0
  331.                            ROVROU.VALMA1(IPD,IPP,IEL1)=0.D0
  332.                            ROUROV.VALMA1(IPD,IPP,IEL1)=0.D0
  333.                            ROVROV.VALMA1(IPD,IPP,IEL1)=0.D0
  334.                         ENDIF
  335.                      ELSE
  336. *     Les contributions valent :
  337. * 1.  (d Res_{\rho u})_d / (d var)_p =
  338. *     +/-1 (normale sortante, rentrante)  (1/V_d) * (S_f) * \mu
  339. *     * [ [ ( 4/3 (n_x * \alpha_x) + (n_y * \alpha_y)) *
  340. *           ((du)_p / (d var)_p)]
  341. *       + [ (-2/3 (n_x * \alpha_y) + (n_y * \alpha_x)) *
  342. *           ((dv)_p / (d var)_p)]
  343. *       ]
  344. * 2.  (d Res_{\rho v})_d / (d var)_p =
  345. *     +/-1 (normale sortante, rentrante)  (1/V_d) * (S_f) * \mu
  346. *     * [ [ (-2/3 (n_y * \alpha_x) + (n_x * \alpha_y)) *
  347. *           ((du)_p / (d var)_p)]
  348. *       + [ ( 4/3 (n_y * \alpha_y) + (n_x * \alpha_x)) *
  349. *           ((dv)_p / (d var)_p)]
  350. *       ]
  351. *
  352. *     avec :
  353. *          (du)_p / (d \rho)_p   = - u / \rho_p
  354. *          (du)_p / (d \rho u)_p =   1 / \rho_p
  355. *          (du)_p / (d \rho v)_p =   0
  356. *          (dv)_p / (d \rho)_p   = - v / \rho_p
  357. *          (dv)_p / (d \rho u)_p =   0
  358. *          (dv)_p / (d \rho v)_p =   1 / \rho_p
  359. *
  360.                         NLCENP=KRCENT.LECT(NPPRIM)
  361.                         IF (NLCENP.EQ.0) THEN
  362.                            WRITE(IOIMP,*) 'Erreur grave n°2'
  363.                            GOTO 9999
  364.                         ENDIF
  365. *       normale sortante pour IPD=1, rentrante pour IPD=2
  366.                         SIGNOR=(-1.D0)**(IPD+1)
  367.                         VOLUEL=MPVOLU.VPOCHA(NLCEND,1)
  368.                         SURFFA=MPSURF.VPOCHA(NLFACE,1)
  369.                         CNX   =MPNORM.VPOCHA(NLFACE,1)
  370.                         CNY   =MPNORM.VPOCHA(NLFACE,2)
  371.                         ALPHAX=KDUNDX.VELCHE(IPP+1,IELEM)
  372.                         ALPHAY=KDUNDY.VELCHE(IPP+1,IELEM)
  373.                         RHOP  =MPROC.VPOCHA(NLCENP,1)
  374.                         UP    =MPVITC.VPOCHA(NLCENP,1)
  375.                         VP    =MPVITC.VPOCHA(NLCENP,2)
  376.                         FACTOR=SIGNOR*(1.D0/VOLUEL)*SURFFA*MU
  377.                         BROUDU=(( 4.D0/3.D0)*(CNX*ALPHAX))
  378.      $                       + (CNY*ALPHAY)
  379.                         BROUDV=((-2.D0/3.D0)*(CNX*ALPHAY))
  380.      $                       + (CNY*ALPHAX)
  381.                         BROVDU=((-2.D0/3.D0)*(CNY*ALPHAX))
  382.      $                       + (CNX*ALPHAY)
  383.                         BROVDV=(( 4.D0/3.D0)*(CNY*ALPHAY))
  384.      $                       + (CNX*ALPHAX)
  385.                         DUDRHO=-UP /RHOP
  386.                         DUDROU=1.D0/RHOP
  387.                         DVDRHO=-VP /RHOP
  388.                         DVDROV=1.D0/RHOP
  389.                         IF (.NOT.LMUR) THEN
  390.                            CTSGRV.POIPR2(IPP,IEL2)=NPPRIM
  391.                            ROURHO.VALMA2(IPD,IPP,IEL2)=
  392.      $                          FACTOR*((BROUDU*DUDRHO)+(BROUDV*DVDRHO))
  393.                            ROVRHO.VALMA2(IPD,IPP,IEL2)=
  394.      $                          FACTOR*((BROVDU*DUDRHO)+(BROVDV*DVDRHO))
  395.                            ROUROU.VALMA2(IPD,IPP,IEL2)=
  396.      $                          FACTOR* (BROUDU*DUDROU)
  397.                            ROVROU.VALMA2(IPD,IPP,IEL2)=
  398.      $                          FACTOR* (BROVDU*DUDROU)
  399.                            ROUROV.VALMA2(IPD,IPP,IEL2)=
  400.      $                          FACTOR* (BROUDV*DVDROV)
  401.                            ROVROV.VALMA2(IPD,IPP,IEL2)=
  402.      $                          FACTOR* (BROVDV*DVDROV)
  403.                         ELSE
  404.                            CTSGRV.POIPR1(IPP,IEL1)=NPPRIM
  405.                            ROURHO.VALMA1(IPD,IPP,IEL1)=
  406.      $                          FACTOR*((BROUDU*DUDRHO)+(BROUDV*DVDRHO))
  407.                            ROVRHO.VALMA1(IPD,IPP,IEL1)=
  408.      $                          FACTOR*((BROVDU*DUDRHO)+(BROVDV*DVDRHO))
  409.                            ROUROU.VALMA1(IPD,IPP,IEL1)=
  410.      $                          FACTOR* (BROUDU*DUDROU)
  411.                            ROVROU.VALMA1(IPD,IPP,IEL1)=
  412.      $                          FACTOR* (BROVDU*DUDROU)
  413.                            ROUROV.VALMA1(IPD,IPP,IEL1)=
  414.      $                          FACTOR* (BROUDV*DVDROV)
  415.                            ROVROV.VALMA1(IPD,IPP,IEL1)=
  416.      $                          FACTOR* (BROVDV*DVDROV)
  417.                         ENDIF
  418.                      ENDIF
  419.  124              CONTINUE
  420.  122           CONTINUE
  421.                IF (.NOT.LMUR) THEN
  422.                   IEL2=IEL2+1
  423.                ELSE
  424.                   IEL1=IEL1+1
  425.                ENDIF
  426.             ENDIF
  427.  12      CONTINUE
  428.          NPP1=NPTEL-1
  429.          NPP2=NPTEL-1
  430.          NEL1=IEL1-1
  431.          NEL2=IEL2-1
  432.          SEGADJ ROURHO
  433.          SEGADJ ROVRHO
  434.          SEGADJ ROUROU
  435.          SEGADJ ROVROU
  436.          SEGADJ ROUROV
  437.          SEGADJ ROVROV
  438.          SEGADJ CTSGRV
  439.          CTSGRV.LMATSI(**)=ROURHO
  440.          CTSGRV.LMATSI(**)=ROVRHO
  441.          CTSGRV.LMATSI(**)=ROUROU
  442.          CTSGRV.LMATSI(**)=ROVROU
  443.          CTSGRV.LMATSI(**)=ROUROV
  444.          CTSGRV.LMATSI(**)=ROVROV
  445. * On accumule les matrices résultantes dans IJACO
  446.          CALL AJMTK(CTSGRV,IJACO,IMPR,IRET)
  447.          IF (IRET.NE.0) GOTO 9999
  448.          SEGSUP ROURHO
  449.          SEGSUP ROVRHO
  450.          SEGSUP ROUROU
  451.          SEGSUP ROVROU
  452.          SEGSUP ROUROV
  453.          SEGSUP ROVROV
  454.          SEGSUP CTSGRV
  455. *
  456.          SEGDES MCOGRV
  457.          SEGDES KDUNDY
  458.          SEGDES KDUNDX
  459.  1    CONTINUE
  460.       SEGDES ICOGRV
  461.       SEGDES MPVITC
  462.       SEGDES MPMUC
  463.       SEGDES MPROC
  464.       SEGDES MPVOLU
  465.       SEGDES MPNORM
  466.       SEGDES MPSURF
  467.       SEGDES MELEFL
  468.       SEGDES KRFACE
  469.       SEGDES KRCENT
  470.       SEGDES NOMINC
  471.       IF (LCLITO) THEN
  472.          SEGDES KRTOIM
  473.       ENDIF
  474.       IF (LCLIMV) THEN
  475.          SEGDES KRVIMP
  476.       ENDIF
  477. *
  478. * Normal termination
  479. *
  480.       IRET=0
  481.       RETURN
  482. *
  483. * Format handling
  484. *
  485. *
  486. * Error handling
  487. *
  488.  9999 CONTINUE
  489.       IRET=1
  490.       WRITE(IOIMP,*) 'An error was detected in subroutine xlap1c'
  491.       RETURN
  492. *
  493. * End of subroutine XLAP1C
  494. *
  495.       END
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  

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