Télécharger la plaquette Cast3M


fr en

Télécharger ylap1e.eso

Retour à la liste

Numérotation des lignes : 

ylap1e

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

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