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

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