Télécharger la plaquette Cast3M


fr en

Télécharger clim11.eso

Retour à la liste

Numérotation des lignes : 

clim11

  1. C CLIM11    SOURCE    PV        20/09/26    21:16:09     10724          
  2.       SUBROUTINE CLIM11(IJAC)
  3. C************************************************************************
  4. C
  5. C PROJET            :  CASTEM 2000
  6. C
  7. C NOM               :  CLIM11
  8. C
  9. C DESCRIPTION       :  Subroutine appellée par CLIM1
  10. C
  11. C                      Modelisation 2D/3D des equations d'Euler
  12. C                      Calcul de conditions aux bords
  13. C                      Inlet; Riemann invariants
  14. C
  15. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C APPELES (Calcul)  :
  22. C
  23. C************************************************************************
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C HISTORIQUE (Anomalies et modifications éventuelles)
  29. C
  30. C HISTORIQUE :
  31. C
  32. C************************************************************************
  33. C
  34.       IMPLICIT INTEGER(I-N)
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMLMOTS
  39. -INC SMELEME
  40. -INC SMLENTI
  42.       POINTEUR MLMVIT.MLMOTS
  43. C
  44. C**** Variables de COOPTIO
  45. C
  46. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  47. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  48. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  49. C     &        ,IECHO,   IIMPI,  IOSPI
  50. C     &        ,IDIM,    IFICLE, IPREFI
  51. C     &        ,MCOORD
  52. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  53. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  54. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  55. C     &        ,NUCROU, IPSAUV
  56. C
  57.       INTEGER IJAC, IJACO
  58.      &     ,IDOMA, IDBOR, IRET, MELEMC, MELEFE, MELEMF, ICHPVO, INORM
  59.      &     ,ICHPSU, MELECB, NBCOMP, INDIC, MELEFC, MELRES
  60.      &     ,JGN, JGM, NBELEM, NBNN, NBSOUS, NBREF, NGF, NLC
  61.      &     ,I1, ICEN, N1, ILIINP
  62.      &     ,ILIINC, IROC, IVITC, IPC, IGAMC, ICHLIM, NBOPT, ILIM
  63.      &     ,ICHRES, ICHRLI
  64.      &     ,NKID,NKMT,NMATRI,NRIGE,MMODEL,INEFMD
  65.       PARAMETER (NBOPT=9)
  66.       CHARACTER*8 LOPT(NBOPT)
  67.       CHARACTER*4 MOT
  68.       CHARACTER*8 TYPE
  69. C
  70.       DATA LOPT/'INRI    ','OUTRI   ','INSS    ','OUTSS   ','OUTP    ',
  71.      &          'INSU    ','INJE    ','INJELM  ','INSO    '/
  72. C
  73. C*******************************
  74. C**** La table domaine *********
  75. C*******************************
  76. C
  77.       CALL LIROBJ('MMODEL  ',MMODEL,1,IRET)
  78.       CALL ACTOBJ('MMODEL  ',MMODEL,1)
  79.       IF(IERR.NE.0)GOTO 9999
  80.       CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  81. C     INEFMD inutilisé
  82.       IF(IERR .NE. 0)GOTO 9999
  83. C
  84.       CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  85.       IF(IERR .NE. 0) GOTO 9999
  86. C
  87.       CALL LEKTAB(IDOMA,'FACE',MELEMF)
  88.       IF(IERR .NE. 0) GOTO 9999
  89. C
  90. C**** Lecture du CHPOINT contenant les volumes
  91. C
  92.       CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  93.       IF(IERR .NE. 0) GOTO 9999
  94.       INDIC = 1
  95.       NBCOMP = 1
  96.       MOT = 'SCAL'
  97.       CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  98.       IF(IERR .NE. 0) GOTO 9999
  99. C
  100.       CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  101.       IF(IERR .NE. 0) GOTO 9999
  102.       INDIC = 1
  103.       NBCOMP = 1
  104.       MOT = 'SCAL'
  105.       CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  106.       IF(IERR .NE. 0) GOTO 9999
  107. C
  108. C**** Les normales aux faces
  109. C
  110.       IF(IDIM .EQ. 2)THEN
  111. C        Que les normales
  112.          CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  113.          IF(IERR .NE. 0) GOTO 9999
  114.          JGN = 4
  115.          JGM = 2
  116.          SEGINI MLMVIT
  117.          MLMVIT.MOTS(1) = 'UX  '
  118.          MLMVIT.MOTS(2) = 'UY  '
  119.          CALL QUEPO1(INORM, MELEMF, MLMVIT)
  120.          SEGSUP MLMVIT
  121.          IF(IERR .NE. 0) GOTO 9999
  122.       ELSE
  123. C
  124. C****    Les normales ('MX  ', ...)
  125. C        Les tangentes ('RX  ', ...)
  126. C
  127.          TYPE = ' '
  128.          CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  129.          IF (TYPE .NE. 'CHPOINT ') THEN
  130.             CALL MATRAN(IDOMA,INORM)
  131.             IF(IERR .NE. 0) GOTO 9999
  132.          ENDIF
  133.          JGN = 4
  134.          JGM = 9
  135.          SEGINI MLMVIT
  136.          MLMVIT.MOTS(1) = 'MX  '
  137.          MLMVIT.MOTS(2) = 'MY  '
  138.          MLMVIT.MOTS(3) = 'MZ  '
  139.          MLMVIT.MOTS(4) = 'RX  '
  140.          MLMVIT.MOTS(5) = 'RY  '
  141.          MLMVIT.MOTS(6) = 'RZ  '
  142.          MLMVIT.MOTS(7) = 'UX  '
  143.          MLMVIT.MOTS(8) = 'UY  '
  144.          MLMVIT.MOTS(9) = 'UZ  '
  145.          CALL QUEPO1(INORM, MELEMF, MLMVIT)
  146.          SEGSUP MLMVIT
  147.       ENDIF
  148. C
  149. C**********************************
  150. C**** La table domaine du bord ****
  151. C**********************************
  152. C
  153.       CALL LIROBJ('MMODEL  ',MMODEL,1,IRET)
  154.       CALL ACTOBJ('MMODEL  ',MMODEL,1)
  155.       IF(IERR.NE.0)GOTO 9999
  156.       CALL LEKMOD(MMODEL,IDBOR,INEFMD)
  157. C     INEFMD inutilisé
  158.       IF(IERR .NE. 0)GOTO 9999
  159. C
  160.       CALL LEKTAB(IDBOR,'CENTRE',MELECB)
  161.       IF(IERR .NE. 0) GOTO 9999
  162. C
  163.       TYPE = ' '
  164.       CALL ACMO(IDBOR,'FACCEN',TYPE,MELEFC)
  165.       IF (TYPE.NE.'MAILLAGE') THEN
  166. C
  167.          CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  168.          IF(IERR .NE. 0) GOTO 9999
  169. C
  170. C******* On cree la connectivité face-centre
  171. C
  172.          IPT1=MELECB
  173.          IPT2=MELEFE
  174.          SEGACT IPT1
  175.          SEGACT IPT2
  176.          CALL KRIPAD(IPT1,MLENTI)
  177. C        SEGINI MLENTI
  178.          NBELEM=IPT1.NUM(/2)
  179.          NBNN=2
  180.          NBSOUS=0
  181.          NBREF=0
  182.          SEGINI IPT3
  183.          IPT3.ITYPEL=2
  184.          N1=IPT2.NUM(/2)
  185.          ICEN=0
  186.          DO I1=1,N1,1
  187.             NGF=IPT2.NUM(2,I1)
  188.             NLC=MLENTI.LECT(NGF)
  189.             IF(NLC.NE.0)THEN
  190.                ICEN=ICEN+1
  191.                IPT3.NUM(1,ICEN)=NGF
  192.                IPT3.NUM(2,ICEN)=IPT2.NUM(1,I1)
  193.                IF(IPT2.NUM(1,I1) .NE. IPT2.NUM(3,I1))THEN
  194. C                Interior point
  195. C                Donné incompatible
  196.                   WRITE(IOIMP,*) 'Internal boundary condition!!!'
  197.                   CALL ERREUR(21)
  198.                ENDIF
  199.             ENDIF
  200.          ENDDO
  201. C
  202.          IF(ICEN .NE. NBELEM)THEN
  203.             CALL ERREUR(5)
  204.          ENDIF
  205.          SEGDES IPT1
  206.          SEGDES IPT2
  207.          SEGDES IPT3
  208.          SEGSUP MLENTI
  209. C
  210.          MELEFC=IPT3
  211.          CALL ECMO(IDBOR,'FACCEN','MAILLAGE',IPT3)
  212.       ENDIF
  213. C
  214. C**** Le SPG du residu
  215. C
  216.       IPT1=MELEFC
  217.       SEGACT IPT1
  218.       NBELEM=IPT1.NUM(/2)
  219.       NBNN=1
  220.       NBSOUS=0
  221.       NBREF=0
  222.       SEGINI IPT2
  223.       IPT2.ITYPEL=1
  224.       DO I1=1,NBELEM,1
  225.          IPT2.NUM(1,I1)=IPT1.NUM(2,I1)
  226.       ENDDO
  227.       MELRES=IPT2
  228.       SEGDES IPT1
  229.       SEGDES IPT2
  230. C
  231. C**** Noms de variables conservatives
  232. C
  233.       TYPE='LISTMOTS'
  234.       CALL LIROBJ(TYPE,ILIINC,1,IRET)
  235.       IF(IERR .NE. 0) GOTO 9999
  236.       MLMOTS = ILIINC
  237.       SEGACT MLMOTS
  238.       NBCOMP = MLMOTS.MOTS(/2)
  239.       SEGDES MLMOTS
  240.       IF(NBCOMP .NE. (IDIM+2))THEN
  241.          MOTERR(1:40) = 'LISTINCO = ???'
  242.          WRITE(IOIMP,*) MOTERR
  243. C
  244. C******* Message d'erreur standard
  245. C        21 2
  246. C        Données incompatibles
  247. C
  248.          CALL ERREUR(21)
  249.          GOTO 9999
  250.       ENDIF
  251. C
  252. C**** Noms de variables primitives
  253. C
  254.       TYPE='LISTMOTS'
  255.       CALL LIROBJ(TYPE,ILIINP,1,IRET)
  256.       IF(IERR .NE. 0) GOTO 9999
  257.       MLMOTS = ILIINP
  258.       SEGACT MLMOTS
  259.       NBCOMP = MLMOTS.MOTS(/2)
  260.       SEGDES MLMOTS
  261.       IF(NBCOMP .NE. (IDIM+2))THEN
  262.          MOTERR(1:40) = 'LISTPRIM = ???'
  263.          WRITE(IOIMP,*) MOTERR
  264. C
  265. C******* Message d'erreur standard
  266. C        21 2
  267. C        Données incompatibles
  268. C
  269.          CALL ERREUR(21)
  270.          GOTO 9999
  271.       ENDIF
  272. C
  273. C**** Lecture du CHPOINT RN
  274. C
  275.       TYPE='CHPOINT '
  276.       CALL LIROBJ(TYPE,IROC,1,IRET)
  277.       CALL ACTOBJ(TYPE,IROC,1)
  278.       IF (IERR.NE.0) GOTO 9999
  279. C
  280. C**** Control du CHPOINT: QUEPOI
  281. C
  282. C     INDIC = 1   -> on impose le pointeur du support geometrique
  283. C     NBCOMP > 0 -> nombre des composantes
  284. C
  285.       INDIC = 1
  286.       NBCOMP = 1
  287.       MOT = 'SCAL'
  288.       CALL QUEPOI(IROC, MELEMC, INDIC, NBCOMP, MOT)
  289.       IF(IERR .NE. 0)GOTO 9999
  290. C
  291. C**** Lecture du CHPOINT VITC
  292. C
  293.       CALL LIROBJ('CHPOINT ',IVITC,1,IRET)
  294.       CALL ACTOBJ('CHPOINT ',IVITC,1)
  295.       IF (IERR.NE.0) GOTO 9999
  296. C
  297. C**** Control du CHPOINT
  298. C
  299.       JGN = 4
  300.       JGM = IDIM
  301.       SEGINI MLMVIT
  302.       MLMVIT.MOTS(1) = 'UX  '
  303.       MLMVIT.MOTS(2) = 'UY  '
  304.       IF(IDIM .EQ. 3)  MLMVIT.MOTS(3) = 'UZ  '
  305.       CALL QUEPO1(IVITC, MELEMC, MLMVIT)
  306.       SEGSUP MLMVIT
  307.       IF(IERR .NE. 0)GOTO 9999
  308. C
  309. C**** Lecture du CHPOINT PC
  310. C
  311.       CALL LIROBJ('CHPOINT ',IPC,1,IRET)
  312.       CALL ACTOBJ('CHPOINT ',IPC,1)
  313.       IF (IERR.NE.0) GOTO 9999
  314. C
  315. C**** Control du CHPOINT
  316. C
  317.       INDIC = 1
  318.       NBCOMP = 1
  319.       MOT = 'SCAL'
  320.       CALL QUEPOI(IPC, MELEMC, INDIC, NBCOMP, MOT)
  321.       IF(IERR .NE. 0)GOTO 9999
  322. C
  323. C**** Lecture du CHPOINT GAMC
  324. C
  325.       CALL LIROBJ('CHPOINT ',IGAMC,1,IRET)
  326.       CALL ACTOBJ('CHPOINT ',IGAMC,1)
  327.       IF (IERR.NE.0) GOTO 9999
  328. C
  329. C**** Control du CHPOINT
  330. C
  331.       INDIC = 1
  332.       NBCOMP = 1
  333.       MOT = 'SCAL'
  334.       CALL QUEPOI(IGAMC, MELEMC, INDIC, NBCOMP, MOT)
  335.       IF(IERR .NE. 0)GOTO 9999
  336. C
  337. C**** CHPOINT condition limite
  338. C
  339.       CALL LIROBJ('CHPOINT',ICHLIM,1,IRET)
  340.       CALL ACTOBJ('CHPOINT',ICHLIM,1)
  341.       IF (IERR.NE.0) GOTO 9999
  342. C
  343. C**** Resultats
  344. C
  345.       IF(IJAC .EQ.0)THEN
  346.          TYPE='        '
  347.          CALL KRCHP1(TYPE,MELRES,ICHRES,ILIINC)
  348. C
  349.          TYPE='        '
  350.          CALL KRCHP1(TYPE,MELECB,ICHRLI,ILIINP)
  351.       ELSE
  352.          ICHRES=0
  353.          ICHRLI=0
  354.       ENDIF
  355. C
  356. C**** TYPE DE CONDITION LIMITE
  357. C
  358.       CALL LIRMOT(LOPT,NBOPT,ILIM,1)
  359.       IF(IERR .NE. 0) GOTO 9999
  360.       IF(ILIM .EQ. 1)THEN
  361. C
  362. C********  'INRI    '
  363. C
  364.          JGN = 4
  365.          JGM = IDIM+2
  366.          SEGINI MLMVIT
  367.          MLMVIT.MOTS(1) = 'RN  '
  368.          MLMVIT.MOTS(2) = 'UX  '
  369.          MLMVIT.MOTS(3) = 'UY  '
  370.          IF(IDIM .EQ. 3)  MLMVIT.MOTS(4) = 'UZ  '
  371.          MLMVIT.MOTS(2+IDIM)='PN  '
  372.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  373.          SEGSUP MLMVIT
  374.          IF (IERR.NE.0) GOTO 9999
  375. C
  376.          IF(IJAC.EQ.0)THEN
  377.             CALL CLI111(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  378.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  379.             IF(IERR.NE.0)GOTO 9999
  380.          ELSE
  381.             IF(IDIM.EQ.2)THEN
  382.                CALL CLI112(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  383.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  384.      $              ,ILIINP,IJAC,IJACO)
  385.             ELSE
  386.                CALL CLI113(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  387.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  388.      $              ,ILIINP,IJAC,IJACO)
  389.             ENDIF
  390.             IF(IERR.NE.0)GOTO 9999
  391.          ENDIF
  392.       ELSEIF(ILIM .EQ. 2)THEN
  393. C
  394. C********  'OUTRI   '
  395. C
  396.          JGN = 4
  397.          JGM = IDIM+2
  398.          SEGINI MLMVIT
  399.          MLMVIT.MOTS(1) = 'RN  '
  400.          MLMVIT.MOTS(2) = 'UX  '
  401.          MLMVIT.MOTS(3) = 'UY  '
  402.          IF(IDIM .EQ. 3)  MLMVIT.MOTS(4) = 'UZ  '
  403.          MLMVIT.MOTS(2+IDIM)='PN  '
  404.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  405.          SEGSUP MLMVIT
  406.          IF (IERR.NE.0) GOTO 9999
  407. C
  408.          IF(IJAC.EQ.0)THEN
  409.             CALL CLI121(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  410.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  411.             IF(IERR.NE.0)GOTO 9999
  412.          ELSE
  413.             IF(IDIM.EQ.2)THEN
  414.                CALL CLI122(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  415.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  416.      $              ,ILIINP,IJAC,IJACO)
  417.             ELSE
  418.                CALL CLI123(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  419.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  420.      $              ,ILIINP,IJAC,IJACO)
  421.             ENDIF
  422.             IF(IERR.NE.0)GOTO 9999
  423.          ENDIF
  424.       ELSEIF(ILIM .EQ. 3)THEN
  425. C
  426. C********  'INSS    '
  427. C
  428.          JGN = 4
  429.          JGM = IDIM+2
  430.          SEGINI MLMVIT
  431.          MLMVIT.MOTS(1) = 'RN  '
  432.          MLMVIT.MOTS(2) = 'UX  '
  433.          MLMVIT.MOTS(3) = 'UY  '
  434.          IF(IDIM .EQ. 3)  MLMVIT.MOTS(4) = 'UZ  '
  435.          MLMVIT.MOTS(2+IDIM)='PN  '
  436.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  437.          SEGSUP MLMVIT
  438.          IF (IERR.NE.0) GOTO 9999
  439. C
  440.          IF(IJAC.EQ.0)THEN
  441.             CALL CLI131(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  442.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  443.             IF(IERR.NE.0)GOTO 9999
  444.          ELSE
  445. *           Le Jacobien est une matrik vide
  446.             NRIGE=7
  447.             NMATRI=0
  448.             NKID =9
  449.             NKMT =7
  450.             SEGINI MATRIK
  451.             SEGDES MATRIK
  452.             IJACO=MATRIK
  453.          ENDIF
  454.       ELSEIF(ILIM .EQ. 4)THEN
  455. C
  456. C********  'OUTSS   '
  457. C
  458. C        ICHLIM est un CHPOINT vide
  459. C        Mais on fait pas de controlle
  460. C
  461.          IF(IJAC.EQ.0)THEN
  462.             CALL CLI141(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  463.      &           IROC,IVITC,IPC,IGAMC,ICHRES,ICHRLI)
  464.             IF(IERR.NE.0)GOTO 9999
  465.          ELSE
  466.             IF(IDIM.EQ.2)THEN
  467.                CALL CLI142(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  468.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC
  469.      $              ,ILIINP,IJAC,IJACO)
  470.             ELSE
  471.                CALL CLI143(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  472.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC
  473.      $              ,ILIINP,IJAC,IJACO)
  474.             ENDIF
  475.             IF(IERR.NE.0)GOTO 9999
  476.          ENDIF
  477.       ELSEIF(ILIM .EQ. 5)THEN
  478. C
  479. C********  'OUTP   '
  480. C
  481.          JGN = 4
  482.          JGM = 1
  483.          SEGINI MLMVIT
  484.          MLMVIT.MOTS(1)='PN  '
  485.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  486.          SEGSUP MLMVIT
  487.          IF (IERR.NE.0) GOTO 9999
  488. C
  489.          IF(IJAC.EQ.0)THEN
  490.             CALL CLI151(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  491.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  492.             IF(IERR.NE.0)GOTO 9999
  493.          ELSE
  494.             IF(IDIM.EQ.2)THEN
  495.                CALL CLI152(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  496.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  497.      $              ,ILIINP,IJAC,IJACO)
  498.             ELSE
  499.                CALL CLI153(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  500.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  501.      $              ,ILIINP,IJAC,IJACO)
  502.             ENDIF
  503.          ENDIF
  504.       ELSEIF(ILIM .EQ. 6)THEN
  505. C
  506. C********  'INSU    '
  507. C
  508.          JGN = 4
  509.          JGM = 2
  510.          SEGINI MLMVIT
  511.          MLMVIT.MOTS(1) = 'HT  '
  512.          MLMVIT.MOTS(2) = 'S   '
  513.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  514.          SEGSUP MLMVIT
  515.          IF (IERR.NE.0) GOTO 9999
  516. C
  517.          IF(IJAC.EQ.0)THEN
  518.             CALL CLI161(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  519.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  520.             IF(IERR.NE.0)GOTO 9999
  521.          ELSE
  522.             IF(IDIM.EQ.2)THEN
  523.                CALL CLI162(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  524.      &              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  525.      &              ,ILIINP,IJAC,IJACO)
  526.             ELSE
  527.                CALL CLI163(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  528.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  529.      $              ,ILIINP,IJAC,IJACO)
  530.             ENDIF
  531.          ENDIF
  532.       ELSEIF(ILIM .EQ. 7)THEN
  533. C
  534. C********  'INJE    '
  535. C
  536.          JGN = 4
  537.          JGM = 2
  538.          SEGINI MLMVIT
  539.          MLMVIT.MOTS(1) = 'MOME'
  540.          MLMVIT.MOTS(2) = 'RT  '
  541.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  542.          SEGSUP MLMVIT
  543.          IF (IERR.NE.0) GOTO 9999
  544. C
  545.          IF(IJAC.EQ.0)THEN
  546.             CALL CLI181(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  547.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  548.             IF(IERR.NE.0)GOTO 9999
  549.          ELSE
  550.             IF(IDIM.EQ.2)THEN
  551.                CALL CLI182(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  552.      &              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  553.      &              ,ILIINP,IJAC,IJACO)
  554.             ELSE
  555.                CALL CLI183(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  556.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  557.      $              ,ILIINP,IJAC,IJACO)
  558.             ENDIF
  559.          ENDIF
  560.       ELSEIF(ILIM .EQ. 8)THEN
  561. C
  562. C********  'INJELM  '
  563. C
  564.          JGN = 4
  565.          JGM = 2
  566.          SEGINI MLMVIT
  567.          MLMVIT.MOTS(1) = 'MOME'
  568.          MLMVIT.MOTS(2) = 'RT  '
  569.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  570.          SEGSUP MLMVIT
  571.          IF (IERR.NE.0) GOTO 9999
  572. C
  573.          IF(IJAC.EQ.0)THEN
  574.             CALL CLI171(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  575.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  576.             IF(IERR.NE.0)GOTO 9999
  577.          ELSE
  578.             IF(IDIM.EQ.2)THEN
  579.                CALL CLI172(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  580.      &              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  581.      &              ,ILIINP,IJAC,IJACO)
  582.             ELSE
  583.                CALL CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  584.      $              ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  585.      $              ,ILIINP,IJAC,IJACO)
  586.             ENDIF
  587.          ENDIF
  588.       ELSEIF(ILIM .EQ. 9)THEN
  589. C
  590. C********  'INSO  '
  591. C
  592.          JGN = 4
  593.          JGM = 2
  594.          SEGINI MLMVIT
  595.          MLMVIT.MOTS(1) = 'PSTA'
  596.          MLMVIT.MOTS(2) = 'RSTA'
  597.          CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  598.          SEGSUP MLMVIT
  599.          IF (IERR.NE.0) GOTO 9999
  600. C
  601.          IF(IJAC.EQ.0)THEN
  602.             CALL CLI191(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  603.      &           IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  604.             IF(IERR.NE.0)GOTO 9999
  605.          ENDIF
  606.       ENDIF
  607. C
  608.       IF(IJAC.EQ.0)THEN
  609.          CALL ACTOBJ('CHPOINT ',ICHRES,1)
  610.          CALL ACTOBJ('CHPOINT ',ICHRLI,1)
  611.  
  612.          CALL ECROBJ('CHPOINT ',ICHRES)
  613.          CALL ECROBJ('CHPOINT ',ICHRLI)
  614.       ELSE
  615.          CALL ECROBJ('MATRIK  ',IJACO)
  616.       ENDIF
  617. C
  618.  9999 CONTINUE
  619.       END
  620.  
  621.  
  622.  
  623.  

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