Télécharger la plaquette Cast3M


fr en

Télécharger ylap1c.eso

Retour à la liste

Numérotation des lignes : 

ylap1c

  1. C YLAP1C    SOURCE    CB215821  20/11/25    13:44:06     10792          
  2.       SUBROUTINE YLAP1C(ICOGRV,MPROC,MPVITC,
  3.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  4.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  5.      $     NOMINC,
  6.      $     MU,
  7.      $     IJACO,
  8.      $     IMPR,IRET)
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11. C***********************************************************************
  12. C NOM         : YLAP1C
  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       : YLAP1A : 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                      MU (type réel) : 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, 08/08/2001, version initiale
  75. C HISTORIQUE : v1, 08/08/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 SMCHPOI
  87.       POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL
  88.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  89. -INC SMCHAML
  90.       POINTEUR ICOGRV.MCHELM,JCOGRV.MCHAML
  91.       POINTEUR KDUNDX.MELVAL,KDUNDY.MELVAL
  92. -INC SMELEME
  93.       POINTEUR MELEFL.MELEME
  94.       POINTEUR MCOGRV.MELEME
  95. -INC SMLENTI
  96.       POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
  97.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  98. -INC SMLMOTS
  99.       POINTEUR NOMINC.MLMOTS
  101.       POINTEUR IJACO.MATRIK
  102. *
  103. * Objet matrice élémentaire simplifié
  104. *
  105.       SEGMENT GMATSI
  106.       INTEGER POIPR1(NPP1,NEL1)
  107.       INTEGER POIDU1(1,NEL1)
  108.       INTEGER POIPR2(NPP2,NEL2)
  109.       INTEGER POIDU2(2,NEL2)
  110.       POINTEUR LMATSI(0).MATSIM
  111.       ENDSEGMENT
  112. *  Contributions simples de la part du gradient de
  113. *  vitesse (CTSGRV)
  114.       POINTEUR CTSGRV.GMATSI
  115.       SEGMENT MATSIM
  116.       CHARACTER*8 NOMPRI,NOMDUA
  117.       REAL*8 VALMA1(1,NPP1,NEL1)
  118.       REAL*8 VALMA2(2,NPP2,NEL2)
  119.       ENDSEGMENT
  120.       POINTEUR ROURHO.MATSIM
  121.       POINTEUR ROVRHO.MATSIM
  122.       POINTEUR ROUROU.MATSIM
  123.       POINTEUR ROUROV.MATSIM
  124.       POINTEUR ROVROU.MATSIM
  125.       POINTEUR ROVROV.MATSIM
  126. *
  127.       REAL*8 MU
  128. *
  129.       INTEGER IMPR,IRET
  130. *
  131.       LOGICAL LCLIMV,LCLITO
  132.       LOGICAL LMUR
  133.       LOGICAL LCTRB1,LCTRB2
  134. *
  135.       INTEGER IELEM,IPD,IPP,ISOUCH,IEL1,IEL2
  136.       INTEGER NELEM,NPD,NPP,NSOUCH,NEL1,NEL2,NPP1,NPP2
  137.       INTEGER NGCDRO,NGCGAU,NGFACE,NPPRIM,NPDUAL
  138.       INTEGER NLCENP,NLCEND,NLFACE,NLCLTO,NLCLV
  139.       INTEGER NPTEL
  140. *
  141.       REAL*8 ALPHAX,ALPHAY,CNX,CNY
  142.       REAL*8 SIGNOR,SURFFA,VOLUEL
  143.       REAL*8 RHOP,UP,VP
  144.       REAL*8 FACTOR
  145.       REAL*8 DUDRHO,DUDROU,DVDRHO,DVDROV
  146.       REAL*8 BROUDU,BROUDV,BROVDU,BROVDV
  147. C
  148. *
  149. * Executable statements
  150. *
  151.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap1c.eso'
  152. *   On calcule les contributions à (d Res_{\rho u} / d var) et (d
  153. *   Res_{\rho v} / d var) ; var prenant successivement les valeurs :
  154. *      \rho,   \rho u,    \rho v,     \rho e_t
  155. *   Note :
  156. *     - (d Res_{\rho u} / d \rho e_t) = 0
  157. *     - (d Res_{\rho v} / d \rho e_t) = 0
  158. *   On dérive les termes : \tens{\tau} \prod \vect{n}
  159. *   Les noms de matrices élémentaires (type MATSIM) associées sont :
  160. *   ROURHO, ROUROU, ROUROV, ROVRHO, ROVROU, ROVROV
  161.       IF (LCLIMV) THEN
  162.          SEGACT KRVIMP
  163.       ENDIF
  164.       IF (LCLITO) THEN
  165.          SEGACT KRTOIM
  166.       ENDIF
  167.       SEGACT NOMINC
  168.       SEGACT KRCENT
  169.       SEGACT KRFACE
  170.       SEGACT MELEFL
  171.       SEGACT MPSURF
  172.       SEGACT MPNORM
  173.       SEGACT MPVOLU
  174.       SEGACT MPROC
  175.       SEGACT MPVITC
  176.       SEGACT ICOGRV
  177.       NSOUCH=ICOGRV.IMACHE(/1)
  178.       DO 1 ISOUCH=1,NSOUCH
  179.          MCOGRV=ICOGRV.IMACHE(ISOUCH)
  180.          JCOGRV=ICOGRV.ICHAML(ISOUCH)
  181.          SEGACT JCOGRV
  182.          KDUNDX=JCOGRV.IELVAL(1)
  183.          KDUNDY=JCOGRV.IELVAL(2)
  184.          SEGDES JCOGRV
  185.          SEGACT KDUNDX
  186.          SEGACT KDUNDY
  187.          SEGACT MCOGRV
  188.          NELEM=MCOGRV.NUM(/2)
  189.          NPTEL=MCOGRV.NUM(/1)
  190.          NPP1=NPTEL-1
  191.          NPP2=NPTEL-1
  192.          NEL1=NELEM
  193.          NEL2=NELEM
  194.          IEL1=1
  195.          IEL2=1
  196.          SEGINI ROURHO
  197.          SEGINI ROVRHO
  198.          SEGINI ROUROU
  199.          SEGINI ROVROU
  200.          SEGINI ROUROV
  201.          SEGINI ROVROV
  202.          SEGINI CTSGRV
  203.          ROURHO.NOMPRI(1:4)=NOMINC.MOTS(1)
  204.          ROURHO.NOMPRI(5:8)='    '
  205.          ROURHO.NOMDUA(1:4)=NOMINC.MOTS(2)
  206.          ROURHO.NOMDUA(5:8)='    '
  207.          ROVRHO.NOMPRI(1:4)=NOMINC.MOTS(1)
  208.          ROVRHO.NOMPRI(5:8)='    '
  209.          ROVRHO.NOMDUA(1:4)=NOMINC.MOTS(3)
  210.          ROVRHO.NOMDUA(5:8)='    '
  211.          ROUROU.NOMPRI(1:4)=NOMINC.MOTS(2)
  212.          ROUROU.NOMPRI(5:8)='    '
  213.          ROUROU.NOMDUA(1:4)=NOMINC.MOTS(2)
  214.          ROUROU.NOMDUA(5:8)='    '
  215.          ROVROU.NOMPRI(1:4)=NOMINC.MOTS(2)
  216.          ROVROU.NOMPRI(5:8)='    '
  217.          ROVROU.NOMDUA(1:4)=NOMINC.MOTS(3)
  218.          ROVROU.NOMDUA(5:8)='    '
  219.          ROUROV.NOMPRI(1:4)=NOMINC.MOTS(3)
  220.          ROUROV.NOMPRI(5:8)='    '
  221.          ROUROV.NOMDUA(1:4)=NOMINC.MOTS(2)
  222.          ROUROV.NOMDUA(5:8)='    '
  223.          ROVROV.NOMPRI(1:4)=NOMINC.MOTS(3)
  224.          ROVROV.NOMPRI(5:8)='    '
  225.          ROVROV.NOMDUA(1:4)=NOMINC.MOTS(3)
  226.          ROVROV.NOMDUA(5:8)='    '
  227.          DO 12 IELEM=1,NELEM
  228. *     Le premier point du support de ICOGRV est un point FACE
  229.             NGFACE=MCOGRV.NUM(1,IELEM)
  230.             NLFACE=KRFACE.LECT(NGFACE)
  231.             IF (NLFACE.EQ.0) THEN
  232.                WRITE(IOIMP,*) 'Erreur de programmation n°1'
  233.                GOTO 9999
  234.             ENDIF
  235. *     On calcule la contribution à la matrice jacobienne IJACO de la face
  236. *     NGFAC (points duaux     : centres à gauche et à droite de la face)
  237. *           (points primaux   : une partie (bicoz conditions aux limites)
  238. *            de ceux du stencil pour le calcul du gradient
  239. *            à la face, ils doivent être des points centres)
  240. *       Si le tenseur des contraintes sur la face est imposé par les
  241. *       conditions aux limites, la contribution de la face à IJACO est
  242. *       nulle.
  243.             LCTRB1=.TRUE.
  244.             IF (LCLITO) THEN
  245.                NLCLTO=KRTOIM.LECT(NGFACE)
  246.                IF (NLCLTO.NE.0) THEN
  247.                   LCTRB1=.FALSE.
  248.                ENDIF
  249.             ENDIF
  250.             IF (LCTRB1) THEN
  251.                NGCGAU=MELEFL.NUM(1,NLFACE)
  252.                NGCDRO=MELEFL.NUM(3,NLFACE)
  253.                LMUR=(NGCGAU.EQ.NGCDRO)
  254. *     On distingue le cas où la face est un bord du maillage (mur)
  255. *                  du cas où la face est interne au maillage
  256.                IF (.NOT.LMUR) THEN
  257.                   NPD=2
  258.                ELSE
  259.                   NPD=1
  260.                ENDIF
  261.                NPP=NPTEL-1
  262. *     IPD=1 : point à gauche du point NGFACE
  263. *     IPD=2 : point à droite du point NGFACE
  264.                DO 122 IPD=1,NPD
  265.                   NPDUAL=MELEFL.NUM((2*IPD)-1,NLFACE)
  266.                   IF (.NOT.LMUR) THEN
  267.                      CTSGRV.POIDU2(IPD,IEL2)=NPDUAL
  268.                   ELSE
  269.                      CTSGRV.POIDU1(IPD,IEL1)=NPDUAL
  270.                   ENDIF
  271.                   NLCEND=KRCENT.LECT(NPDUAL)
  272.                   IF (NLCEND.EQ.0) THEN
  273.                      WRITE(IOIMP,*) 'Erreur grave n°1'
  274.                      GOTO 9999
  275.                   ENDIF
  276.                   DO 124 IPP=1,NPP
  277.                      NPPRIM=MCOGRV.NUM(IPP+1,IELEM)
  278. C
  279. C* Modif AB: elimination du test condition limite
  280. C
  281.                      NLCENP=KRCENT.LECT(NPPRIM)
  282.                      IF(NLCENP .EQ. 0) THEN
  283. *     Lorsque une contribution est nulle, on fixe artificiellement le
  284. *     point primal égal au point dual.
  285.                         IF (.NOT.LMUR) THEN
  286.                            CTSGRV.POIPR2(IPP,IEL2)=NPDUAL
  287.                            ROURHO.VALMA2(IPD,IPP,IEL2)=0.D0
  288.                            ROVRHO.VALMA2(IPD,IPP,IEL2)=0.D0
  289.                            ROUROU.VALMA2(IPD,IPP,IEL2)=0.D0
  290.                            ROVROU.VALMA2(IPD,IPP,IEL2)=0.D0
  291.                            ROUROV.VALMA2(IPD,IPP,IEL2)=0.D0
  292.                            ROVROV.VALMA2(IPD,IPP,IEL2)=0.D0
  293.                         ELSE
  294.                            CTSGRV.POIPR1(IPP,IEL1)=NPDUAL
  295.                            ROURHO.VALMA1(IPD,IPP,IEL1)=0.D0
  296.                            ROVRHO.VALMA1(IPD,IPP,IEL1)=0.D0
  297.                            ROUROU.VALMA1(IPD,IPP,IEL1)=0.D0
  298.                            ROVROU.VALMA1(IPD,IPP,IEL1)=0.D0
  299.                            ROUROV.VALMA1(IPD,IPP,IEL1)=0.D0
  300.                            ROVROV.VALMA1(IPD,IPP,IEL1)=0.D0
  301.                         ENDIF
  302.                      ELSE
  303. *     Les contributions valent :
  304. * 1.  (d Res_{\rho u})_d / (d var)_p =
  305. *     +/-1 (normale sortante, rentrante)  (1/V_d) * (S_f) * \mu
  306. *     * [ [ ( 4/3 (n_x * \alpha_x) + (n_y * \alpha_y)) *
  307. *           ((du)_p / (d var)_p)]
  308. *       + [ (-2/3 (n_x * \alpha_y) + (n_y * \alpha_x)) *
  309. *           ((dv)_p / (d var)_p)]
  310. *       ]
  311. * 2.  (d Res_{\rho v})_d / (d var)_p =
  312. *     +/-1 (normale sortante, rentrante)  (1/V_d) * (S_f) * \mu
  313. *     * [ [ (-2/3 (n_y * \alpha_x) + (n_x * \alpha_y)) *
  314. *           ((du)_p / (d var)_p)]
  315. *       + [ ( 4/3 (n_y * \alpha_y) + (n_x * \alpha_x)) *
  316. *           ((dv)_p / (d var)_p)]
  317. *       ]
  318. *
  319. *     avec :
  320. *          (du)_p / (d \rho)_p   = - u / \rho_p
  321. *          (du)_p / (d \rho u)_p =   1 / \rho_p
  322. *          (du)_p / (d \rho v)_p =   0
  323. *          (dv)_p / (d \rho)_p   = - v / \rho_p
  324. *          (dv)_p / (d \rho u)_p =   0
  325. *          (dv)_p / (d \rho v)_p =   1 / \rho_p
  326. *
  327.                         IF (NLCENP.EQ.0) THEN
  328.                            WRITE(IOIMP,*) 'Erreur grave n°2'
  329.                            GOTO 9999
  330.                         ENDIF
  331. *       normale sortante pour IPD=1, rentrante pour IPD=2
  332.                         SIGNOR=(-1.D0)**(IPD+1)
  333.                         VOLUEL=MPVOLU.VPOCHA(NLCEND,1)
  334.                         SURFFA=MPSURF.VPOCHA(NLFACE,1)
  335.                         CNX   =MPNORM.VPOCHA(NLFACE,1)
  336.                         CNY   =MPNORM.VPOCHA(NLFACE,2)
  337.                         ALPHAX=KDUNDX.VELCHE(IPP+1,IELEM)
  338.                         ALPHAY=KDUNDY.VELCHE(IPP+1,IELEM)
  339.                         RHOP  =MPROC.VPOCHA(NLCENP,1)
  340.                         UP    =MPVITC.VPOCHA(NLCENP,1)
  341.                         VP    =MPVITC.VPOCHA(NLCENP,2)
  342.                         FACTOR=SIGNOR*(1.D0/VOLUEL)*SURFFA*MU
  343.                         BROUDU=(( 4.D0/3.D0)*(CNX*ALPHAX))
  344.      $                       + (CNY*ALPHAY)
  345.                         BROUDV=((-2.D0/3.D0)*(CNX*ALPHAY))
  346.      $                       + (CNY*ALPHAX)
  347.                         BROVDU=((-2.D0/3.D0)*(CNY*ALPHAX))
  348.      $                       + (CNX*ALPHAY)
  349.                         BROVDV=(( 4.D0/3.D0)*(CNY*ALPHAY))
  350.      $                       + (CNX*ALPHAX)
  351.                         DUDRHO=-UP /RHOP
  352.                         DUDROU=1.D0/RHOP
  353.                         DVDRHO=-VP /RHOP
  354.                         DVDROV=1.D0/RHOP
  355.                         IF (.NOT.LMUR) THEN
  356.                            CTSGRV.POIPR2(IPP,IEL2)=NPPRIM
  357.                            ROURHO.VALMA2(IPD,IPP,IEL2)=
  358.      $                          FACTOR*((BROUDU*DUDRHO)+(BROUDV*DVDRHO))
  359.                            ROVRHO.VALMA2(IPD,IPP,IEL2)=
  360.      $                          FACTOR*((BROVDU*DUDRHO)+(BROVDV*DVDRHO))
  361.                            ROUROU.VALMA2(IPD,IPP,IEL2)=
  362.      $                          FACTOR* (BROUDU*DUDROU)
  363.                            ROVROU.VALMA2(IPD,IPP,IEL2)=
  364.      $                          FACTOR* (BROVDU*DUDROU)
  365.                            ROUROV.VALMA2(IPD,IPP,IEL2)=
  366.      $                          FACTOR* (BROUDV*DVDROV)
  367.                            ROVROV.VALMA2(IPD,IPP,IEL2)=
  368.      $                          FACTOR* (BROVDV*DVDROV)
  369.                         ELSE
  370.                            CTSGRV.POIPR1(IPP,IEL1)=NPPRIM
  371.                            ROURHO.VALMA1(IPD,IPP,IEL1)=
  372.      $                          FACTOR*((BROUDU*DUDRHO)+(BROUDV*DVDRHO))
  373.                            ROVRHO.VALMA1(IPD,IPP,IEL1)=
  374.      $                          FACTOR*((BROVDU*DUDRHO)+(BROVDV*DVDRHO))
  375.                            ROUROU.VALMA1(IPD,IPP,IEL1)=
  376.      $                          FACTOR* (BROUDU*DUDROU)
  377.                            ROVROU.VALMA1(IPD,IPP,IEL1)=
  378.      $                          FACTOR* (BROVDU*DUDROU)
  379.                            ROUROV.VALMA1(IPD,IPP,IEL1)=
  380.      $                          FACTOR* (BROUDV*DVDROV)
  381.                            ROVROV.VALMA1(IPD,IPP,IEL1)=
  382.      $                          FACTOR* (BROVDV*DVDROV)
  383.                         ENDIF
  384.                      ENDIF
  385.  124              CONTINUE
  386.  122           CONTINUE
  387.                IF (.NOT.LMUR) THEN
  388.                   IEL2=IEL2+1
  389.                ELSE
  390.                   IEL1=IEL1+1
  391.                ENDIF
  392.             ENDIF
  393.  12      CONTINUE
  394.          NPP1=NPTEL-1
  395.          NPP2=NPTEL-1
  396.          NEL1=IEL1-1
  397.          NEL2=IEL2-1
  398.          SEGADJ ROURHO
  399.          SEGADJ ROVRHO
  400.          SEGADJ ROUROU
  401.          SEGADJ ROVROU
  402.          SEGADJ ROUROV
  403.          SEGADJ ROVROV
  404.          SEGADJ CTSGRV
  405.          CTSGRV.LMATSI(**)=ROURHO
  406.          CTSGRV.LMATSI(**)=ROVRHO
  407.          CTSGRV.LMATSI(**)=ROUROU
  408.          CTSGRV.LMATSI(**)=ROVROU
  409.          CTSGRV.LMATSI(**)=ROUROV
  410.          CTSGRV.LMATSI(**)=ROVROV
  411. * On accumule les matrices résultantes dans IJACO
  412.          CALL AJMTK(CTSGRV,IJACO,IMPR,IRET)
  413.          IF (IRET.NE.0) GOTO 9999
  414.          SEGSUP ROURHO
  415.          SEGSUP ROVRHO
  416.          SEGSUP ROUROU
  417.          SEGSUP ROVROU
  418.          SEGSUP ROUROV
  419.          SEGSUP ROVROV
  420.          SEGSUP CTSGRV
  421. *
  422.          SEGDES MCOGRV
  423.          SEGDES KDUNDY
  424.          SEGDES KDUNDX
  425.  1    CONTINUE
  426.       SEGDES ICOGRV
  427.       SEGDES MPVITC
  428.       SEGDES MPROC
  429.       SEGDES MPVOLU
  430.       SEGDES MPNORM
  431.       SEGDES MPSURF
  432.       SEGDES MELEFL
  433.       SEGDES KRFACE
  434.       SEGDES KRCENT
  435.       SEGDES NOMINC
  436.       IF (LCLITO) THEN
  437.          SEGDES KRTOIM
  438.       ENDIF
  439.       IF (LCLIMV) THEN
  440.          SEGDES KRVIMP
  441.       ENDIF
  442. *
  443. * Normal termination
  444. *
  445.       IRET=0
  446.       RETURN
  447. *
  448. * Format handling
  449. *
  450. *
  451. * Error handling
  452. *
  453.  9999 CONTINUE
  454.       IRET=1
  455.       WRITE(IOIMP,*) 'An error was detected in subroutine ylap1c'
  456.       RETURN
  457. *
  458. * End of subroutine YLAP1C
  459. *
  460.       END
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470.  
  471.  
  472.  
  473.  

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