Télécharger la plaquette Cast3M


fr en

Télécharger ylap11.eso

Retour à la liste

Numérotation des lignes : 

ylap11

  1. C YLAP11    SOURCE    OF166741  24/12/13    21:17:39     12097          
  2.       SUBROUTINE YLAP11()
  3. C************************************************************************
  4. C
  5. C PROJET            :  CASTEM 2000
  6. C
  7. C NOM               :  YLAPL11
  8. C
  9. C DESCRIPTION       :  Voir YLAPL1
  10. C
  11. C
  12. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  15. C
  16. C************************************************************************
  17. C
  18. C
  19. C APPELES (E/S)     :  LIRMOT, ERREUR
  20. C
  21. C
  22. C APPELES           :  YLAPL12
  23. C
  24. C************************************************************************
  25. C
  26. C*** ENTREE / SORTIE (voir Phrase d'appel GIBIANE)
  27. C
  28. C***********************************************************************
  29. C
  30. C HISTORIQUE (Anomalies et modifications éventuelles)
  31. C
  32. C HISTORIQUE : 11/02/2003 Ajout de l'option MIXT pour la température
  33. C
  34. C************************************************************************
  35. C
  36.       IMPLICIT INTEGER(I-N)
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  41. -INC SMCHPOI
  42. -INC SMLMOTS
  43.       POINTEUR MLMNOM.MLMOTS
  44.       POINTEUR MLDEFO.MLMOTS
  45. -INC SMCHAML
  46.       POINTEUR ICOGRV.MCHELM
  47.       POINTEUR ICOGRT.MCHELM
  48. C
  49. C**** Variables de SMLMOTS
  50. C
  51.       INTEGER  JGM, JGN
  52. C
  53. C**** Variables de SMMATRIK
  54. C
  55.       INTEGER   NKID, NKMT, NMATRI, NRIGE
  56. C
  57. C**** Variables du programme
  58. C
  59.       INTEGER ICELL, IRET, INDIC, NBCOMP
  60.      &      , IDOMA, MELEMC, MELEMF, MELEFL, ICHPSU, ICHPDI, ICHPVO
  61.      &      , INORM
  62.      &      , IRN, IVN, ITN, IGRVN, IGRTN
  63.      &      , IVNIMP, ITAUIM, ITIMP,IQIMP,IMIXT
  64.      &      , ILIINC, NC, INEFMD, ICOND
  65.      &      , IJACO, ICHFLU, ICHRES, NSOUPO,ICLAU
  66.       REAL*8 MU,KAPPA,CV,DELTAT
  67.       CHARACTER*(40) MESERR
  68.       CHARACTER*4 MOT,LFLUX(2), LIMPL(2)
  69.       CHARACTER*8 MOT2
  70.       CHARACTER*8 TYPE
  71.       LOGICAL LOGRES,LOGIMP,LOGAN
  72. C
  73.       DATA LFLUX/'FLUX','RESI'/
  74.       DATA LIMPL/'EXPL','IMPL'/
  75. C
  76. C**** Initialisation des variables pour la gestion des erreurs.
  77. C
  78.       MESERR  = '                                        '
  79.       LOGAN = .FALSE.
  80.       LOGRES=.FALSE.
  81. C
  82. C******* Flux ou residu?
  83. C
  84.       CALL LIRMOT(LFLUX,2,ICELL,1)
  85.       IF(IERR .NE. 0)GOTO 9999
  86.       IF(ICELL .EQ. 1)THEN
  87.          LOGRES = .FALSE.
  88.       ELSEIF(ICELL .EQ. 2)THEN
  89.          LOGRES = .TRUE.
  90.       ELSE
  91. C
  92. C******** Message d'erreur standard
  93. C         251 2
  94. C         Tentative d'utilisation d'une option non implémentée
  95. C
  96.          CALL ERREUR(251)
  97.       ENDIF
  98. C
  99. C
  100.       CALL LIRMOT(LIMPL,2,ICELL,1)
  101.       IF(IERR .NE. 0)GOTO 9999
  102.       IF(ICELL .EQ. 1)THEN
  103.          LOGIMP=.FALSE.
  104.       ELSEIF(ICELL .EQ. 2)THEN
  105.          LOGIMP=.TRUE.
  106.       ELSE
  107.          WRITE(IOIMP,*) 'Erreur de programmation'
  108.          CALL ERREUR(5)
  109.          GOTO 9999
  110.       ENDIF
  111.  
  112. C
  113. C**********************************
  114. C**** Lecture de l'objet MODELE ***
  115. C**********************************
  116. C
  117.       ICOND = 1
  118.       CALL QUETYP(TYPE,ICOND,IRET)
  119.  
  120.       IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  121.         WRITE(6,*)' On attend un objet MMODEL'
  122.         RETURN
  123.       ENDIF
  124.       CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  125.       IF(IERR.NE.0)GOTO 9999
  126.       CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  127.       IF(IERR.NE.0)GOTO 9999
  128. C
  129. C**** Centre, FACE et FACEL
  130. C
  131.       CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  132.       IF(IERR .NE. 0) GOTO 9999
  133. C
  134.       CALL LEKTAB(IDOMA,'FACE',MELEMF)
  135.       IF(IERR .NE. 0) GOTO 9999
  136. C
  137.       CALL LEKTAB(IDOMA,'FACEL',MELEFL)
  138.       IF(IERR .NE. 0) GOTO 9999
  139. C
  140. C**** Lecture du CHPOINT contenant les surfaces des faces.
  141. C
  142.       CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  143.       IF(IERR .NE. 0) GOTO 9999
  144. C
  145. C**** Lecture du CHPOINT contenant les diametres minimums.
  146. C
  147.       CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  148.       IF(IERR .NE. 0) GOTO 9999
  149. C
  150. C**** Lecture du CHPOINT contenant les volumes
  151. C
  152.       CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  153.       IF(IERR .NE. 0) GOTO 9999
  154. C
  155. C********** Les normales aux faces
  156. C
  157.       CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  158.       IF(IERR .NE. 0) GOTO 9999
  159. C
  160. C********************************
  161. C**** Fin table domaine *********
  162. C********************************
  163. C
  164. C**** Viscosité dynamique (kg/m/sec)
  165. C
  166.       CALL LIRREE(MU,1,IRET)
  167.       IF(IERR.NE.0)GOTO 9999
  168. C
  169. C**** Conductivité thermique (J/sec/m/K)
  170. C
  171.       CALL LIRREE(KAPPA,1,IRET)
  172.       IF(IERR.NE.0)GOTO 9999
  173. C
  174. C**** Chaleur specifique (J/kg/K)
  175. C
  176.       CALL LIRREE(CV,1,IRET)
  177.       IF(IERR.NE.0)GOTO 9999
  178. C
  179. C**** Densité
  180. C
  181.       TYPE = 'CHPOINT '
  182.       CALL LIROBJ(TYPE,IRN,1,IRET)
  183.       IF(IERR .NE. 0) GOTO 9999
  184.       INDIC = 1
  185.       NBCOMP = 1
  186.       MOT = 'SCAL'
  187.       CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  188. C
  189. C**** Vitesse
  190. C
  191.       TYPE='CHPOINT '
  192.       CALL LIROBJ(TYPE,IVN,1,IRET)
  193.       IF(IERR .NE. 0) GOTO 9999
  194.       JGN = 4
  195.       JGM = IDIM
  196.       SEGINI MLMNOM
  197.       MLMNOM.MOTS(1) = 'UX  '
  198.       MLMNOM.MOTS(2) = 'UY  '
  199.       IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'UZ  '
  200.       CALL QUEPO1(IVN, MELEMC, MLMNOM)
  201.       IF(IERR .NE. 0) GOTO 9999
  202.       SEGSUP MLMNOM
  203. C
  204. C**** Température
  205. C
  206.       TYPE='CHPOINT '
  207.       CALL LIROBJ(TYPE,ITN,1,IRET)
  208.       IF(IERR .NE. 0) GOTO 9999
  209.       JGN = 4
  210.       JGM = 1
  211.       SEGINI MLMNOM
  212.       MLMNOM.MOTS(1) = 'SCAL'
  213.       CALL QUEPO1(ITN, MELEMC, MLMNOM)
  214.       IF(IERR .NE. 0) GOTO 9999
  215.       SEGSUP MLMNOM
  216. C
  217. C**** Gradient de la vitesse
  218. C
  219.       TYPE='CHPOINT '
  220.       CALL LIROBJ(TYPE,IGRVN,1,IRET)
  221.       IF(IERR .NE. 0) GOTO 9999
  222.       JGN = 4
  223.       JGM =IDIM*IDIM
  224.       SEGINI MLMNOM
  225.       IF(IDIM.EQ.2)THEN
  226.          MLMNOM.MOTS(1) = 'P1DX'
  227.          MLMNOM.MOTS(2) = 'P1DY'
  228.          MLMNOM.MOTS(3) = 'P2DX'
  229.          MLMNOM.MOTS(4) = 'P2DY'
  230.       ELSE
  231.          MLMNOM.MOTS(1) = 'P1DX'
  232.          MLMNOM.MOTS(2) = 'P1DY'
  233.          MLMNOM.MOTS(3) = 'P1DZ'
  234.          MLMNOM.MOTS(4) = 'P2DX'
  235.          MLMNOM.MOTS(5) = 'P2DY'
  236.          MLMNOM.MOTS(6) = 'P2DZ'
  237.          MLMNOM.MOTS(7) = 'P3DX'
  238.          MLMNOM.MOTS(8) = 'P3DY'
  239.          MLMNOM.MOTS(9) = 'P3DZ'
  240.       ENDIF
  241.       CALL QUEPO1(IGRVN, MELEMF, MLMNOM)
  242.       IF(IERR .NE. 0) GOTO 9999
  243.       SEGSUP MLMNOM
  244. C
  245. C**** Gradient de la temperature
  246. C
  247.       TYPE='CHPOINT '
  248.       CALL LIROBJ(TYPE,IGRTN,1,IRET)
  249.       IF(IERR .NE. 0) GOTO 9999
  250.       JGN = 4
  251.       JGM=IDIM
  252.       SEGINI MLMNOM
  253.       MLMNOM.MOTS(1) = 'P1DX'
  254.       MLMNOM.MOTS(2) = 'P1DY'
  255.       IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'P1DZ  '
  256.       CALL QUEPO1(IGRTN, MELEMF, MLMNOM)
  257.       IF(IERR .NE. 0) GOTO 9999
  258.       SEGSUP MLMNOM
  259. C
  260. C
  261.       IF (LOGIMP) THEN
  262.          CALL LIROBJ('MCHAML  ',ICOGRV,1,IRET)
  263.          IF(IERR .NE. 0) GOTO 9999
  264.       ENDIF
  265. C
  266. C
  267.       IF (LOGIMP) THEN
  268.          CALL LIROBJ('MCHAML  ',ICOGRT,1,IRET)
  269.          IF(IERR .NE. 0) GOTO 9999
  270.       ENDIF
  271. C
  272. C
  273. C**** Conditions limites
  274. C
  275. C     Vitesse imposée à la paroi
  276. C
  277.       CALL LIRCHA(MOT,0,IRET)
  278.       IF(IRET .NE. 0)THEN
  279.          IF(MOT .EQ. 'VIMP')THEN
  280.             TYPE='CHPOINT '
  281.             CALL LIROBJ(TYPE,IVNIMP,1,IRET)
  282.             IF(IERR .NE. 0) GOTO 9999
  283.             MCHPOI = IVNIMP
  284.             SEGACT MCHPOI
  285.             NSOUPO = MCHPOI.IPCHP(/1)
  286.             SEGDES MCHPOI
  287.             IF(NSOUPO .GT. 0)THEN
  288.                JGN = 4
  289.                JGM = IDIM
  290.                SEGINI MLMNOM
  291.                MLMNOM.MOTS(1) = 'UX  '
  292.                MLMNOM.MOTS(2) = 'UY  '
  293.                IF(IDIM.EQ.3) MLMNOM.MOTS(3) = 'UZ  '
  294.                CALL QUEPO1(IVNIMP, 0, MLMNOM)
  295.                IF(IERR .NE. 0) GOTO 9999
  296.                SEGSUP MLMNOM
  297.             ELSE
  298.                IVNIMP=0
  299.             ENDIF
  300.          ELSE
  301.             IVNIMP=0
  302. C
  303. C********** Je m'excuse et je le remets dans la pile
  304. C
  305.             CALL REFUS
  306.          ENDIF
  307.       ELSE
  308.          IVNIMP=0
  309.       ENDIF
  310. C
  311. C     Tenseur des contraintes visqueux
  312. C
  313.       CALL LIRCHA(MOT,0,IRET)
  314.       IF(IRET .NE. 0)THEN
  315.          IF(MOT .EQ. 'TAUI')THEN
  316.             TYPE='CHPOINT '
  317.             CALL LIROBJ(TYPE,ITAUIM,1,IRET)
  318.             IF(IERR .NE. 0) GOTO 9999
  319.             MCHPOI = ITAUIM
  320.             SEGACT MCHPOI
  321.             NSOUPO = MCHPOI.IPCHP(/1)
  322.             SEGDES MCHPOI
  323.             IF(NSOUPO .GT. 0)THEN
  324.                JGN = 4
  325. C           2D only
  326.                JGM = 3*(IDIM-1)
  327.                SEGINI MLMNOM
  328.                IF(IDIM .EQ.2)THEN
  329.                   MLMNOM.MOTS(1) = 'TXX'
  330.                   MLMNOM.MOTS(2) = 'TYY'
  331.                   MLMNOM.MOTS(3) = 'TXY'
  332.                ELSE
  333.                   MLMNOM.MOTS(1) = 'TXX'
  334.                   MLMNOM.MOTS(2) = 'TYY'
  335.                   MLMNOM.MOTS(3) = 'TZZ'
  336.                   MLMNOM.MOTS(4) = 'TXY'
  337.                   MLMNOM.MOTS(5) = 'TXZ'
  338.                   MLMNOM.MOTS(6) = 'TYZ'
  339.                ENDIF
  340.                CALL QUEPO1(ITAUIM, 0, MLMNOM)
  341.                IF(IERR .NE. 0) GOTO 9999
  342.                SEGSUP MLMNOM
  343.             ELSE
  344.                ITAUIM=0
  345.             ENDIF
  346.          ELSE
  347.             ITAUIM=0
  348. C
  349. C********** Je m'excuse et je le remets dans la pile
  350. C
  351.             CALL REFUS
  352.          ENDIF
  353.       ELSE
  354.          ITAUIM=0
  355.       ENDIF
  356. C
  357. C     Flux thermique
  358. C
  359.       CALL LIRCHA(MOT,0,IRET)
  360.       IF(IRET .NE. 0)THEN
  361.          IF(MOT .EQ. 'QIMP')THEN
  362.             TYPE='CHPOINT '
  363.             CALL LIROBJ(TYPE,IQIMP,1,IRET)
  364.             IF(IERR .NE. 0) GOTO 9999
  365.             MCHPOI = IQIMP
  366.             SEGACT MCHPOI
  367.             NSOUPO = MCHPOI.IPCHP(/1)
  368.             SEGDES MCHPOI
  369.             IF(NSOUPO .GT.0)THEN
  370.                JGN = 4
  371.                JGM = IDIM
  372.                SEGINI MLMNOM
  373.                MLMNOM.MOTS(1) = 'UX  '
  374.                MLMNOM.MOTS(2) = 'UY  '
  375.                IF(IDIM .EQ. 3) MLMNOM.MOTS(3) = 'UZ  '
  376.                CALL QUEPO1(IQIMP, 0, MLMNOM)
  377.                IF(IERR .NE. 0) GOTO 9999
  378.                SEGSUP MLMNOM
  379.             ELSE
  380.                IQIMP=0
  381.             ENDIF
  382.          ELSE
  383.             IQIMP=0
  384. C
  385. C********** Je m'excuse et je le remets dans la pile
  386. C
  387.             CALL REFUS
  388.          ENDIF
  389.       ELSE
  390.          IQIMP=0
  391.       ENDIF
  392. C
  393. C      Conditions aux limites mixtes
  394. C
  395.       CALL LIRCHA(MOT,0,IRET)
  396.       IF(IRET .NE. 0)THEN
  397.          IF(MOT .EQ. 'MIXT')THEN
  398.             TYPE='CHPOINT '
  399.             CALL LIROBJ(TYPE,IMIXT,1,IRET)
  400.             IF(IERR .NE. 0) GOTO 9999
  401.             MCHPOI = IMIXT
  402.             SEGACT MCHPOI
  403.             NSOUPO = MCHPOI.IPCHP(/1)
  404.             SEGDES MCHPOI
  405.             IF(NSOUPO .GT.0)THEN
  406.             ELSE
  407.                IMIXT=0
  408.             ENDIF
  409.          ELSE
  410.             IMIXT=0
  411. C
  412. C********** Je m'excuse et je le remets dans la pile
  413. C
  414.             CALL REFUS
  415.          ENDIF
  416.       ELSE
  417.          IMIXT=0
  418.       ENDIF
  419. C
  420. C     Température imposée
  421. C
  422.       CALL LIRCHA(MOT,0,IRET)
  423.       IF(IRET .NE. 0)THEN
  424.          IF(MOT .EQ. 'TIMP')THEN
  425.             TYPE='CHPOINT '
  426.             CALL LIROBJ(TYPE,ITIMP,1,IRET)
  427.             IF(IERR .NE. 0) GOTO 9999
  428.             MCHPOI = ITIMP
  429.             SEGACT MCHPOI
  430.             NSOUPO = MCHPOI.IPCHP(/1)
  431.             SEGDES MCHPOI
  432.             IF(NSOUPO .GT.0)THEN
  433.                JGN = 4
  434.                JGM = 1
  435.                SEGINI MLMNOM
  436.                MLMNOM.MOTS(1) = 'SCAL'
  437.                CALL QUEPO1(ITIMP, 0, MLMNOM)
  438.                IF(IERR .NE. 0) GOTO 9999
  439.                SEGSUP MLMNOM
  440.             ELSE
  441.                ITIMP=0
  442.             ENDIF
  443.          ELSE
  444.             ITIMP=0
  445. C
  446. C********** Je m'excuse et je le remets dans la pile
  447. C
  448.             CALL REFUS
  449.          ENDIF
  450.       ELSE
  451.          ITIMP=0
  452.       ENDIF
  453. C
  454. C**** Les noms des inconnues
  455. C
  456.       TYPE='LISTMOTS'
  457.       CALL LIROBJ(TYPE,ILIINC,1,IRET)
  458.       IF(IERR .NE. 0) GOTO 9999
  459.       MLMOTS = ILIINC
  460.       SEGACT MLMOTS
  461.       NC = MLMOTS.MOTS(/2)
  462.       SEGDES MLMOTS
  463.       IF(NC .NE. (IDIM+2))THEN
  464.          MESERR='LMOT1 = ???                         '
  465.          WRITE(IOIMP,*) MESERR
  466. C
  467. C********** Message d'erreur standard
  468. C           21 2
  469. C           Données incompatibles
  470. C
  471.          CALL ERREUR(21)
  472.          GOTO 9999
  473.       ENDIF
  474. C
  475. C    OPTION POUR NE CALCULER QUE LA THERMIQUE
  476. C
  477.       IRET = 0
  478.       CALL LIRCHA(MOT2,0,IRET)
  479.       IF(IERR .NE. 0) GOTO 9999
  480.       IF(IRET .NE. 0)THEN
  481.          IF(MOT2 .EQ. 'CLAUDEIS')THEN
  482.             ICLAU = 1
  483.          ELSE
  484. C
  485. C******* Je la remets dans la pile
  486. C
  487.             CALL ECRCHA(MOT2)
  488.             ICLAU = 0
  489.          ENDIF
  490.       ELSE
  491.          ICLAU=0
  492.       ENDIF
  493.  
  494. C
  495. C Fin de la lecture des données
  496. C
  497. C
  498. C Test des données
  499. C
  500.       IF (.NOT.LOGIMP.AND.(ITIMP.NE.0)) THEN
  501. C**** La temperature imposéé à la paroi ne serve pas dans le
  502. C     cas de proprietés physiques constantes en explicite
  503.          MESERR='TIMP = ???                          '
  504.          WRITE(IOIMP,*) MESERR
  505. C********** Message d'erreur standard
  506. C           21 2
  507. C           Données incompatibles
  508. C
  509.          CALL ERREUR(21)
  510.          GOTO 9999
  511.       ENDIF
  512. C
  513. C Création de la matrice jacobienne du résidu du laplacien VF
  514. C
  515.       IF (LOGIMP) THEN
  516.          IF (IDIM.EQ.2) THEN
  517.             CALL YLAP1A(MU,KAPPA,CV,IRN,IVN,ITN,
  518.      $           IGRVN,ICOGRV,ICOGRT,
  519.      $           IVNIMP,ITAUIM,ITIMP,IQIMP,IMIXT,ICLAU,
  520.      $           MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS,
  521.      $           IJACO)
  522.           ELSEIF (IDIM.EQ.3) THEN
  523.             CALL YLAP2A(MU,KAPPA,CV,IRN,IVN,ITN,
  524.      $           IGRVN,ICOGRV,ICOGRT,
  525.      $           IVNIMP,ITAUIM,ITIMP,IQIMP,
  526.      $           MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPVO,MLMOTS,
  527.      $           IJACO)
  528.           ELSE
  529.              WRITE(IOIMP,*) 'IDIM=',IDIM,' ILLICITE.'
  530.              CALL ERREUR(5)
  531.              GOTO 9999
  532.           ENDIF
  533.        ELSE
  534. C
  535. C******* Objet MATRIK vide en explicite
  536. C
  537.          NRIGE=7
  538.          NMATRI=0
  539.          NKID =9
  540.          NKMT =7
  541.          SEGINI MATRIK
  542.          SEGDES MATRIK
  543.          IJACO = MATRIK
  544.        ENDIF
  545. C
  546. C**** Creation des flux aux interfaces
  547. C
  548.       JGN=4
  549.       JGM=IDIM+1
  550.       SEGINI MLDEFO
  551.       SEGACT MLMOTS
  552.       DO ICELL=1,JGM,1
  553.          MLDEFO.MOTS(ICELL)=MLMOTS.MOTS(ICELL+1)
  554.       ENDDO
  555.       SEGDES MLMOTS
  556.       TYPE = 'CHPOINT '
  557.       CALL KRCHP1(TYPE, MELEMF, ICHFLU, MLDEFO)
  558. C
  559. C**** Calcul des flux et du pas du temps.
  560. C
  561.       IF(IDIM.EQ.2)THEN
  562.          CALL YLAP12(MU,KAPPA,CV,IRN,IVN,IGRVN,IGRTN,
  563.      &        IVNIMP,ITAUIM,IQIMP,
  564.      &        MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT)
  565.       ELSE
  566.          CALL YLAP13(MU,KAPPA,CV,IRN,IVN,IGRVN,IGRTN,
  567.      &        IVNIMP,ITAUIM,IQIMP,
  568.      &        MELEMC,MELEMF,MELEFL,ICHPSU,INORM,ICHPDI,ICHFLU,DELTAT)
  569.       ENDIF
  570.       IF(IERR .NE. 0)GOTO 9999
  571. C
  572. C**** Calcul de residu (si LOGRES = .TRUE.)
  573. C
  574.       IF(LOGRES)THEN
  575.          TYPE = 'CHPOINT '
  576.          CALL KRCHP1(TYPE, MELEMC, ICHRES, MLDEFO)
  577.          IF(IERR.NE.0) GOTO 9999
  578. C
  579.          CALL KONRE1(MELEMC,MELEMF,MELEFL,ICHPVO,
  580.      &        ICHFLU, ICHRES,
  581.      &        LOGAN,MESERR)
  582.          IF(LOGAN)THEN
  583. C
  584. C******* Anomalie detectée
  585. C
  586. C
  587. C******* Message d'erreur standard
  588. C        -301 0
  589. C        %m1:40
  590. C
  591.             MOTERR(1:40) =  MESERR(1:40)
  592.             WRITE(IOIMP,*) MOTERR(1:40)
  593. C
  594. C******* Message d'erreur standard
  595. C        5 3
  596. C        Erreur anormale.contactez votre support
  597. C
  598.             CALL ERREUR(5)
  599.             GOTO 9999
  600.          ENDIF
  601.       ELSE
  602.          SEGSUP MLDEFO
  603.          ICHRES = 0
  604.       ENDIF
  605. C
  606. C**** Sortie
  607. C
  608.       CALL ECRREE(DELTAT)
  609.       TYPE = 'CHPOINT '
  610.       IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
  611.       IF(ICHFLU .NE. 0) CALL ECROBJ(TYPE,ICHFLU)
  612.       TYPE='MATRIK '
  613.       CALL ECROBJ(TYPE,IJACO)
  614. C
  615.  9999 RETURN
  616.       END
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  

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