Télécharger la plaquette Cast3M


fr en

Télécharger zlap1c.eso

Retour à la liste

Numérotation des lignes : 

zlap1c

  1. C ZLAP1C    SOURCE    CB215821  20/11/25    13:45:06     10792          
  2.       SUBROUTINE ZLAP1C(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         : ZLAP1C
  14. C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
  15. C               VF 2D (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       : ZLAP1A : Calcul de la matrice jacobienne du
  33. C                    résidu du laplacien VF 2D.
  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 2D.
  63. C SORTIES            : -
  64. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  65. C***********************************************************************
  66. C VERSION    : v1, 25/02/2002, version initiale
  67. C HISTORIQUE : v1, 25/02/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
  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,CNX,CNY
  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,XG,YG,XFMXG,YFMYG,DRG
  161.      &     ,XD,YD,XFMXD,YFMYD,DRD,ALPHA,UMALPH
  162. C
  163. *
  164. * Executable statements
  165. *
  166.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans zlap1c.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.             SEGDES JCOGRY
  209.             SEGACT KDYKDX
  210.             SEGACT KDYKDY
  211.             SEGACT MCOGRY
  212.             NELEM=MCOGRY.NUM(/2)
  213.             NPTEL=MCOGRY.NUM(/1)
  214.             NPP1=NPTEL-1
  215.             NPP2=NPTEL-1
  216.             NEL1=NELEM
  217.             NEL2=NELEM
  218.             IEL1=1
  219.             IEL2=1
  220.             SEGINI RETRHO
  221.             IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  222.                SEGINI RETRYK
  223.             ENDIF
  224.             SEGINI CTGRY
  225.             RETRHO.NOMPRI(1:4)=NOMINC.MOTS(1)
  226.             RETRHO.NOMPRI(5:8)='    '
  227.             RETRHO.NOMDUA(1:4)=NOMINC.MOTS(IDIM+2)
  228.             RETRHO.NOMDUA(5:8)='    '
  229.             IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  230.                RETRYK.NOMPRI(1:4)=NOMINC.MOTS(IDIM+2+IESP)
  231.                RETRYK.NOMPRI(5:8)='    '
  232.                RETRYK.NOMDUA(1:4)=NOMINC.MOTS(IDIM+2)
  233.                RETRYK.NOMDUA(5:8)='    '
  234.             ENDIF
  235.             DO 12 IELEM=1,NELEM
  236. *     Le premier point du support de ICOGRY est un point FACE
  237.                NGFACE=MCOGRY.NUM(1,IELEM)
  238.                NLFACE=KRFACE.LECT(NGFACE)
  239.                IF (NLFACE.EQ.0) THEN
  240.                   WRITE(IOIMP,*) 'Erreur de programmation n°1'
  241.                   GOTO 9999
  242.                ENDIF
  243. *     On calcule la contribution à la matrice jacobienne IJACO de la face
  244. *     NGFAC (points duaux     : centres à gauche et à droite de la face)
  245. *           (points primaux   : une partie (bicoz conditions aux limites)
  246. *            de ceux du stencil pour le calcul du gradient
  247. *            à la face, ils doivent être des points centres)
  248. *       Si le flux de chaleur sur la face est imposé par les conditions
  249. *       aux limites, la contribution de la face à IJACO est nulle.
  250.                NGCGAU=MELEFL.NUM(1,NLFACE)
  251.                NGCDRO=MELEFL.NUM(3,NLFACE)
  252.                NLCGAU=KRCENT.LECT(NGCGAU)
  253.                NLCDRO=KRCENT.LECT(NGCDRO)
  254.                LMUR=(NGCGAU.EQ.NGCDRO)
  255. *     On distingue le cas où la face est un bord du maillage (mur)
  256. *                  du cas où la face est interne au maillage
  257.                IF (.NOT.LMUR) THEN
  258.                   NPD=2
  259.                   ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
  260.                   XF = MCOORD.XCOOR(ICOORX)
  261.                   YF = MCOORD.XCOOR(ICOORX+1)
  262.                   ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
  263.                   XG = MCOORD.XCOOR(ICOORX)
  264.                   YG = MCOORD.XCOOR(ICOORX+1)
  265.                   XFMXG = XF - XG
  266.                   YFMYG = YF - YG
  267.                   DRG=SQRT((XFMXG*XFMXG)+(YFMYG*YFMYG))
  268.                   ICOORX = ((IDIM + 1) * (NGCDRO - 1))+1
  269.                   XD = MCOORD.XCOOR(ICOORX)
  270.                   YD = MCOORD.XCOOR(ICOORX+1)
  271.                   XFMXD = XF - XD
  272.                   YFMYD = YF - YD
  273.                   DRD=SQRT((XFMXD*XFMXD)+(YFMYD*YFMYD))
  274.                   ALPHA=DRG/(DRG+DRD)
  275.                   UMALPH= 1.0D0 - ALPHA
  276.                ELSE
  277.                   NPD=1
  278.                   ALPHA=0.0D0
  279.                   UMALPH=1.0D0
  280.                ENDIF
  281.                IF (LCLIMR) THEN
  282.                   NLFRI=KRRIMP.LECT(NGFACE)
  283.                ELSE
  284.                   NLFRI=0
  285.                ENDIF
  286.                IF (NLFRI.GT.0) THEN
  287.                   RHOF=MPRIMP.VPOCHA(NLFRI,1)
  288.                ELSE
  289.                   RHOG = MPROC.VPOCHA(NLCGAU,1)
  290.                   RHOD = MPROC.VPOCHA(NLCDRO,1)
  291.                   RHOF = UMALPH * RHOG + ALPHA * RHOD
  292.                ENDIF
  293.                IF (LCLIMT) THEN
  294.                   NLFTI=KRTIMP.LECT(NGFACE)
  295.                ELSE
  296.                   NLFTI=0
  297.                ENDIF
  298.                IF (NLFTI.GT.0) THEN
  299.                   TEMF=MPTIMP.VPOCHA(NLFTI,1)
  300.                ELSE
  301.                   TEMG = MPTEMC.VPOCHA(NLCGAU,1)
  302.                   TEMD = MPTEMC.VPOCHA(NLCDRO,1)
  303.                   TEMF = UMALPH * TEMG + ALPHA * TEMD
  304.                ENDIF
  305.                DKG  = MPDKC.VPOCHA(NLCGAU,1)
  306.                DKD  = MPDKC.VPOCHA(NLCDRO,1)
  307.                DKF  = UMALPH * DKG + ALPHA * DKD
  308.                DNG  = MPDNC.VPOCHA(NLCGAU,1)
  309.                DND  = MPDNC.VPOCHA(NLCDRO,1)
  310.                DNF  = UMALPH * DNG + ALPHA * DND
  311.                NPP=NPTEL-1
  312. *     IPD=1 : point à gauche du point NGFACE
  313. *     IPD=2 : point à droite du point NGFACE
  314.                DO 122 IPD=1,NPD
  315.                   NPDUAL=MELEFL.NUM((2*IPD)-1,NLFACE)
  316.                   IF (.NOT.LMUR) THEN
  317.                      CTGRY.POIDU2(IPD,IEL2)=NPDUAL
  318.                   ELSE
  319.                      CTGRY.POIDU1(IPD,IEL1)=NPDUAL
  320.                   ENDIF
  321.                   NLCEND=KRCENT.LECT(NPDUAL)
  322.                   IF (NLCEND.EQ.0) THEN
  323.                      WRITE(IOIMP,*) 'Erreur grave n°1'
  324.                      GOTO 9999
  325.                   ENDIF
  326.                   DO 124 IPP=1,NPP
  327.                      NPPRIM=MCOGRY.NUM(IPP+1,IELEM)
  328.                      LCTRB2=.TRUE.
  329.                      IF (LCLIMY) THEN
  330.                         NLCLY=KRYIMP.LECT(NPPRIM)
  331.                         IF (NLCLY.NE.0) THEN
  332.                            LCTRB2=.FALSE.
  333.                         ENDIF
  334.                      ENDIF
  335.                      IF (.NOT.LCTRB2) THEN
  336. *     Lorsque une contribution est nulle, on fixe artificiellement le
  337. *     point primal égal au point dual.
  338.                         IF (.NOT.LMUR) THEN
  339.                            CTGRY.POIPR2(IPP,IEL2)=NPDUAL
  340.                            RETRHO.VALMA2(IPD,IPP,IEL2)=0.D0
  341.                            IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  342.                               RETRYK.VALMA2(IPD,IPP,IEL2)=0.D0
  343.                            ENDIF
  344.                         ELSE
  345.                            CTGRY.POIPR1(IPP,IEL1)=NPDUAL
  346.                            RETRHO.VALMA1(IPD,IPP,IEL1)=0.D0
  347.                            IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  348.                               RETRYK.VALMA1(IPD,IPP,IEL1)=0.D0
  349.                            ENDIF
  350.                         ENDIF
  351.                      ELSE
  352. *     Les contributions valent :
  353. *     (d Res_{\rho Yk})_d / (d var)_p =
  354. *     +/-1 (normale sortante, rentrante) (1/V_d) * (S_f) * \rho_f * Dk_f
  355. *     * [ ((n_x * \beta_x) +(n_y * \beta_y)) *
  356. *         ((dYk)_p / (d var)_p)]
  357. *     avec :
  358. *          (dYk)_p / (d \rho)_p = - Yk_p / \rho_p
  359. *          (dYk)_p / (d \rho Yk)_p =   1 / \rho_p
  360. *     \beta_x : coefficients pour le calcul de dYk/dx
  361. *     \beta_y : coefficients pour le calcul de dYk/dy
  362. *
  363.                         NLCENP=KRCENT.LECT(NPPRIM)
  364.                         IF (NLCENP.EQ.0) THEN
  365.                            WRITE(IOIMP,*) 'Erreur grave n°2'
  366.                            GOTO 9999
  367.                         ENDIF
  368. *       normale sortante pour IPD=1, rentrante pour IPD=2
  369.                         SIGNOR=(-1.D0)**(IPD+1)
  370.                         VOLUEL=MPVOLU.VPOCHA(NLCEND,1)
  371.                         SURFFA=MPSURF.VPOCHA(NLFACE,1)
  372.                         CNX   =MPNORM.VPOCHA(NLFACE,1)
  373.                         CNY   =MPNORM.VPOCHA(NLFACE,2)
  374.                         BETAX =KDYKDX.VELCHE(IPP+1,IELEM)
  375.                         BETAY =KDYKDY.VELCHE(IPP+1,IELEM)
  376.                         RHOP  =MPROC.VPOCHA(NLCENP,1)
  377.                         YKP   =MPYKC.VPOCHA(NLCENP,1)
  378. *                        YKP   =MPYKC.VPOCHA(NLCEND,1)
  379.                         CPK=PROPHY.CV(IESP)+PROPHY.R(IESP)
  380.                         CPN=PROPHY.CV(NESP+1)+PROPHY.R(NESP+1)
  381.                         HKF=(CPK*TEMF)+PROPHY.H0K(IESP)
  382.                         HNF=(CPN*TEMF)+PROPHY.H0K(NESP+1)
  383.                         FACTOR=SIGNOR*(1.D0/VOLUEL)*SURFFA*RHOF*
  384.      $                       ((HKF*DKF)-(HNF*DNF))
  385.      $                       *((CNX*BETAX)+(CNY*BETAY))
  386.                         DYKDRO=-YKP/RHOP
  387.                         DYKDRY=1.D0/RHOP
  388. C                        IF((NGCGAU.EQ.30).AND.(NGCDRO.EQ.30)) THEN
  389. C                           WRITE(IOIMP,*) 'NGFACE=',NGFACE
  390. C                           WRITE(IOIMP,*) 'NGCGAU=',NGCGAU
  391. C                           WRITE(IOIMP,*) 'NGCDRO=',NGCDRO
  392. C                           WRITE(IOIMP,*) 'IESP=',IESP
  393. C                           WRITE(IOIMP,*) 'JACO(RETRYK)=',
  394. C     $                          (FACTOR*DYKDRY)
  395. C                        ENDIF
  396.                        IF (.NOT.LMUR) THEN
  397.                            CTGRY.POIPR2(IPP,IEL2)=NPPRIM
  398.                            RETRHO.VALMA2(IPD,IPP,IEL2)=FACTOR*DYKDRO
  399.                            IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  400.                               RETRYK.VALMA2(IPD,IPP,IEL2)=FACTOR*DYKDRY
  401.                            ENDIF
  402.                         ELSE
  403.                            CTGRY.POIPR1(IPP,IEL1)=NPPRIM
  404.                            RETRHO.VALMA1(IPD,IPP,IEL1)=FACTOR*DYKDRO
  405.                            IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  406.                               RETRYK.VALMA1(IPD,IPP,IEL1)=FACTOR*DYKDRY
  407.                            ENDIF
  408.                         ENDIF
  409.                      ENDIF
  410.  124              CONTINUE
  411.  122           CONTINUE
  412.                IF (.NOT.LMUR) THEN
  413.                   IEL2=IEL2+1
  414.                ELSE
  415.                   IEL1=IEL1+1
  416.                ENDIF
  417.  12         CONTINUE
  418.             NPP1=NPTEL-1
  419.             NPP2=NPTEL-1
  420.             NEL1=IEL1-1
  421.             NEL2=IEL2-1
  422.             SEGADJ RETRHO
  423.             IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  424.                SEGADJ RETRYK
  425.             ENDIF
  426.             SEGADJ CTGRY
  427.             CTGRY.LMATSI(**)=RETRHO
  428.             IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  429.                CTGRY.LMATSI(**)=RETRYK
  430.             ENDIF
  431. * On accumule les matrices résultantes dans IJACO
  432.             CALL AJMTK(CTGRY,IJACO,IMPR,IRET)
  433.             IF (IRET.NE.0) GOTO 9999
  434.             SEGSUP RETRHO
  435.             IF ((IESP.GE.1).AND.(IESP.LE.NESP)) THEN
  436.                SEGSUP RETRYK
  437.             ENDIF
  438.             SEGSUP CTGRY
  439. *
  440.             SEGDES MCOGRY
  441.             SEGDES KDYKDY
  442.             SEGDES KDYKDX
  443.  1       CONTINUE
  444.          SEGDES ICOGRY
  445.          SEGDES MPYKC
  446.          SEGDES MPTEMC
  447.          SEGDES MPROC
  448.          SEGDES MPDKC
  449.          SEGDES MPVOLU
  450.          SEGDES MPNORM
  451.          SEGDES MPSURF
  452.          SEGDES MELEFL
  453.          SEGDES KRFACE
  454.          SEGDES KRCENT
  455.          SEGDES NOMINC
  456.          IF (LCLIMY) THEN
  457.             SEGDES KRYIMP
  458.          ENDIF
  459.          IF (LCLIMT) THEN
  460.             SEGDES KRTIMP
  461.             SEGDES MPTIMP
  462.          ENDIF
  463.          IF (LCLIMR) THEN
  464.             SEGDES KRRIMP
  465.             SEGDES MPRIMP
  466.          ENDIF
  467.       ENDDO
  468.       SEGDES MPDNC
  469.       SEGDES PROPH2
  470.       SEGDES PROPHY
  471. *
  472. * Normal termination
  473. *
  474.       IRET=0
  475.       RETURN
  476. *
  477. * Format handling
  478. *
  479. *
  480. * Error handling
  481. *
  482.  9999 CONTINUE
  483.       IRET=1
  484.       WRITE(IOIMP,*) 'An error was detected in subroutine zlap1c'
  485.       RETURN
  486. *
  487. * End of subroutine ZLAP1C
  488. *
  489.       END
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  

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