Télécharger la plaquette Cast3M


fr en

Télécharger konja5.eso

Retour à la liste

Numérotation des lignes : 

konja5

  1. C KONJA5    SOURCE    OF166741  24/12/13    21:16:32     12097          
  2.       SUBROUTINE KONJA5(IIMPL,ILINC,IROF,IPF,IVITF,IGAMF,
  3.      &     IRN,IPN,IVN,IGAMN,
  4.      $     ICHPVO,ICHPSU, ICHPNO, MELEMC, MELEFE, MELEMF, MELTFA,
  5.      &     IGRN, IGVN, IGPN,IGLRN, IGLVN, IGLPN,
  6.      &     ICRN, ICVN, ICPN, IVLIM,MELLIM,IMAT)
  7. C
  8. C************************************************************************
  9. C
  10. C PROJET            :  CASTEM 2000
  11. C
  12. C NOM               :  KONJA5
  13. C
  14. C DESCRIPTION       :  Voir KONV11
  15. C                      Calcul du jacobien du résidu "2nd order accurate"
  16. C
  17. C                      Cas deux dimensions, gaz "calorically perfect"
  18. C
  19. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  20. C
  21. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  22. C
  23. C************************************************************************
  24. C
  25. C APPELES (Outils
  26. C          CASTEM)  :  KRIPAD, LICHT, ERREUR
  27. C
  28. C APPELES (Calcul)  :  VLHJ3, AUSMW, VLHJ1, AUSMF
  29. C
  30. C************************************************************************
  31. C
  32. C ENTREES
  33. C
  34. C     IIMPL  : INTEGER
  35. C              = 4 -> methode VLH
  36. C              = 5 -> methode AUSM+
  37. C
  38. C     ILINC  : liste des inconnues (pointeur d'un objet de type
  39. C              LISTMOTS)
  40. C
  41. C  1) Pointeurs des CHPOINT/CHAMELEM
  42. C
  43. C     IROF    : MCHAML  'FACEL' densité
  44. C
  45. C     IPF     : MCHAML  'FACEL' pression
  46. C
  47. C     IVITF   : MCHAML  'FACEL' vitesse/normales
  48. C
  49. C     IGAMF   : MCHAML  'FACEL' gamma
  50. C
  51. C     IRN     : CHPOINT 'CENTRE' densité
  52. C
  53. C     IPN     : CHPOINT 'CENTRE' pression
  54. C
  55. C     IVN     : CHPOINT 'CENTRE' vitesse
  56. C
  57. C     IGAMN   : CHPOINT 'CENTRE' gamma
  58. C
  59. C     ICHPVO  : CHPOINT VOLUME  contenant le volume
  60. C
  61. C     ICHPSU  : CHPOINT FACE  contenant la surface des faces
  62. C
  63. C     ICHPNO  : CHPOINT 'FACE' contenant les normales aux faces
  64. C
  65. C     IGRN    : CHPOINT 'CENTRE' gradient de densité
  66. C
  67. C     IGVN    : CHPOINT 'CENTRE' gradient de vitesse
  68. C
  69. C     IGPN    : CHPOINT 'CENTRE' gradient de pression
  70. C
  71. C     IGLRN   : CHPOINT 'CENTRE' limiteur du gradient de densité
  72. C
  73. C     IGLVN   : CHPOINT 'CENTRE' limiteur du gradient de vitesse
  74. C
  75. C     IGLPN   : CHPOINT 'CENTRE' limiteur du gradient de pression
  76. C
  77. C     ICRN    : MCHAML contenant les coeff. pour calculer le gradient
  78. C               de densité
  79. C
  80. C     ICVN    : MCHAML contenant les coeff. pour calculer le gradient
  81. C               de vitesse
  82. C
  83. C     ICPN    : MCHAML contenant les coeff. pour calculer le gradient
  84. C               de pression
  85. C
  86. C     IVLIM   : CHPOINT des conditions aux limites sur la vitesse
  87. C
  88. C  2) Pointeurs de MELEME de la table DOMAINE
  89. C
  90. C     MELEMC  : MELEME 'CENTRE', SPG des CENTRES des elts
  91. C
  92. C     MELEFE  : MELEME 'FACEL' (centre elt gauche, centre de face
  93. C                               centre elt droite)
  94. C
  95. C     MELEMF  : MELEME 'FACE',  SPG des CENTRES des faces
  96. C
  97. C     MELTFA  : MELEME 'ELTFA' (centre d'elt, centres de faces)
  98. C
  99. C     MELLIM  : MELEME SPG des conditions aux bords
  100. C
  101. C SORTIES
  102. C
  103. C     IMAT    : pointeur de la MATRIK du jacobien du residu
  104. C
  105. C************************************************************************
  106. C
  107. C HISTORIQUE (Anomalies et modifications éventuelles)
  108. C
  109. C HISTORIQUE :
  110. C
  111. C************************************************************************
  112. C
  113. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  114. C                                         GAMMA \in (1,3)
  115. C       Si non il faut le faire!!!
  116. C
  117. C************************************************************************
  118. C
  119.       IMPLICIT INTEGER(I-N)
  120.       INTEGER IIMPL,ILINC, ICHPVO, ICHPNO, ICHPSU
  121.      &       ,IROF,IVITF,IPF,IGAMF, IRN,IPN,IVN,IGAMN
  122.      &       , IGRN, IGVN, IGPN,IGLRN, IGLVN, IGLPN
  123.      &       , ICRN, ICVN, ICPN, IVLIM , IMAT
  124.      &       , NBSOUP, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  125.      &       , NKMT, NBME, NBEL,  MP, NP, NP1
  126.      &       , IFAC, NGCF, NLCF, NGCF1,  NGCG, NGCD
  127.      &       , NGC, NLC, NLCD,  NGNO, NGN1,NGN2, NLNO, IELEM, IELPRI
  128.      &       , JG, NBSOUS,  NBSOU1, ISOUS, NBEL1
  129.      &       , ISPG1, ISPG2
  130.      &       , I1, IGEOMC, IGEOMF, IGEOML
  131.      &       , IFACGR, NGGRA, NLGRA, NGFGR, NLFGR, NG, ND, ICOOR, IFAC2
  132.      &       , NLVIMP
  133.      &       , NGPRI,NLPRI,IELETR,IDUATR,IPRITR, NLFL
  134.       REAL*8 ROG, PG, UNG, UTG, UXG, UYG, RETG, GAMG, VOLG, VOLD
  135.      &       , ROD, PD, UND, UTD, UXD, UYD
  136.      &       , SURF, CNX, CNY, CTX, CTY, ECIN, FUNCEL
  137.      &       , DFRO(4), DFRET(4), DFRUN(4), DFRUT(4),DFRUX(4),DFRUY(4)
  138.      &       , ALR, ALP, ALVX, ALVY, XCG, YCG, DXCF, DYCF, CELLR, CELLP
  139.      &       , CVXVX, CVXVY, CVYVX, CVYVY, CNX1, CNY1, CTX1, CTY1
  140.      &       , DDP, DDRO, DDUX, DDUY
  141.      &       , GAMGM1, CELCO1, CELCO2, CELCO3, CELCO4, CELCO5
  142.  
  143.       CHARACTER*8 TYPE
  144. C
  145. C**** LES INCLUDES
  146. C
  147. -INC SMCOORD
  148.  
  149. -INC PPARAM
  150. -INC CCOPTIO
  151. -INC SMCHAML
  152.       POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  153.      &         MELT1X.MELVAL, MELT1Y.MELVAL
  154.       POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  155.       POINTEUR MELRO.MELVAL, MELP.MELVAL,
  156.      &         MELGAM.MELVAL
  157.       POINTEUR MELCR1.MELVAL, MELCR2.MELVAL, MELCP1.MELVAL,
  158.      &     MELCP2.MELVAL, MELCV1.MELVAL, MELCV2.MELVAL
  159. C
  160. -INC SMCHPOI
  161. -INC SMELEME
  162. -INC SMLMOTS
  163. -INC SMLENTI
  165.       POINTEUR MPVOLU.MPOVAL, MPNORM.MPOVAL, MPOVSU.MPOVAL,
  166.      $  MPVGRN.MPOVAL,MPGLRN.MPOVAL, MPVGPN.MPOVAL, MPGLPN.MPOVAL,
  167.      $  MPVGVN.MPOVAL,MPGLVN.MPOVAL, MPVLIM.MPOVAL,MPOVRN.MPOVAL,MPOVVN
  168.      $     .MPOVAL,MPOVPN.MPOVAL,MPOGAM.MPOVAL
  169.       POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  170.      &     MELTFA.MELEME,MELPRI.MELEME,MELGRR.MELEME,MELGRP.MELEME
  171.      $     ,MELGRV.MELEME, MELLIM.MELEME
  172.       POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLESPG.MLENTI,MLEPRI.MLENTI
  173.      &     ,MLEVL.MLENTI,MLEGRR.MLENTI,MLEGRP.MLENTI,MLEGRV.MLENTI
  174.      &     ,MLELIM.MLENTI
  175.       POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  176.      &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  177.      &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  178.      &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  179.       POINTEUR MLMINC.MLMOTS
  180. C
  181. C**** KRIPAD pour la correspondance global/local des conditions limits
  182. C
  183.       CALL KRIPAD(MELLIM,MLELIM)
  184. C     SEGACT MELLIM
  185. C
  186. C**** Masse volumique
  187. C
  188.       MCHEL1 = IROF
  189.       SEGACT MCHEL1
  190.       MCHAM1 = MCHEL1.ICHAML(1)
  191.       SEGACT MCHAM1
  192.       MELRO = MCHAM1.IELVAL(1)
  193.       SEGDES MCHEL1
  194.       SEGDES MCHAM1
  195. C
  196. C**** Pression
  197. C
  198.       MCHEL1 = IPF
  199.       SEGACT MCHEL1
  200.       MCHAM1 = MCHEL1.ICHAML(1)
  201.       SEGACT MCHAM1
  202.       MELP = MCHAM1.IELVAL(1)
  203.       SEGDES MCHEL1
  204.       SEGDES MCHAM1
  205. C
  206. C**** Gamma
  207. C
  208.       MCHEL1 = IGAMF
  209.       SEGACT MCHEL1
  210.       MCHAM1 = MCHEL1.ICHAML(1)
  211.       SEGACT MCHAM1
  212.       MELGAM = MCHAM1.IELVAL(1)
  213.       SEGDES MCHEL1
  214.       SEGDES MCHAM1
  215. C
  216. C**** Vitesse et cosinus directeurs du repere (n,t)
  217. C
  218.       MCHEL1 = IVITF
  219.       SEGACT MCHEL1
  220. C
  221. C**** La vitesse a comme SPG MELEFE
  222. C     Le cosinus directeurs ont comme SPG MELEMF
  223. C
  224. C     MCHAM1 -> Cosinus directeurs
  225. C     MCHAM2 -> Vitesse
  226. C
  227.       ISPG1 = MCHEL1.IMACHE(1)
  228.       ISPG2 = MCHEL1.IMACHE(2)
  229.       IF((ISPG1 .EQ. MELEMF)  .AND. (ISPG2 .EQ. MELEFE))THEN
  230.          MCHAM1 = MCHEL1.ICHAML(1)
  231.          MCHAM2 = MCHEL1.ICHAML(2)
  232.       ELSEIF((ISPG1 .EQ. MELEFE)  .AND. (ISPG2 .EQ. MELEMF))THEN
  233.          MCHAM1 = MCHEL1.ICHAML(2)
  234.          MCHAM2 = MCHEL1.ICHAML(1)
  235.       ELSE
  236.          WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  237.          CALL ERREUR(5)
  238.          GOTO 9999
  239.       ENDIF
  240.       SEGACT MCHAM1
  241.       MELVNX = MCHAM1.IELVAL(1)
  242.       MELVNY = MCHAM1.IELVAL(2)
  243.       MELT1X = MCHAM1.IELVAL(3)
  244.       MELT1Y = MCHAM1.IELVAL(4)
  245.       SEGDES MCHAM1
  246.       SEGACT MCHAM2
  247.       MELVUN = MCHAM2.IELVAL(1)
  248.       MELVUT = MCHAM2.IELVAL(2)
  249.       SEGDES MCHAM2
  250.       SEGDES MCHEL1
  251. C
  252. C**** Activation des MCHAMLs
  253. C
  254.       SEGACT MELRO
  255.       SEGACT MELP
  256.       SEGACT MELGAM
  257.       SEGACT MELVUN
  258.       SEGACT MELVUT
  259.       SEGACT MELVNX
  260.       SEGACT MELVNY
  261.       SEGACT MELT1X
  262.       SEGACT MELT1Y
  263. C
  264. C**************** CHPOINT gradients, limiteurs, vitesse aux bords
  265. C
  266.       CALL LICHT(IRN,MPOVRN,TYPE,IGEOMC)
  267.       IF(IERR.NE.0)GOTO 9999
  268. C     SEGACT MPOVRN
  269.       CALL LICHT(IVN,MPOVVN,TYPE,IGEOMC)
  270.       IF(IERR.NE.0)GOTO 9999
  271. C     SEGACT MPOVVN
  272.       CALL LICHT(IPN,MPOVPN,TYPE,IGEOMC)
  273.       IF(IERR.NE.0)GOTO 9999
  274. C     SEGACT MPOVPN
  275.       CALL LICHT(IGAMN,MPOGAM,TYPE,IGEOMC)
  276.       IF(IERR.NE.0)GOTO 9999
  277. C     SEGACT MPOGAM
  278.       CALL LICHT(IGRN,MPVGRN,TYPE,IGEOMC)
  279.       IF(IERR.NE.0)GOTO 9999
  280. C     SEGACT MPVGRN
  281.       CALL LICHT(IGLRN,MPGLRN,TYPE,IGEOMC)
  282.       IF(IERR.NE.0)GOTO 9999
  283. C     SEGACT MPGLRN
  284.       CALL LICHT(IGPN,MPVGPN,TYPE,IGEOMC)
  285.       IF(IERR.NE.0)GOTO 9999
  286. C     SEGACT MPVGPN
  287.       CALL LICHT(IGLPN,MPGLPN,TYPE,IGEOMC)
  288.       IF(IERR.NE.0)GOTO 9999
  289. C     SEGACT MPGLPN
  290.       CALL LICHT(IGVN,MPVGVN,TYPE,IGEOMC)
  291.       IF(IERR.NE.0)GOTO 9999
  292. C     SEGACT MPVGPN
  293.       CALL LICHT(IGLVN,MPGLVN,TYPE,IGEOMC)
  294.       IF(IERR.NE.0)GOTO 9999
  295. C     SEGACT MPGLVN
  296.       CALL LICHT(IVLIM,MPVLIM,TYPE,IGEOML)
  297.       IF(IERR.NE.0)GOTO 9999
  298. C     SEGACT MPVLIM
  299. C
  300. C**************** KRIPAD pour la correspondance global/local des centres d'elts
  301. C
  302.       CALL KRIPAD(MELEMC,MLENTC)
  303.       IF(IERR.NE.0)GOTO 9999
  304. C
  305. C     SEGACT MLENTC
  306.       SEGACT MELEMC
  307. C
  308. C**** KRIPAD pour la correspondance global/local des centres des faces
  309. C
  310.       CALL KRIPAD(MELEMF,MLENTF)
  311.       IF(IERR.NE.0)GOTO 9999
  312. C
  313. C     SEGACT MLENTF
  314. C
  315. C**** KRIPAD pour la correspondance global/local des B.C. sur le vitesse
  316. C
  317.       CALL KRIPAD(IGEOML,MLEVL)
  318.       IF(IERR.NE.0)GOTO 9999
  319. C
  320. C     SEGACT MLEVL
  321. C
  322.       SEGACT MELEFE
  323. C
  324.       CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  325.       IF(IERR.NE.0)GOTO 9999
  326.       CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  327.       IF(IERR.NE.0)GOTO 9999
  328.       CALL LICHT(ICHPNO,MPNORM,TYPE,IGEOMC)
  329.       IF(IERR.NE.0)GOTO 9999
  330. C
  331. C**** LICHT active les MPOVALs en *MOD
  332. C
  333. C     i.e.
  334. C
  335. C     SEGACT MPOVSU*MOD
  336. C     SEGACT MPVOLU*MOD
  337. C     SEGACT MPNORM*MOD
  338. C
  339. C
  340. C**** Les gradients ont tous le meme SPG (mais le numero
  341. C     du pointeur peut-etre different).
  342. C     Ils ont le meme nombre des SPGs que MELTFA
  343. C     En plus le SPGs ont le meme ordre:
  344. C     le iem elt de MELTFA correspond a l'elt qui a
  345. C     comme centre le iem noeud de CENTRE
  346. C
  347.       SEGACT MELTFA
  348.       NBSOUP=MELTFA.LISOUS(/1)
  349.       IF(NBSOUP.EQ.0) NBSOUP=1
  350.       JG=NBSOUP
  351.       SEGINI MLESPG
  352.       IF(NBSOUP .EQ. 1)THEN
  353.          MLESPG.LECT(1)=MELTFA
  354.       ELSE
  355.          DO I1 = 1, NBSOUP, 1
  356.             MLESPG.LECT(I1)=MELTFA.LISOUS(I1)
  357.          ENDDO
  358.       ENDIF
  359. C
  360.       MCHEL1=ICRN
  361.       SEGACT MCHEL1
  362.       NBSOU1=MCHEL1.IMACHE(/1)
  363.       IF(NBSOU1 .NE. NBSOUP)THEN
  364.          WRITE(IOIMP,*) 'SPG coeffs grads = ???'
  365.          WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  366.          CALL ERREUR(5)
  367.          GOTO 9999
  368.       ENDIF
  369. C
  370.       MCHEL2=ICPN
  371.       SEGACT MCHEL2
  372.       NBSOU1=MCHEL2.IMACHE(/1)
  373.       IF(NBSOU1 .NE. NBSOUP)THEN
  374.          WRITE(IOIMP,*) 'SPG coeffs grads = ???'
  375.          WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  376.          CALL ERREUR(5)
  377.          GOTO 9999
  378.       ENDIF
  379. C
  380.       MCHEL2=ICVN
  381.       SEGACT MCHEL2
  382.       NBSOU1=MCHEL2.IMACHE(/1)
  383.       IF(NBSOU1 .NE. NBSOUP)THEN
  384.          WRITE(IOIMP,*) 'SPG coeffs grads = ???'
  385.          WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  386.          CALL ERREUR(5)
  387.          GOTO 9999
  388.       ENDIF
  389. C
  390. C**** N.B.: ICRN, ICPN, ICVN sont activés!!!
  391. C
  392. C
  393. C****************** L'objet matrik
  394. C
  395. C
  396.       NRIGE = 7
  397.       NMATRI = 1
  398.       NKID = 9
  399.       NKMT = 7
  400. C
  401.       SEGINI MATRIK
  402.       IMAT = MATRIK
  403. C
  404. C**** Maillage des inconnues duales: MELEMC
  405. C     Maillage des inconnues primales:
  406. C     même structure que MCHEL1.IMACHE(ISOUS)
  407. C     Donc on partitionne les deux dans la meme
  408. C     maniere.
  409. C
  410.       JG=NBSOUP
  411.       SEGINI MLEPRI
  412.       SEGINI MLEGRR
  413.       SEGINI MLEGRP
  414.       SEGINI MLEGRV
  415.       IF(NBSOUP .EQ. 1)THEN
  416.          MCHEL1=ICRN
  417.          IPT1=MCHEL1.IMACHE(1)
  418.          SEGACT IPT1
  419.          SEGINI, MELPRI = IPT1
  420.          MLEPRI.LECT(1) = MELPRI
  421.          MLEGRR.LECT(1) = IPT1
  422. C
  423.          MCHEL1=ICPN
  424.          IPT1=MCHEL1.IMACHE(1)
  425.          SEGACT IPT1
  426.          MLEGRP.LECT(1) = IPT1
  427. C
  428.          MCHEL1=ICVN
  429.          IPT1=MCHEL1.IMACHE(1)
  430.          SEGACT IPT1
  431.          MLEGRV.LECT(1) = IPT1
  432.       ELSE
  433.          NBSOUS=NBSOUP
  434.          NBREF=0
  435.          NBNN=0
  436.          NBELEM=0
  437.          SEGINI MELPRI
  438.          MCHEL1=ICRN
  439.          MCHEL2=ICPN
  440.          MCHEL3=ICVN
  441.          DO ISOUS = 1, NBSOUP, 1
  442.             IPT1=MCHEL1.IMACHE(ISOUS)
  443.             IPT2=MCHEL2.IMACHE(ISOUS)
  444.             IPT3=MCHEL3.IMACHE(ISOUS)
  445.             SEGACT IPT1
  446.             SEGACT IPT2
  447.             SEGACT IPT3
  448.             SEGINI, MELEME=IPT1
  449.             MELPRI.LISOUS(ISOUS) = MELEME
  450.             MLEPRI.LECT(ISOUS) = MELEME
  451.             MLEGRR.LECT(ISOUS) = IPT1
  452.             MLEGRP.LECT(ISOUS) = IPT2
  453.             MLEGRV.LECT(ISOUS) = IPT3
  454.          ENDDO
  455.       ENDIF
  456.       MATRIK.IRIGEL(2,1) = MELPRI
  457.       MATRIK.IRIGEL(1,1) = MELPRI
  458. C
  459. C**** Matrice non symetrique
  460. C
  461.       MATRIK.IRIGEL(7,1) = 2
  462.       NBME = 16
  463.       NBSOUS=NBSOUP
  464.       SEGINI IMATRI
  465.       MLMINC = ILINC
  466.       SEGACT MLMINC
  467.       MATRIK.IRIGEL(4,1) = IMATRI
  468. C
  469.       IMATRI.LISPRI(1) = MLMINC.MOTS(1)
  470.       IMATRI.LISPRI(2) = MLMINC.MOTS(2)
  471.       IMATRI.LISPRI(3) = MLMINC.MOTS(3)
  472.       IMATRI.LISPRI(4) = MLMINC.MOTS(4)
  473.       IMATRI.LISPRI(5) = MLMINC.MOTS(1)
  474.       IMATRI.LISPRI(6) = MLMINC.MOTS(2)
  475.       IMATRI.LISPRI(7) = MLMINC.MOTS(3)
  476.       IMATRI.LISPRI(8) = MLMINC.MOTS(4)
  477.       IMATRI.LISPRI(9) = MLMINC.MOTS(1)
  478.       IMATRI.LISPRI(10) = MLMINC.MOTS(2)
  479.       IMATRI.LISPRI(11) = MLMINC.MOTS(3)
  480.       IMATRI.LISPRI(12) = MLMINC.MOTS(4)
  481.       IMATRI.LISPRI(13) = MLMINC.MOTS(1)
  482.       IMATRI.LISPRI(14) = MLMINC.MOTS(2)
  483.       IMATRI.LISPRI(15) = MLMINC.MOTS(3)
  484.       IMATRI.LISPRI(16) = MLMINC.MOTS(4)
  485. C
  486.       IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  487.       IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  488.       IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  489.       IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  490.       IMATRI.LISDUA(5) = MLMINC.MOTS(2)
  491.       IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  492.       IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  493.       IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  494.       IMATRI.LISDUA(9) = MLMINC.MOTS(3)
  495.       IMATRI.LISDUA(10) = MLMINC.MOTS(3)
  496.       IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  497.       IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  498.       IMATRI.LISDUA(13) = MLMINC.MOTS(4)
  499.       IMATRI.LISDUA(14) = MLMINC.MOTS(4)
  500.       IMATRI.LISDUA(15) = MLMINC.MOTS(4)
  501.       IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  502. C
  503. C**** Boucle sur les LISOUS de MELPRI
  504. C
  505.       IELEM=0
  506. C
  507.       DO ISOUS=1,NBSOUP,1
  508. C
  509. C******* Les coeffs des grad.
  510. C
  511.          MCHEL1=ICRN
  512.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  513.          SEGACT MCHAM1
  514.          MELCR1=MCHAM1.IELVAL(1)
  515.          MELCR2=MCHAM1.IELVAL(2)
  516.          SEGACT MELCR1, MELCR2
  517.          SEGDES MCHAM1
  518. C
  519.          MCHEL1=ICPN
  520.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  521.          SEGACT MCHAM1
  522.          MELCP1=MCHAM1.IELVAL(1)
  523.          MELCP2=MCHAM1.IELVAL(2)
  524.          SEGACT MELCP1, MELCP2
  525.          SEGDES MCHAM1
  526. C
  527. C
  528.          MCHEL1=ICVN
  529.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  530.          SEGACT MCHAM1
  531.          MELCV1=MCHAM1.IELVAL(1)
  532.          MELCV2=MCHAM1.IELVAL(2)
  533.          SEGACT MELCV1, MELCV2
  534.          SEGDES MCHAM1
  535. C
  536. C******* MELEME : maillage elementaire de ELTFA
  537. C
  538.          MELEME=MLESPG.LECT(ISOUS)
  539.          SEGACT MELEME
  540.          NBEL1=MELEME.NUM(/2)
  541.          NP1=MELEME.NUM(/1)
  542. C
  543. C******* IPT1 : SPG des inconnues primales et duales
  544. C
  545.          IPT1=MLEPRI.LECT(ISOUS)
  546.          NBEL = IPT1.NUM(/2)
  547.          NP = IPT1.NUM(/1)
  548. C
  549. C******* MELGRR: SPG elementaire des coeffs de GRAD
  550. C        Il resemble a IPT1, mais IPT1 peut changer!
  551. C
  552.          MELGRR=MLEGRR.LECT(ISOUS)
  553.          MELGRP=MLEGRP.LECT(ISOUS)
  554.          MELGRV=MLEGRV.LECT(ISOUS)
  555. C
  556. C******* MLESPG et MLEPRI doivent avoir le meme nombre
  557. C        d'elts et de noeuds!
  558. C
  559.          IF((NBEL1 .NE. NBEL) .OR. (NP1 .NE. (NP-1)))THEN
  560.             WRITE(IOIMP,*) 'ELTFA, SPGs gradients'
  561.             WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  562.             CALL ERREUR(5)
  563.             GOTO 9999
  564.          ENDIF
  565. C
  566.          MP = NP
  567.          SEGINI   RR  , RUX , RUY , RRET ,
  568.      &        UXR , UXUX , UXUY , UXRET ,
  569.      &        UYR , UYUX , UYUY , UYRET ,
  570.      &        RETR , RETUX , RETUY , RETRET
  571. C
  572. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  573. C     Primale = IMATRI.LISPRI(1) = 'RN'
  574. C     -> IMATRI.LIZAFM(1,1) = RR
  575. C
  576. C     Duale = IMATRI.LISDUA(2) = 'RN'
  577. C     Primale = IMATRI.LISPRI(2) = 'RUXN'
  578. C     -> IMATRI.LIZAFM(1,2) = RUX
  579. C     ...
  580. C
  581. C NB  Pour le moment on y stoke le jacobien du flux
  582. C     par rapport aux variables primitives (R,UX,UY,P)
  583. C
  584.          IMATRI.LIZAFM(ISOUS,1) = RR
  585.          IMATRI.LIZAFM(ISOUS,2) = RUX
  586.          IMATRI.LIZAFM(ISOUS,3) = RUY
  587.          IMATRI.LIZAFM(ISOUS,4) = RRET
  588.          IMATRI.LIZAFM(ISOUS,5) = UXR
  589.          IMATRI.LIZAFM(ISOUS,6) = UXUX
  590.          IMATRI.LIZAFM(ISOUS,7) = UXUY
  591.          IMATRI.LIZAFM(ISOUS,8) = UXRET
  592.          IMATRI.LIZAFM(ISOUS,9) = UYR
  593.          IMATRI.LIZAFM(ISOUS,10) = UYUX
  594.          IMATRI.LIZAFM(ISOUS,11) = UYUY
  595.          IMATRI.LIZAFM(ISOUS,12) = UYRET
  596.          IMATRI.LIZAFM(ISOUS,13) = RETR
  597.          IMATRI.LIZAFM(ISOUS,14) = RETUX
  598.          IMATRI.LIZAFM(ISOUS,15) = RETUY
  599.          IMATRI.LIZAFM(ISOUS,16) = RETRET
  600. C
  601. C******* Boucle sur les elts de MLEPRI.LECT
  602. C
  603.  
  604.          DO IELPRI=1,NBEL,1
  605.             IELEM=IELEM+1
  606.             NGC=IPT1.NUM(NP,IELPRI)
  607.             NLC=MLENTC.LECT(NGC)
  608.             IF(NLC.NE.IELEM)THEN
  609.                WRITE(IOIMP,*) 'NLC != IELEM'
  610.                WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  611.                CALL ERREUR(5)
  612.                GOTO 9999
  613.             ENDIF
  614.             VOLG = MPVOLU.VPOCHA(NLC,1)
  615. C
  616. C************* Pour la contribution des gradients
  617. C              1) les limiteurs
  618. C
  619.                ALR  = MPGLRN.VPOCHA(NLC,1)
  620.                ALP  = MPGLPN.VPOCHA(NLC,1)
  621.                ALVX = MPGLVN.VPOCHA(NLC,1)
  622.                ALVY = MPGLVN.VPOCHA(NLC,2)
  623.                ICOOR= (NGC - 1) * 3
  624.                XCG = MCOORD.XCOOR(ICOOR + 1)
  625.                YCG = MCOORD.XCOOR(ICOOR + 2)
  626. C
  627. C******** Boucle sur le noeuds de MLESPG.LECT
  628. C
  629.             DO IFAC=1,(NP - 1),1
  630.                NGCF = MELEME.NUM(IFAC,IELPRI)
  631.                ICOOR= (NGCF - 1) * 3
  632.                DXCF = MCOORD.XCOOR(ICOOR + 1) - XCG
  633.                DYCF = MCOORD.XCOOR(ICOOR + 2) - YCG
  634.                NLCF = MLENTF.LECT(NGCF)
  635.                NGCF1 = MELEFE.NUM(2,NLCF)
  636.                IF(NGCF .NE. NGCF1)THEN
  637.                   WRITE(IOIMP,*)
  638.      $                 'FACE ET FACEL = ???'
  639.                   WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  640.                   CALL ERREUR(5)
  641.                   GOTO 9999
  642.                ENDIF
  643.                NGCG = MELEFE.NUM(1,NLCF)
  644.                NGCD = MELEFE.NUM(3,NLCF)
  645.                SURF = MPOVSU.VPOCHA(NLCF,1)
  646.                NLFL = MLELIM.LECT(NGCF)
  647.                IF(NLFL .NE. 0)THEN
  648. C
  649. C************* The point belongs on BC -> No contribution to jacobian!
  650. C
  651.                   DFRO(1)=0.0D0
  652.                   DFRO(2)=0.0D0
  653.                   DFRO(3)=0.0D0
  654.                   DFRO(4)=0.0D0
  655.                   DFRUN(1)=0.0D0
  656.                   DFRUN(2)=0.0D0
  657.                   DFRUN(3)=0.0D0
  658.                   DFRUN(4)=0.0D0
  659.                   DFRUT(1)=0.0D0
  660.                   DFRUT(2)=0.0D0
  661.                   DFRUT(3)=0.0D0
  662.                   DFRUT(4)=0.0D0
  663.                   DFRET(1)=0.0D0
  664.                   DFRET(2)=0.0D0
  665.                   DFRET(3)=0.0D0
  666.                   DFRET(4)=0.0D0
  667. C
  668. C************* On est sur G, sur D, ou sur un mur?
  669. C
  670.                ELSEIF(NGCG .EQ. NGCD)THEN
  671. C
  672. C***************** Murs
  673. C                  Aucune contribution à l'elt droite!
  674. C
  675.                   CNX = MELVNX.VELCHE(1,NLCF)
  676.                   CNY = MELVNY.VELCHE(1,NLCF)
  677.                   CTX = MELT1X.VELCHE(1,NLCF)
  678.                   CTY = MELT1Y.VELCHE(1,NLCF)
  679.                   ROG = MELRO.VELCHE(1,NLCF)
  680.                   UNG = MELVUN.VELCHE(1,NLCF)
  681.                   UTG = MELVUT.VELCHE(1,NLCF)
  682.                   UXG = UNG * CNX + UTG * CTX
  683.                   UYG = UNG * CNY + UTG * CTY
  684.                   PG = MELP.VELCHE(1,NLCF)
  685.                   GAMG = MELGAM.VELCHE(1,NLCF)
  686. C
  687. C**************** Jacobien par rapport aux variables primitives sur
  688. C                 la face
  689. C
  690.                   IF(IIMPL .EQ. 4)THEN
  691. C
  692. C******************* VLH
  693. C
  694.                      CALL VLHJ3(ROG,UXG,UYG,PG,GAMG,CNX,CNY,DFRUN)
  695. C
  696.                   ELSEIF(IIMPL .EQ. 5)THEN
  697. C
  698. C******************* AUSM+
  699. C
  700.                      ROD=ROG
  701.                      PD=PG
  702.                      UND=-1.0D0*UNG
  703.                      UTD=UTG
  704.                      UXD = UND * CNX + UTD * CTX
  705.                      UYD = UND * CNY + UTD * CTY
  706.                      CALL AUSMW(ROG,UXG,UYG,PG,ROD,UXD,UYD,PD,
  707.      &                    GAMG,CNX,CNY,DFRUN)
  708.                   ELSE
  709.                      CALL ERREUR(5)
  710.                   ENDIF
  711.                   DFRO(1)=0.0D0
  712.                   DFRO(2)=0.0D0
  713.                   DFRO(3)=0.0D0
  714.                   DFRO(4)=0.0D0
  715.                   DFRUT(1)=0.0D0
  716.                   DFRUT(2)=0.0D0
  717.                   DFRUT(3)=0.0D0
  718.                   DFRUT(4)=0.0D0
  719.                   DFRET(1)=0.0D0
  720.                   DFRET(2)=0.0D0
  721.                   DFRET(3)=0.0D0
  722.                   DFRET(4)=0.0D0
  723. C
  724.                ELSEIF(NGC .EQ. NGCG)THEN
  725. C
  726. C*************  On est sur G
  727. C
  728.                   CNX = MELVNX.VELCHE(1,NLCF)
  729.                   CNY = MELVNY.VELCHE(1,NLCF)
  730.                   CTX = MELT1X.VELCHE(1,NLCF)
  731.                   CTY = MELT1Y.VELCHE(1,NLCF)
  732. C
  733.                   ROG = MELRO.VELCHE(1,NLCF)
  734.                   UNG = MELVUN.VELCHE(1,NLCF)
  735.                   UTG = MELVUT.VELCHE(1,NLCF)
  736.                   UXG = UNG * CNX + UTG * CTX
  737.                   UYG = UNG * CNY + UTG * CTY
  738.                   PG = MELP.VELCHE(1,NLCF)
  739.                   GAMG = MELGAM.VELCHE(1,NLCF)
  740.                   ECIN=0.5D0*ROG*(UNG*UNG+UTG*UTG)
  741.                   RETG=PG/(GAMG-1.0D0)+ECIN
  742. C
  743.                   ROD = MELRO.VELCHE(3,NLCF)
  744.                   UND = MELVUN.VELCHE(3,NLCF)
  745.                   UTD = MELVUT.VELCHE(3,NLCF)
  746.                   UXD = UND * CNX + UTD * CTX
  747.                   UYD = UND * CNY + UTD * CTY
  748.                   PD = MELP.VELCHE(3,NLCF)
  749. C
  750.                   NLCD=MLENTC.LECT(NGCD)
  751.                   VOLD=MPVOLU.VPOCHA(NLCD,1)
  752.                   IF(IIMPL .EQ. 4)THEN
  753. C
  754. C******************* VLH
  755. C
  756.                      CALL VLHJ1(ROG,UXG,UYG,PG,RETG,GAMG,CNX,CNY,CTX,CTY
  757.      $                    ,DFRO,DFRUN,DFRUT,DFRET)
  758.                   ELSEIF(IIMPL .EQ. 5)THEN
  759. C
  760. C******************* AUSM+
  761. C
  762.                      CALL AUSMF(ROG,UXG,UYG,PG,ROD,UXD,UYD,PD,
  763.      &                   GAMG,CNX,CNY,CTX,CTY,
  764.      &                   DFRO,DFRUN,DFRUT,DFRET)
  765.                   ELSE
  766.                      CALL ERREUR(5)
  767.                   ENDIF
  768.                ELSEIF(NGC .EQ. NGCD)THEN
  769.                   CNX = -1.0D0 * MELVNX.VELCHE(1,NLCF)
  770.                   CNY = -1.0D0 * MELVNY.VELCHE(1,NLCF)
  771.                   CTX = -1.0D0 * MELT1X.VELCHE(1,NLCF)
  772.                   CTY = -1.0D0 * MELT1Y.VELCHE(1,NLCF)
  773. C
  774.                   ROG = MELRO.VELCHE(3,NLCF)
  775.                   UNG = MELVUN.VELCHE(3,NLCF)
  776.                   UTG = MELVUT.VELCHE(3,NLCF)
  777.                   UXG = -1.0D0 * (UNG * CNX + UTG * CTX)
  778.                   UYG = -1.0D0 * (UNG * CNY + UTG * CTY)
  779.                   PG = MELP.VELCHE(3,NLCF)
  780.                   GAMG = MELGAM.VELCHE(3,NLCF)
  781.                   ECIN=0.5D0*ROG*(UNG*UNG+UTG*UTG)
  782.                   RETG=PG/(GAMG-1.0D0)+ECIN
  783. C
  784.                   ROD = MELRO.VELCHE(1,NLCF)
  785.                   UND = MELVUN.VELCHE(1,NLCF)
  786.                   UTD = MELVUT.VELCHE(1,NLCF)
  787.                   UXD = -1.0D0 * (UND * CNX + UTD * CTX)
  788.                   UYD =  -1.0D0 * (UND * CNY + UTD * CTY)
  789.                   PD = MELP.VELCHE(1,NLCF)
  790. C
  791.                   NLCD=MLENTC.LECT(NGCG)
  792.                   VOLD=MPVOLU.VPOCHA(NLCD,1)
  793.                   IF(IIMPL .EQ. 4)THEN
  794. C
  795. C******************* VLH
  796. C
  797.                      CALL VLHJ1(ROG,UXG,UYG,PG,RETG,GAMG,CNX,CNY,CTX,CTY
  798.      $                    ,DFRO,DFRUN,DFRUT,DFRET)
  799.                   ELSEIF(IIMPL .EQ. 5)THEN
  800. C
  801. C******************* AUSM+
  802. C
  803.                      CALL AUSMF(ROG,UXG,UYG,PG,ROD,UXD,UYD,PD,
  804.      &                    GAMG,CNX,CNY,CTX,CTY,
  805.      &                    DFRO,DFRUN,DFRUT,DFRET)
  806.                   ELSE
  807.                      CALL ERREUR(5)
  808.                   ENDIF
  809.                ELSE
  810.                   WRITE(IOIMP,*) 'FACEL = ???'
  811.                   WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  812.                   CALL ERREUR(5)
  813.                   GOTO 9999
  814.                ENDIF
  815. C
  816.                DO I1=1,4
  817.                   DFRUX(I1)=DFRUN(I1)*CNX+DFRUT(I1)*CTX
  818.                   DFRUY(I1)=DFRUN(I1)*CNY+DFRUT(I1)*CTY
  819.                ENDDO
  820. C
  821.                NGNO=MELGRR.NUM(IFAC,IELPRI)
  822.                NGN1=MELGRP.NUM(IFAC,IELPRI)
  823.                NGN2=MELGRV.NUM(IFAC,IELPRI)
  824. C
  825.                IF((NGN1 .NE. NGNO) .OR. (NGN2 .NE. NGNO))THEN
  826.                   WRITE(IOIMP,*) 'SPG COEFF GRAD =???'
  827.                   WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  828.                   CALL ERREUR(5)
  829.                   GOTO 9999
  830.                ENDIF
  831. C
  832.                NLNO=MLENTC.LECT(NGNO)
  833.                IF(NLNO .EQ. 0)THEN
  834. C
  835. C**************** MURS
  836. C
  837.                   IPT1.NUM(IFAC,IELPRI)=NGC
  838.  
  839. C                Primal variable in IPT1.NUM(IFAC,IELPRI)=IPT1.NUM(NP,IELPRI)
  840. C                Dual variable in IPT1.NUM(NP,IELPRI)
  841. C
  842.                   FUNCEL = -1.0D0 * SURF / VOLG
  843.                   UXR.AM(IELPRI,IFAC,NP)=UXR.AM(IELPRI,IFAC,NP)
  844.      &                 +DFRUX(1)*FUNCEL
  845.                   UYR.AM(IELPRI,IFAC,NP)=UYR.AM(IELPRI,IFAC,NP)
  846.      &                 +DFRUY(1)*FUNCEL
  847.                   UXUX.AM(IELPRI,IFAC,NP)=UXUX.AM(IELPRI,IFAC,NP)
  848.      &                 +DFRUX(2)*FUNCEL
  849.                   UYUX.AM(IELPRI,IFAC,NP)=UYUX.AM(IELPRI,IFAC,NP)
  850.      &                 +DFRUY(2)*FUNCEL
  851.                   UXUY.AM(IELPRI,IFAC,NP)=UXUY.AM(IELPRI,IFAC,NP)
  852.      &                 +DFRUX(3)*FUNCEL
  853.                   UYUY.AM(IELPRI,IFAC,NP)=UYUY.AM(IELPRI,IFAC,NP)
  854.      &                 +DFRUY(3)*FUNCEL
  855.                   UXRET.AM(IELPRI,IFAC,NP)=UXRET.AM(IELPRI,IFAC,NP)
  856.      &                 +DFRUX(4)*FUNCEL
  857.                   UYRET.AM(IELPRI,IFAC,NP)=UYRET.AM(IELPRI,IFAC,NP)
  858.      &                 +DFRUY(4)*FUNCEL
  859.  
  860.                ELSE
  861. C
  862. C                 Primal variable in IPT1.NUM(NP,IELPRI)
  863. C                 Dual variable in IPT1.NUM(NP,IELPRI)
  864. C
  865.                   FUNCEL=DFRO(1)*SURF
  866.                   RR.AM(IELPRI,NP,NP)=RR.AM(IELPRI,NP,NP)-
  867.      &                 FUNCEL/VOLG
  868. C
  869. C                 Primal variable in NP
  870. C                 Dual variable in IFAC
  871. C
  872.                   RR.AM(IELPRI,NP,IFAC)=RR.AM(IELPRI,NP,IFAC)+FUNCEL
  873.      $                 /VOLD
  874. C
  875.                   FUNCEL=DFRO(2)*SURF
  876.                   RUX.AM(IELPRI,NP,NP)=RUX.AM(IELPRI,NP,NP) -
  877.      &                 FUNCEL/VOLG
  878.                   RUX.AM(IELPRI,NP,IFAC)=RUX.AM(IELPRI,NP,IFAC)+ FUNCEL
  879.      $                 /VOLD
  880. C
  881.                   FUNCEL=DFRO(3)*SURF
  882.                   RUY.AM(IELPRI,NP,NP)=RUY.AM(IELPRI,NP,NP) -
  883.      &                 FUNCEL/VOLG
  884.                   RUY.AM(IELPRI,NP,IFAC)=RUY.AM(IELPRI,NP,IFAC)+ FUNCEL
  885.      $                 /VOLD
  886. C
  887.                   FUNCEL=DFRO(4)*SURF
  888.                   RRET.AM(IELPRI,NP,NP)=RRET.AM(IELPRI,NP,NP) -
  889.      &                 FUNCEL/VOLG
  890.                   RRET.AM(IELPRI,NP,IFAC)= RRET.AM(IELPRI,NP,IFAC)
  891.      $                 +FUNCEL/VOLD
  892. C
  893. C
  894.                   FUNCEL=DFRUX(1)*SURF
  895.                   UXR.AM(IELPRI,NP,NP)=UXR.AM(IELPRI,NP,NP) -
  896.      &                 FUNCEL/VOLG
  897.                   UXR.AM(IELPRI,NP,IFAC)=UXR.AM(IELPRI,NP,IFAC)+FUNCEL
  898.      $                 /VOLD
  899. C
  900.                   FUNCEL=DFRUX(2)*SURF
  901.                   UXUX.AM(IELPRI,NP,NP)=UXUX.AM(IELPRI,NP,NP) -
  902.      &                 FUNCEL/VOLG
  903.                   UXUX.AM(IELPRI,NP,IFAC)=UXUX.AM(IELPRI,NP,IFAC)+
  904.      $                 FUNCEL/VOLD
  905. C
  906.                   FUNCEL=DFRUX(3)*SURF
  907.                   UXUY.AM(IELPRI,NP,NP)=UXUY.AM(IELPRI,NP,NP) -
  908.      &                 FUNCEL/VOLG
  909.                   UXUY.AM(IELPRI,NP,IFAC)=UXUY.AM(IELPRI,NP,IFAC)+
  910.      $                 FUNCEL/VOLD
  911. C
  912.                   FUNCEL=DFRUX(4)*SURF
  913.                   UXRET.AM(IELPRI,NP,NP)=UXRET.AM(IELPRI,NP,NP) -
  914.      &                 FUNCEL/VOLG
  915.                   UXRET.AM(IELPRI,NP,IFAC)=UXRET.AM(IELPRI,NP,IFAC)+
  916.      $                 FUNCEL/VOLD
  917. C
  918. C
  919.                   FUNCEL=DFRUY(1)*SURF
  920.                   UYR.AM(IELPRI,NP,NP)=UYR.AM(IELPRI,NP,NP) -
  921.      &                 FUNCEL/VOLG
  922.                   UYR.AM(IELPRI,NP,IFAC)=UYR.AM(IELPRI,NP,IFAC)+FUNCEL
  923.      $                 /VOLD
  924. C
  925.                   FUNCEL=DFRUY(2)*SURF
  926.                   UYUX.AM(IELPRI,NP,NP)=UYUX.AM(IELPRI,NP,NP) -
  927.      &                 FUNCEL/VOLG
  928.                   UYUX.AM(IELPRI,NP,IFAC)=UYUX.AM(IELPRI,NP,IFAC)+
  929.      $                 FUNCEL/VOLD
  930. C
  931.                   FUNCEL=DFRUY(3)*SURF
  932.                   UYUY.AM(IELPRI,NP,NP)=UYUY.AM(IELPRI,NP,NP) -
  933.      &                 FUNCEL/VOLG
  934.                   UYUY.AM(IELPRI,NP,IFAC)=UYUY.AM(IELPRI,NP,IFAC)+
  935.      $                 FUNCEL/VOLD
  936. C
  937.                   FUNCEL=DFRUY(4)*SURF
  938.                   UYRET.AM(IELPRI,NP,NP)=UYRET.AM(IELPRI,NP,NP) -
  939.      &                 FUNCEL/VOLG
  940.                   UYRET.AM(IELPRI,NP,IFAC)=UYRET.AM(IELPRI,NP,IFAC)+
  941.      $                 FUNCEL/VOLD
  942. C
  943. C
  944.                   FUNCEL=DFRET(1)*SURF
  945.                   RETR.AM(IELPRI,NP,NP)=RETR.AM(IELPRI,NP,NP) -
  946.      &                 FUNCEL/VOLG
  947.                   RETR.AM(IELPRI,NP,IFAC)=RETR.AM(IELPRI,NP,IFAC)+FUNCEL
  948.      $                 /VOLD
  949. C
  950.                   FUNCEL=DFRET(2)*SURF
  951.                   RETUX.AM(IELPRI,NP,NP)=RETUX.AM(IELPRI,NP,NP) -
  952.      &                 FUNCEL/VOLG
  953.                   RETUX.AM(IELPRI,NP,IFAC)=RETUX.AM(IELPRI,NP,IFAC)+
  954.      $                 FUNCEL/VOLD
  955. C
  956.                   FUNCEL=DFRET(3)*SURF
  957.                   RETUY.AM(IELPRI,NP,NP)=RETUY.AM(IELPRI,NP,NP) -
  958.      &                 FUNCEL/VOLG
  959.                   RETUY.AM(IELPRI,NP,IFAC)=RETUY.AM(IELPRI,NP,IFAC)+
  960.      $                 FUNCEL/VOLD
  961. C
  962.                   FUNCEL=DFRET(4)*SURF
  963.                   RETRET.AM(IELPRI,NP,NP)=RETRET.AM(IELPRI,NP,NP) -
  964.      &                 FUNCEL/VOLG
  965.                   RETRET.AM(IELPRI,NP,IFAC)=RETRET.AM(IELPRI,NP,IFAC)+
  966.      $                 FUNCEL/VOLD
  967.                ENDIF
  968. C
  969. C************* Gradients computed with EULESCAL or EULEVECT
  970. C              Computation of gradients contributions
  971.  
  972.                DO IFAC2 = 1, (NP-1), 1
  973. C
  974. C**************** On controlle que les melemes de ELTFA et
  975. C                 le SPG du grad ont le meme ordre
  976. C
  977.                   NGFGR=MELEME.NUM(IFAC2,IELPRI)
  978.                   NLFGR=MLENTF.LECT(NGFGR)
  979.                   NG=MELEFE.NUM(1,NLFGR)
  980.                   ND=MELEFE.NUM(3,NLFGR)
  981. C
  982.                   IF(NG .EQ. ND)THEN
  983. C
  984. C******************* On est sur un mur: EULESCAL
  985. C
  986.                      DO IFACGR = 1, (NP -1) , 1
  987. C
  988. C********************** Boucle sur les elts de MELGRR pour trouver la position
  989. C                       correspondante
  990. C
  991.                         NGGRA=MELGRR.NUM(IFACGR,IELPRI)
  992.                         IF(NGFGR .EQ. NGGRA) GOTO 10
  993.                      ENDDO
  994.                      WRITE(IOIMP,*) 'ELTFA et SPG grad= ???'
  995.                      WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  996.                      CALL ERREUR(5)
  997.                      GOTO 9999
  998.  10                  CONTINUE
  999. C
  1000. C******************* Les coeff qui nous interesse sont donc dans la
  1001. C                    position IFACGR du gradient
  1002. C
  1003.                      CELLR = ALR * (DXCF * MELCR1.VELCHE(IFACGR,IELPRI)
  1004.      $                    +DYCF * MELCR2.VELCHE(IFACGR,IELPRI))
  1005.                      CELLP = ALP * (DXCF * MELCP1.VELCHE(IFACGR,IELPRI)
  1006.      $                    + DYCF * MELCP2.VELCHE(IFACGR,IELPRI))
  1007. C
  1008. C******************* La vitesse est un peux plus difficile
  1009. C                    (HP EULEVECT ou vitesse imposé)
  1010. C
  1011. C                    CViVj contribution de vj sur le grad de vi
  1012. C
  1013.                      NLVIMP = MLEVL.LECT(NGGRA)
  1014.                      IF(NLVIMP .NE.0)THEN
  1015. C
  1016. C*********************** NGGRA spg de conditions limites -> no
  1017. C                        contribution
  1018. C
  1019.                         CVXVX=0.0D0
  1020.                         CVXVY=0.0D0
  1021.                         CVYVX=0.0D0
  1022.                         CVYVY=0.0D0
  1023.                      ELSE
  1024.                         CNX1=MPNORM.VPOCHA(NLFGR,1)
  1025.                         CNY1=MPNORM.VPOCHA(NLFGR,2)
  1026.                         CTX1=-1.0D0*CNY1
  1027.                         CTY1=CNX1
  1028.                         FUNCEL=(DXCF * MELCV1.VELCHE(IFACGR,IELPRI)+DYCF
  1029.      $                       * MELCV2.VELCHE(IFACGR,IELPRI))
  1030.                         CVXVX=FUNCEL*(CTX1*CTX1-CNX1*CNX1)*ALVX
  1031.                         CVXVY=FUNCEL*(CTX1*CTY1-CNX1*CNY1)*ALVX
  1032.                         CVYVX=FUNCEL*(CTX1*CTY1-CNX1*CNY1)*ALVY
  1033.                         CVYVY=FUNCEL*(CTY1*CTY1-CNY1*CNY1)*ALVY
  1034.                      ENDIF
  1035. C
  1036.                   ELSE
  1037.                      DO IFACGR = 1, (NP -1) , 1
  1038. C
  1039. C********************** Boucle sur les elts de MELGRR pour trouver la position
  1040. C                       correspondante
  1041. C
  1042.                         NGGRA=MELGRR.NUM(IFACGR,IELPRI)
  1043.                         IF((NGGRA .EQ. NG) .OR. (NGGRA .EQ. ND)) GOTO 20
  1044.                      ENDDO
  1045.                      WRITE(IOIMP,*) 'ELTFA et SPG grad= ???'
  1046.                      WRITE(IOIMP,*) 'SUBROUTINE konja5.eso'
  1047.                      CALL ERREUR(5)
  1048.                      GOTO 9999
  1049.  20                  CONTINUE
  1050.                      CELLR = ALR * (DXCF * MELCR1.VELCHE(IFACGR,IELPRI)
  1051.      $                    +DYCF * MELCR2.VELCHE(IFACGR,IELPRI))
  1052.                      CELLP = ALP * (DXCF * MELCP1.VELCHE(IFACGR,IELPRI)
  1053.      $                    + DYCF * MELCP2.VELCHE(IFACGR,IELPRI))
  1054.                      CVXVX = ALVX * (DXCF * MELCV1.VELCHE(IFACGR,IELPRI)
  1055.      $                    + DYCF * MELCV2.VELCHE(IFACGR,IELPRI))
  1056.                      CVXVY=0.0D0
  1057.                      CVYVY = ALVY * (DXCF * MELCV1.VELCHE(IFACGR,IELPRI)
  1058.      $                    + DYCF * MELCV2.VELCHE(IFACGR,IELPRI))
  1059.                      CVYVX = 0.0D0
  1060.  
  1061.                   ENDIF
  1062. C
  1063. C**************** Dans le cas d'un mur (NLN0=0) , IFACGR = primale qui donne
  1064. C                 contribution en IELPRI,IFACGR,IFAC OU (IELPRI,IFACGR,NP)
  1065. C
  1066. C                 Dans le cas non mur (NLN0=0) , IFACGR = primale qui donne
  1067. C                 contribution en IELPRI,IFACGR,NP et en IELPRI,IFAC,NP
  1068. C
  1069.                   IF(NLNO .EQ. 0)THEN
  1070. C
  1071. C**************** MURS
  1072. C
  1073.                      FUNCEL = -1.0D0 * SURF / VOLG * CELLR
  1074.                      UXR.AM(IELPRI,IFACGR,NP)=UXR.AM(IELPRI,IFACGR,NP)
  1075.      &                    +DFRUX(1)*FUNCEL
  1076.                      UYR.AM(IELPRI,IFACGR,NP)=UYR.AM(IELPRI,IFACGR,NP)
  1077.      &                    +DFRUY(1)*FUNCEL
  1078. C
  1079.                      FUNCEL = -1.0D0 * SURF / VOLG
  1080.                      UXUX.AM(IELPRI,IFACGR,NP)=UXUX.AM(IELPRI,IFACGR,NP)
  1081.      &                    +FUNCEL * (DFRUX(2)*CVXVX + DFRUX(3) *CVYVX)
  1082.                      UYUX.AM(IELPRI,IFACGR,NP)=UYUX.AM(IELPRI,IFACGR,NP)
  1083.      &                    +FUNCEL * (DFRUY(2)*CVXVX + DFRUY(3) *CVYVX)
  1084. C
  1085.                      FUNCEL = -1.0D0 * SURF / VOLG
  1086.                      UXUY.AM(IELPRI,IFACGR,NP)=UXUY.AM(IELPRI,IFACGR,NP)
  1087.      &                    +FUNCEL * (DFRUX(3)*CVYVY + DFRUX(2) *CVXVY)
  1088.                      UYUY.AM(IELPRI,IFACGR,NP)=UYUY.AM(IELPRI,IFACGR,NP)
  1089.      &                    +FUNCEL * (DFRUY(3)*CVYVY + DFRUY(2) *CVXVY)
  1090.  
  1091. C
  1092.                      FUNCEL = -1.0D0 * SURF / VOLG * CELLP
  1093.                      UXRET.AM(IELPRI,IFACGR,NP)=UXRET.AM(IELPRI,IFACGR
  1094.      $                    ,NP)+DFRUX(4)*FUNCEL
  1095.                      UYRET.AM(IELPRI,IFACGR,NP)=UYRET.AM(IELPRI,IFACGR
  1096.      $                    ,NP)+DFRUY(4)*FUNCEL
  1097.                   ELSE
  1098. C
  1099. C******************* dR/
  1100. C
  1101.                      FUNCEL=DFRO(1)*SURF*CELLR
  1102.                      RR.AM(IELPRI,IFACGR,NP)=RR.AM(IELPRI,IFACGR,NP)-
  1103.      &                 FUNCEL/VOLG
  1104.                      RR.AM(IELPRI,IFACGR,IFAC)=RR.AM(IELPRI,IFACGR,IFAC)
  1105.      $                    +FUNCEL/VOLD
  1106. C
  1107.                      FUNCEL=DFRO(4)*SURF*CELLP
  1108.                      RRET.AM(IELPRI,IFACGR,NP)=RRET.AM(IELPRI,IFACGR,NP)
  1109.      $                    -FUNCEL/VOLG
  1110.                      RRET.AM(IELPRI,IFACGR,IFAC)=RRET.AM(IELPRI,IFACGR
  1111.      $                    ,IFAC)+FUNCEL/VOLD
  1112. C
  1113.                      FUNCEL=SURF * (DFRO(2)*CVXVX + DFRO(3) *CVYVX)
  1114.                      RUX.AM(IELPRI,IFACGR,NP)=RUX.AM(IELPRI,IFACGR,NP)
  1115.      &                    - FUNCEL / VOLG
  1116.                      RUX.AM(IELPRI,IFACGR,IFAC)=RUX.AM(IELPRI,IFACGR
  1117.      $                    ,IFAC) + FUNCEL / VOLD
  1118. C
  1119.                      FUNCEL=SURF * (DFRO(3)*CVYVY + DFRO(2) *CVXVY)
  1120.                      RUY.AM(IELPRI,IFACGR,NP)=RUY.AM(IELPRI,IFACGR,NP)
  1121.      &                    - FUNCEL / VOLG
  1122.                      RUY.AM(IELPRI,IFACGR,IFAC)=RUY.AM(IELPRI,IFACGR
  1123.      $                    ,IFAC) + FUNCEL / VOLD
  1124. C
  1125. C******************* dUX/
  1126. C
  1127.                      FUNCEL=DFRUX(1)*SURF*CELLR
  1128.                      UXR.AM(IELPRI,IFACGR,NP)=UXR.AM(IELPRI,IFACGR,NP) -
  1129.      &                    FUNCEL/VOLG
  1130.                      UXR.AM(IELPRI,IFACGR,IFAC)=  UXR.AM(IELPRI,IFACGR
  1131.      $                    ,IFAC)+FUNCEL/VOLD
  1132. C
  1133.                      FUNCEL=DFRUX(4)*SURF*CELLP
  1134.                      UXRET.AM(IELPRI,IFACGR,NP)=UXRET.AM(IELPRI,IFACGR
  1135.      $                    ,NP) -FUNCEL/VOLG
  1136.                      UXRET.AM(IELPRI,IFACGR,IFAC)=  UXRET.AM(IELPRI
  1137.      $                    ,IFACGR,IFAC)+FUNCEL/VOLD
  1138. C
  1139.                      FUNCEL=SURF * (DFRUX(2)*CVXVX + DFRUX(3) *CVYVX)
  1140.                      UXUX.AM(IELPRI,IFACGR,NP)=UXUX.AM(IELPRI,IFACGR,NP)
  1141.      &                    - FUNCEL / VOLG
  1142.                      UXUX.AM(IELPRI,IFACGR,IFAC)=UXUX.AM(IELPRI,IFACGR
  1143.      $                    ,IFAC) + FUNCEL / VOLD
  1144. C
  1145.                      FUNCEL=SURF * (DFRUX(3)*CVYVY + DFRUX(2) *CVXVY)
  1146.                      UXUY.AM(IELPRI,IFACGR,NP)=UXUY.AM(IELPRI,IFACGR,NP)
  1147.      &                    - FUNCEL / VOLG
  1148.                      UXUY.AM(IELPRI,IFACGR,IFAC)=UXUY.AM(IELPRI,IFACGR
  1149.      $                    ,IFAC) + FUNCEL / VOLD
  1150. C
  1151. C******************* dUY/
  1152. C
  1153.                      FUNCEL=DFRUY(1)*SURF*CELLR
  1154.                      UYR.AM(IELPRI,IFACGR,NP)=UYR.AM(IELPRI,IFACGR,NP) -
  1155.      &                    FUNCEL/VOLG
  1156.                      UYR.AM(IELPRI,IFACGR,IFAC)=UYR.AM(IELPRI,IFACGR
  1157.      $                    ,IFAC) + FUNCEL/VOLD
  1158. C
  1159.                      FUNCEL=DFRUY(4)*SURF*CELLP
  1160.                      UYRET.AM(IELPRI,IFACGR,NP)=UYRET.AM(IELPRI,IFACGR
  1161.      $                    ,NP) -FUNCEL/VOLG
  1162.                      UYRET.AM(IELPRI,IFACGR,IFAC)=UYRET.AM(IELPRI,IFACGR
  1163.      $                    ,IFAC) + FUNCEL/VOLD
  1164. C
  1165.                      FUNCEL=SURF * (DFRUY(2)*CVXVX + DFRUY(3) *CVYVX)
  1166.                      UYUX.AM(IELPRI,IFACGR,NP)=UYUX.AM(IELPRI,IFACGR,NP)
  1167.      &                    - FUNCEL / VOLG
  1168.                      UYUX.AM(IELPRI,IFACGR,IFAC)=UYUX.AM(IELPRI,IFACGR
  1169.      $                    ,IFAC) + FUNCEL / VOLD
  1170. C
  1171.                      FUNCEL=SURF * (DFRUY(3)*CVYVY + DFRUY(2) *CVXVY)
  1172.                      UYUY.AM(IELPRI,IFACGR,NP)=UYUY.AM(IELPRI,IFACGR,NP)
  1173.      &                    - FUNCEL / VOLG
  1174.                      UYUY.AM(IELPRI,IFACGR,IFAC)=UYUY.AM(IELPRI,IFACGR
  1175.      $                    ,IFAC) + FUNCEL / VOLD
  1176. C
  1177. C******************* dRET/
  1178. C
  1179.                      FUNCEL=DFRET(1)*SURF*CELLR
  1180.                      RETR.AM(IELPRI,IFACGR,NP)=RETR.AM(IELPRI,IFACGR,NP)
  1181.      $                    -FUNCEL/VOLG
  1182.                      RETR.AM(IELPRI,IFACGR,IFAC)=RETR.AM(IELPRI,IFACGR
  1183.      $                    ,IFAC)+FUNCEL/VOLD
  1184. C
  1185.                      FUNCEL=DFRET(4)*SURF*CELLP
  1186.                      RETRET.AM(IELPRI,IFACGR,NP)=RETRET.AM(IELPRI,IFACGR
  1187.      $                    ,NP)-FUNCEL/VOLG
  1188.                      RETRET.AM(IELPRI,IFACGR,IFAC)=RETRET.AM(IELPRI
  1189.      $                    ,IFACGR,IFAC)+FUNCEL/VOLD
  1190. C
  1191.                      FUNCEL=SURF * (DFRET(2)*CVXVX + DFRET(3) *CVYVX)
  1192.                      RETUX.AM(IELPRI,IFACGR,NP)=RETUX.AM(IELPRI,IFACGR
  1193.      $                    ,NP)- FUNCEL / VOLG
  1194.                      RETUX.AM(IELPRI,IFACGR,IFAC)=RETUX.AM(IELPRI,IFACGR
  1195.      $                    ,IFAC) + FUNCEL / VOLD
  1196. C
  1197.                      FUNCEL=SURF * (DFRET(3)*CVYVY + DFRET(2) *CVXVY)
  1198.                      RETUY.AM(IELPRI,IFACGR,NP)=RETUY.AM(IELPRI,IFACGR
  1199.      $                    ,NP)- FUNCEL / VOLG
  1200.                      RETUY.AM(IELPRI,IFACGR,IFAC)=RETUY.AM(IELPRI,IFACGR
  1201.      $                    ,IFAC) + FUNCEL / VOLD
  1202. C
  1203.                   ENDIF
  1204.                ENDDO
  1205.             ENDDO
  1206.          ENDDO
  1207. C
  1208. C
  1209. C******* Transformation:
  1210. C        jacobien par rapport aux variables primitives ->
  1211. C        jacobien par rapport aux variables conservatives
  1212. C        Optimisation du programme:
  1213. C        on pourrais faire ça avant
  1214. C
  1215.          NBEL=RR.AM(/1)
  1216.          NP=RR.AM(/2)
  1217.          MP=RR.AM(/3)
  1218. C
  1219. C******* Boucle sur les variables primales
  1220. C
  1221.          DO IELETR=1,NBEL,1
  1222.             DO IPRITR=1,NP,1
  1223.                NGPRI=IPT1.NUM(IPRITR,IELETR)
  1224.                NLPRI=MLENTC.LECT(NGPRI)
  1225.                ROG=MPOVRN.VPOCHA(NLPRI,1)
  1226.                PG=MPOVPN.VPOCHA(NLPRI,1)
  1227.                GAMG=MPOGAM.VPOCHA(NLPRI,1)
  1228.                UXG=MPOVVN.VPOCHA(NLPRI,1)
  1229.                UYG=MPOVVN.VPOCHA(NLPRI,2)
  1230.                GAMGM1=GAMG-1.0D0
  1231.                CELCO1=UXG/ROG
  1232.                CELCO2=UYG/ROG
  1233.                CELCO3=0.5D0*GAMGM1*(UXG*UXG+UYG*UYG)
  1234.                CELCO4=GAMGM1*UXG
  1235.                CELCO5=GAMGM1*UYG
  1236.                DO IDUATR=1,MP,1
  1237.                   DDRO=RR.AM(IELETR,IPRITR,IDUATR)
  1238.                   DDUX=RUX.AM(IELETR,IPRITR,IDUATR)
  1239.                   DDUY=RUY.AM(IELETR,IPRITR,IDUATR)
  1240.                   DDP=RRET.AM(IELETR,IPRITR,IDUATR)
  1241.                   RR.AM(IELETR,IPRITR,IDUATR)=DDRO-(CELCO1*DDUX)
  1242.      &                 -(CELCO2*DDUY)+(CELCO3*DDP)
  1243.                   RUX.AM(IELETR,IPRITR,IDUATR)=DDUX/ROG -
  1244.      &                 CELCO4*DDP
  1245.                   RUY.AM(IELETR,IPRITR,IDUATR)=DDUY/ROG -
  1246.      &                 CELCO5*DDP
  1247.                   RRET.AM(IELETR,IPRITR,IDUATR)=GAMGM1*DDP
  1248. C
  1249.                   DDRO=UXR.AM(IELETR,IPRITR,IDUATR)
  1250.                   DDUX=UXUX.AM(IELETR,IPRITR,IDUATR)
  1251.                   DDUY=UXUY.AM(IELETR,IPRITR,IDUATR)
  1252.                   DDP=UXRET.AM(IELETR,IPRITR,IDUATR)
  1253.                   UXR.AM(IELETR,IPRITR,IDUATR)=DDRO-(CELCO1*DDUX)
  1254.      &                 -(CELCO2*DDUY)+(CELCO3*DDP)
  1255.                   UXUX.AM(IELETR,IPRITR,IDUATR)=DDUX/ROG -
  1256.      &                 CELCO4*DDP
  1257.                   UXUY.AM(IELETR,IPRITR,IDUATR)=DDUY/ROG -
  1258.      &                 CELCO5*DDP
  1259.                   UXRET.AM(IELETR,IPRITR,IDUATR)=GAMGM1*DDP
  1260. C
  1261.                   DDRO=UYR.AM(IELETR,IPRITR,IDUATR)
  1262.                   DDUX=UYUX.AM(IELETR,IPRITR,IDUATR)
  1263.                   DDUY=UYUY.AM(IELETR,IPRITR,IDUATR)
  1264.                   DDP=UYRET.AM(IELETR,IPRITR,IDUATR)
  1265.                   UYR.AM(IELETR,IPRITR,IDUATR)=DDRO-(CELCO1*DDUX)
  1266.      &                 -(CELCO2*DDUY)+(CELCO3*DDP)
  1267.                   UYUX.AM(IELETR,IPRITR,IDUATR)=DDUX/ROG -
  1268.      &                 CELCO4*DDP
  1269.                   UYUY.AM(IELETR,IPRITR,IDUATR)=DDUY/ROG -
  1270.      &                 CELCO5*DDP
  1271.                   UYRET.AM(IELETR,IPRITR,IDUATR)=GAMGM1*DDP
  1272. C
  1273.                   DDRO=RETR.AM(IELETR,IPRITR,IDUATR)
  1274.                   DDUX=RETUX.AM(IELETR,IPRITR,IDUATR)
  1275.                   DDUY=RETUY.AM(IELETR,IPRITR,IDUATR)
  1276.                   DDP=RETRET.AM(IELETR,IPRITR,IDUATR)
  1277.                   RETR.AM(IELETR,IPRITR,IDUATR)=DDRO-(CELCO1*DDUX)
  1278.      &                 -(CELCO2*DDUY)+(CELCO3*DDP)
  1279.                   RETUX.AM(IELETR,IPRITR,IDUATR)=DDUX/ROG -
  1280.      &                 CELCO4*DDP
  1281.                   RETUY.AM(IELETR,IPRITR,IDUATR)=DDUY/ROG -
  1282.      &                 CELCO5*DDP
  1283.                   RETRET.AM(IELETR,IPRITR,IDUATR)=GAMGM1*DDP
  1284.                ENDDO
  1285.             ENDDO
  1286.          ENDDO
  1287. C
  1288.          MELEME = MLESPG.LECT(ISOUS)
  1289.          SEGDES MELEME
  1290.          MELEME = MLEPRI.LECT(ISOUS)
  1291.          SEGDES MELEME
  1292.          MELEME = MLEGRR.LECT(ISOUS)
  1293.          SEGDES MELEME
  1294.          MELEME = MLEGRP.LECT(ISOUS)
  1295.          SEGDES MELEME
  1296.          MELEME = MLEGRV.LECT(ISOUS)
  1297.          SEGDES MELEME
  1298. C
  1299.          SEGDES   RR  , RUX , RUY , RRET ,
  1300.      &        UXR , UXUX , UXUY , UXRET ,
  1301.      &        UYR , UYUX , UYUY , UYRET ,
  1302.      &        RETR , RETUX , RETUY , RETRET
  1303.          SEGDES MELCR1, MELCR2
  1304.          SEGDES MELCP1, MELCP2
  1305.          SEGDES MELCV1, MELCV2
  1306.       ENDDO
  1307. C
  1308. C
  1309. C**** Les MELVALs
  1310. C
  1311.       SEGDES MELRO
  1312.       SEGDES MELP
  1313.       SEGDES MELGAM
  1314.       SEGDES MELVUN
  1315.       SEGDES MELVUT
  1316.       SEGDES MELVNX
  1317.       SEGDES MELVNY
  1318.       SEGDES MELT1X
  1319.       SEGDES MELT1Y
  1320. C
  1321. C**** Les MPOVALs
  1322. C
  1323. C
  1324.       SEGDES MPOVRN
  1325.       SEGDES MPOVVN
  1326.       SEGDES MPOVPN
  1327.       SEGDES MPOGAM
  1328.       SEGDES MPVGRN
  1329.       SEGDES MPGLRN
  1330.       SEGDES MPVGPN
  1331.       SEGDES MPGLPN
  1332.       SEGDES MPVGPN
  1333.       SEGDES MPGLPN
  1334.       IF(MPVLIM .NE. 0) SEGDES MPVLIM
  1335. C
  1336. C**** Les MELEMEs, les MLENTIs, les volumes, les surfaces
  1337. C
  1338.       SEGDES MELEMC
  1339.       SEGSUP MLENTC
  1340.       SEGSUP MLENTF
  1341.       SEGSUP MLEVL
  1342.       SEGDES MELEFE
  1343.       SEGDES MPVOLU
  1344.       SEGDES MPNORM
  1345.       SEGDES MPOVSU
  1346.       SEGDES MELPRI
  1347.       SEGSUP MLEPRI
  1348.       SEGSUP MLEGRR
  1349.       SEGSUP MLEGRP
  1350.       SEGSUP MLEGRV
  1351.  
  1352. C
  1353. C**** Coeff GRAD
  1354. C
  1355.       MCHEL1=ICRN
  1356.       SEGDES MCHEL1
  1357.       MCHEL1=ICPN
  1358.       SEGDES MCHEL1
  1359.       MCHEL1=ICVN
  1360.       SEGDES MCHEL1
  1361. C
  1362.       SEGSUP MLESPG
  1363.       SEGDES MELTFA
  1364. C
  1365. C**** MATRIK, liste des inconnues
  1366. C
  1367.       SEGDES MATRIK
  1368.       SEGDES IMATRI
  1369.       SEGDES MLMINC
  1370.  
  1371. C
  1372. C
  1373.       SEGDES   RR  , RUX , RUY , RRET ,
  1374.      &         UXR , UXUX , UXUY , UXRET ,
  1375.      &         UYR , UYUX , UYUY , UYRET ,
  1376.      &         RETR , RETUX , RETUY , RETRET
  1377.  
  1378.       SEGSUP MLENTC
  1379.       SEGSUP MLENTF
  1380.       SEGDES MLMINC
  1381.       SEGDES MLELIM
  1382.  
  1383.  9999 CONTINUE
  1384.       RETURN
  1385.       END
  1386.  
  1387.  
  1388.  
  1389.  
  1390.  
  1391.  
  1392.  
  1393.  
  1394.  
  1395.  
  1396.  
  1397.  
  1398.  
  1399.  

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