Télécharger la plaquette Cast3M


fr en

Télécharger xlap2b.eso

Retour à la liste

Numérotation des lignes : 

xlap2b

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

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