Télécharger la plaquette Cast3M


fr en

Télécharger zlap2c.eso

Retour à la liste

Numérotation des lignes : 

zlap2c

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

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