Télécharger la plaquette Cast3M


fr en

Télécharger znske.eso

Retour à la liste

Numérotation des lignes : 

znske

  1. C ZNSKE     SOURCE    FANDEUR   22/01/03    21:16:04     11136          
  2.       SUBROUTINE ZNSKE(MTABX,MTAB1)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C  CET OPERATEUR DISCRETISE LES EQUATIONS DE NAVIER STOKES COUPLEES
  8. C  AUX DEUX EQUATIONS DU MODELE K - EPSILON
  9. C    EN 2D SUR LES ELEMENTS QUA4 ET TRI3      PLAN OU AXI
  10. C    EN 3D SUR LES ELEMENTS CUB8 ET PRI6
  11. C  LES OPERATEURS SONT "SOUS-INTEGRES"
  12. C
  13. C  SYNTAXE :
  14. C  ---------
  15. C    1/ Cas incompréssible
  16. C
  17. C du/dt + u Grad u = (nu+nut) Lapl u - 1/ro Grad p  < + S >
  18. C                                             < + g beta (T-Tref) >
  19. C
  20. C   'OPER' 'NSKE' nu nut            'INCO' UN :
  21. C   'OPER' 'NSKE' nu nut s          'INCO' UN :
  22. C   'OPER' 'NSKE' nu nut gb tn tref 'INCO' UN :
  23. C
  24. C
  25. C    2/ Cas compréssible
  26. C
  27. C dG/dt + u Grad G + G Div u = (mu+mut)(Lapl u + 1/3 Grad Div u)
  28. C                              - Grad p   < + S >
  29. C
  30. C   'OPER' 'NSKE' ro mu mut un    'INCO' GN :
  31. C   'OPER' 'NSKE' ro mu mut un S  'INCO' GN :
  32. C
  33. C    ro   densité
  34. C         FLOTTANT ou CHPOINT SCAL CENTRE
  35. C    nu,mu viscosité cinématique (resp. dynamique) moléculaire
  36. C         FLOTTANT ou CHPOINT SCAL CENTRE
  37. C    nut,mut viscosité cinématique (resp. dynamique) turbulente
  38. C         CHPOINT SCAL CENTRE
  39. C    s    source volumique de qdm
  40. C         POINT ou CHPOINT VECT CENTRE
  41. C    gb   coéfficient de flottabilité (g*beta où g est l'accéllération
  42. C         de la pesanteur et beta le coéfficient de dilatabilité)
  43. C         POINT ou CHPOINT VECT CENTRE
  44. C    tn   Champ de température CHPOINT SCAL SOMMET
  45. C    tref température de référence
  46. C         FLOTTANT ou CHPOINT SCAL SOMMET
  47. C
  48. C         Champ de vitesse                       -> VITESS
  49. C    un   Champ de vitesse transportant          -> UTRANS
  50. C         CHPOINT VECT SOMMET
  51. C    gn   Champ de vitesse massique (transporté) -> IZTU1  (Inconnue)
  52. C         CHPOINT VECT SOMMET
  53. C    kn   Energie cinétique turbulente
  54. C         CHPOINT SCAL SOMMET
  55. C    en   Taux de disparition de k
  56. C         CHPOINT SCAL SOMMET
  57. C    Constantes du modèle K - Epsilon
  58. C         cnu = 0.09 c1 = 1.41 c2 = 1.92
  59. C
  60. C************************************************************************
  61.  
  62.  
  63. -INC PPARAM
  64. -INC CCOPTIO
  65. -INC CCGEOME
  66. -INC SIZFFB
  67.       POINTEUR IZF1.IZFFM
  68. -INC SMCHAML
  69. -INC SMCOORD
  70. -INC SMLENTI
  71.       POINTEUR IPADI.MLENTI,IPADU.MLENTI,IPADF.MLENTI,IPADS.MLENTI
  72.       POINTEUR IPADQ.MLENTI
  73. -INC SMELEME
  74.       POINTEUR MELEM1.MELEME,MELEMC.MELEME,MELEMS.MELEME,MELEMI.MELEME
  75.       POINTEUR MELEP1.MELEME
  76. -INC SMCHPOI
  77.       POINTEUR IZG1.MCHPOI, IZG3.MCHPOI
  78.       POINTEUR IZGG1.MPOVAL,IZGG2.MPOVAL,IZGG3.MPOVAL
  79.       POINTEUR IZGDD2.MPOVAL,IZGDD3.MPOVAL
  80.       POINTEUR IZDD2.MPOVAL,IZDD3.MPOVAL
  81.       POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL
  82.       POINTEUR VITESS.MPOVAL,UTRANS.MPOVAL
  83.       POINTEUR MZNU.MPOVAL,MZGB.MPOVAL,MZTN.MPOVAL,MZTR.MPOVAL
  84.       POINTEUR MZRO.MPOVAL
  85.       POINTEUR MZNT.MPOVAL
  86.       POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL
  87.       POINTEUR MCHVOL.MCHPOI,IZG2.MCHPOI,IZGD2.MCHPOI
  88.       POINTEUR IZD2.MCHPOI,IZGD3.MCHPOI,IZD3.MCHPOI
  90.       POINTEUR IPM.IZAFM
  91.  
  92.       SEGMENT IMATRS
  93.       INTEGER LIZAFS(NBSOUS,NBME)
  94.       ENDSEGMENT
  95.       POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM
  96.  
  97. -INC SMLMOTS
  98.       POINTEUR LINCO.MLMOTS
  99.       CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,TYPC,NOM,NOM0
  100.       PARAMETER (NTB=1)
  101.       CHARACTER*8 LTAB(NTB)
  102.       DIMENSION KTAB(NTB),IXV(3),RO(1)
  103.       SAVE IPAS
  104.       DATA LTAB/'KIZX    '/,IPAS/0/,RO/1.D0/
  105. C*****************************************************************************
  106. CNSKE
  107. C     write(6,*)' DEBUT NSKE '
  108.  
  109. C
  110. C- Récupération de la table INCO (pointeur KINC)
  111. C
  112.       CALL LEKTAB(MTAB1,'INCO',KINC)
  113.       IF(KINC.EQ.0)THEN
  114. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  115.          MOTERR( 1: 8) = '  INCO  '
  116.          MOTERR( 9:16) = '  INCO  '
  117.          MOTERR(17:24) = '  EQEX  '
  118.          CALL ERREUR(786)
  119.          RETURN
  120.       ENDIF
  121.  
  122. C*****************************************************************************
  123. C OPTIONS
  124. C KIMPL = 0 -> EXPL     1 -> IMPL     2 -> SEMI
  125. C KFORM = 0 -> SI       1 -> EF       2 -> VF    3 -> EFMC
  126. C IDCEN = 0-> rien  1-> CENTREE  2-> SUPGDC  3-> SUPG  4-> TVISQUEU  5-> CNG
  127.  
  128.       IAXI=0
  129.       IF(IFOMOD.EQ.0)IAXI=2
  130. C
  131. C- Récupération de la table des options KOPT (pointeur KOPTI)
  132. C
  133.       CALL LEKTAB(MTABX,'KOPT',KOPTI)
  134.       IF (KOPTI.EQ.0) THEN
  135. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  136.          MOTERR( 1: 8) = '  KOPT  '
  137.          MOTERR( 9:16) = '  KOPT  '
  138.          MOTERR(17:24) = '  KIZX  '
  139.          CALL ERREUR(786)
  140.          RETURN
  141.       ENDIF
  142.  
  143.       CALL ACME(KOPTI,'MTRMASS ',MMPG)
  144.       IPG=0
  145.       IF(MMPG.EQ.3)IPG=1
  146.       CALL ACME(KOPTI,'IDCEN',IDCEN)
  147.       CALL ACME(KOPTI,'RNG   ',IMODEL)
  148.       CALL ACME(KOPTI,'IKOMP',IKOMP)
  149.       CALL ACME(KOPTI,'KIMPL',KIMPL)
  150.       CALL ACME(KOPTI,'KPOIN',KPRE)
  151.       CALL ACME(KOPTI,'KFORM',KFORM)
  152.       CALL ACME(KOPTI,'KMACO',KMACO)
  153.       CALL ACMF(KOPTI,'AIMPL',AIMPL)
  154.  
  155.       IF (IERR.NE.0) RETURN
  156.  
  157.       IF(KFORM.NE.0.AND.KFORM.NE.1)THEN
  158. C        Option %m1:8 incompatible avec les données
  159.             MOTERR( 1: 8) = 'EF/EFM1 '
  160.             CALL ERREUR(803)
  161.             RETURN
  162.         ENDIF
  163.  
  164.       IF(KFORM.NE.0.AND.KPRE.NE.2)THEN
  165. C        Option %m1:8 incompatible avec les données
  166.             MOTERR( 1: 8) = 'EFM1 '
  167.             CALL ERREUR(803)
  168.             RETURN
  169.         ENDIF
  170.  
  171. C     write(6,*)' Apres les options '
  172. C*****************************************************************************
  173. C
  174. C- Récupération de la table DOMAINE associée au domaine local
  175. C
  176.       CALL ACMM(MTABX,'NOMZONE',NOMZ)
  177.       CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  178.       IF(MTABZ.EQ.0)THEN
  179. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  180.          MOTERR( 1: 8) = '  DOMZ  '
  181.          MOTERR( 9:16) = '  DOMZ  '
  182.          MOTERR(17:24) = '  KIZX  '
  183.          CALL ERREUR(786)
  184.          RETURN
  185.       ENDIF
  186.  
  187.       CALL LEKTAB(MTABZ,'MAILLAGE',MELEME)
  188.       CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
  189.       CALL LEKTAB(MTABZ,'SOMMET',MELEMS)
  190.       IF (IERR.NE.0) RETURN
  191.  
  192.       MELEMQ=MELEMC
  193.       MELEP1=MELEMC
  194.  
  195.       IF(KPRE.NE.2)THEN
  196.       CALL LEKTAB(MTABZ,'MACRO',MACRO)
  197.       CALL LEKTAB(MTABZ,'MACRO1',MELEMI)
  198.       CALL LEKTAB(MTABZ,'QUADRATI',MQUAD)
  199.       IF(KPRE.EQ.3)THEN
  200.       CALL LEKTAB(MTABZ,'CENTREP0',MELEMQ)
  201.       MELEP1=MELEMQ
  202.       ELSEIF(KPRE.EQ.4)THEN
  203.       CALL LEKTAB(MTABZ,'CENTREP1',MELEMQ)
  204.       CALL LEKTAB(MTABZ,'ELTP1NC ',MELEP1)
  205.       ENDIF
  206.       ENDIF
  207.  
  208. C*************************************************************************
  209. C VERIFICATIONS SUR LES INCONNUES
  210. C
  211. C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI
  212. C
  213.       TYPE='LISTMOTS'
  214.       CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO)
  215.       IF (IERR.NE.0) RETURN
  216.       SEGACT LINCO
  217.       NBINC=LINCO.MOTS(/2)
  218.       IF(NBINC.NE.3)THEN
  219. C        Indice %m1:8 : contient plus de %i1 %m9:16
  220.          MOTERR( 1:8) = 'LISTINCO'
  221.          INTERR(1) = 3
  222.          MOTERR(9:16) = ' MOTS   '
  223.          CALL ERREUR(799)
  224.          RETURN
  225.       ENDIF
  226.  
  227.       NOMI=LINCO.MOTS(1)
  228.       NOMA=NOMI
  229. C
  230. C- Récupération de l'inconnue
  231. C
  232.       TYPE=' '
  233.       CALL ACMO(KINC,NOMI,TYPE,MCHPOI)
  234.       IF(TYPE.NE.'CHPOINT ')THEN
  235. C        Indice %m1:8 : ne contient pas un objet de type %m9:16
  236.          MOTERR( 1: 8) = 'INC '//NOMI
  237.          MOTERR( 9:16) = 'CHPOINT '
  238.          CALL ERREUR(800)
  239.          RETURN
  240.       ELSE
  241.       CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1)
  242.          NINKO = IZTU1.VPOCHA(/2)
  243.          IF (NINKO.NE.IDIM) THEN
  244. C        Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
  245.             MOTERR( 1: 8) = 'INC '//NOMI
  246.             MOTERR( 9:16) = 'CHPOINT '
  247.             CALL ERREUR(784)
  248.             RETURN
  249.          ENDIF
  250. C     write(6,*)' MCHPOI,MELEM1=',MCHPOI,MELEM1
  251. C On fait pointer ces deux tableaux sur le champ U inconu (tjs présent) pour
  252. C eviter de les enlever lors de l'appel FORTRAN si les options sont absentes
  253.       UTRANS=IZTU1
  254.       IKW=0
  255.       VITESS=IZTU1
  256.       ENDIF
  257.  
  258. C*****************************************************************************
  259. C Le domaine de definition est donne par le SPG  de la premiere inconnue
  260. C Les inconnues suivantes devront posseder ce meme pointeur
  261. C On verifie que les points de la zone sont tous inclus dans ce SPG
  262.  
  263.       CALL KRIPAD(MELEM1,IPADI)
  264.       IPADS=IPADI
  265.       IPADD=IPADI
  266.       IPADU=IPADI
  267.       IF(MELEM1.NE.MELEMS)CALL KRIPAD(MELEMS,IPADS)
  268.  
  269.       IF(IPAS.EQ.0)THEN
  270.       IPAS=1
  271.       CALL VERPAD(IPADI,MELEME,IRET)
  272.       IF(IRET.NE.0)THEN
  273. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  274.          MOTERR(1: 8) = 'INC '//NOMI
  275.          MOTERR(9:16) = 'CHPOINT '
  276.          CALL ERREUR(788)
  277.       RETURN
  278.       ENDIF
  279.       ENDIF
  280.  
  281. C*************************************************************************
  282. C Lecture du coefficient
  283. C Type du coefficient :
  284. C IK1=0 CHPOINT IK1=1 scalaire  IK1=2 vecteur
  285.  
  286. C     write(6,*)' Opérateur NSKE lecture des coefficients'
  287.       CALL ACME(MTABX,'IARG',IARG)
  288.       IF(IKOMP.EQ.0)THEN
  289.       IF(IARG.NE.2.AND.IARG.NE.3.AND.IARG.NE.5)THEN
  290.       WRITE(6,*)' Opérateur NSKE : option incompréssible '
  291.       WRITE(6,*)' Nombre d''arguments incorrect : ',IARG
  292.       WRITE(6,*)' On attend 2 , 3 ou 5 '
  293. C           Indice %m1:8 : nombre d'arguments incorrect
  294.             MOTERR(1:8) = 'IARG    '
  295.             CALL ERREUR(804)
  296.       RETURN
  297.       ENDIF
  298.       ELSEIF(IKOMP.EQ.1)THEN
  299.       IF(IARG.NE.4.AND.IARG.NE.5)THEN
  300.       WRITE(6,*)' Opérateur NSKE : option compréssible '
  301.       WRITE(6,*)' Nombre d''arguments incorrect : ',IARG
  302.       WRITE(6,*)' On attend 4 ou 5 '
  303. C           Indice %m1:8 : nombre d'arguments incorrect
  304.             MOTERR(1:8) = 'IARG    '
  305.             CALL ERREUR(804)
  306.       RETURN
  307.       ENDIF
  308.       ENDIF
  309.  
  310. C--Cas incompréssible
  311.       IF(IKOMP.EQ.0)THEN
  312.  
  313.       MZRO=IZTU1
  314.  
  315. C 1er coefficient : nu
  316.       IXV(1)=MELEMC
  317.       IXV(2)=1
  318.       IXV(3)=0
  319.       CALL LEKCOF('Opérateur NSKE :',
  320.      & MTABX,KINC,1,IXV,MNU,MZNU,NPT1,NC1,IKN,IRET)
  321.       IF(IRET.EQ.0)RETURN
  322.  
  323.       MZGB=MZNU
  324.       MZTN=MZNU
  325.       MZTR=MZNU
  326.  
  327. C 2ème coefficient : nut
  328.       IXV(1)=MELEMC
  329.       IXV(2)=0
  330.       IXV(3)=0
  331.       CALL LEKCOF('Opérateur NSKE :',
  332.      & MTABX,KINC,2,IXV,MNT,MZNT,NPT2,NC2,IKNT,IRET)
  333.       IF(IRET.EQ.0)RETURN
  334.  
  335.       IF(IARG.GE.3)THEN
  336. C 3ème coefficient : gbeta
  337.       IXV(1)=-MELEMC
  338.       IXV(2)=0
  339.       IXV(3)=1
  340.       CALL LEKCOF('Opérateur NSKE :',
  341.      & MTABX,KINC,3,IXV,MGB,MZGB,NELG,NC3,IKG,IRET)
  342.       IF(IRET.EQ.0)RETURN
  343.  
  344.       IF(IKG.EQ.2)IKG=1
  345.  
  346.       IF(IARG.EQ.5)THEN
  347.  
  348. C 4ème coefficient : tn
  349.       IXV(1)=MELEMS
  350.       IXV(2)=1
  351.       IXV(3)=0
  352.       CALL LEKCOF('Opérateur NSKE :',
  353.      & MTABX,KINC,4,IXV,MTN,MZTN,NPT4,NC4,IKTN,IRET)
  354.       IF(IRET.EQ.0)RETURN
  355.  
  356. C 5ème coefficient : tref
  357.       IXV(1)=MELEMS
  358.       IXV(2)=1
  359.       IXV(3)=0
  360.       CALL LEKCOF('Opérateur NSKE :',
  361.      & MTABX,KINC,5,IXV,MTR,MZTR,NPT5,NC5,IKTR,IRET)
  362.       IF(IRET.EQ.0)RETURN
  363.  
  364.       ENDIF
  365.       ENDIF
  366.  
  367. C--Cas compréssible
  368.       ELSEIF(IKOMP.EQ.1)THEN
  369. C 1er coefficient : ro
  370.       IXV(1)=MELEMC
  371.       IXV(2)=1
  372.       IXV(3)=0
  373.       CALL LEKCOF('Opérateur NSKE :',
  374.      & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NCR,IKR,IRET)
  375.       IF(IRET.EQ.0)RETURN
  376.  
  377.       MZGB=MZRO
  378.       MZTN=MZRO
  379.       MZTR=MZRO
  380.  
  381. C 2ème coefficient : mu
  382.       IXV(1)=MELEMC
  383.       IXV(2)=1
  384.       IXV(3)=0
  385.       CALL LEKCOF('Opérateur NSKE :',
  386.      & MTABX,KINC,2,IXV,MNU,MZNU,NPT2,NC2,IKN,IRET)
  387.       IF(IRET.EQ.0)RETURN
  388.  
  389. C 3ème coefficient : mut
  390.       IXV(1)=MELEMC
  391.       IXV(2)=0
  392.       IXV(3)=0
  393.       CALL LEKCOF('Opérateur NSKE :',
  394.      & MTABX,KINC,3,IXV,MNT,MZNT,NPT3,NC3,IKNT,IRET)
  395.       IF(IRET.EQ.0)RETURN
  396.  
  397. C 4ème coefficient : un (en compréssible)
  398.       IXV(1)=-MELEMS
  399.       IXV(2)=0
  400.       IXV(3)=0
  401.       CALL LEKCOF('Opérateur NSKE :',
  402.      & MTABX,KINC,4,IXV,MUN,UTRANS,NPT4,NC4,IK4,IRET)
  403.       IPADU=IPADS
  404.       IF(IRET.EQ.0)RETURN
  405.  
  406.       IF(IARG.EQ.5)THEN
  407. C 5ème coefficient : s (en compréssible)
  408.       IXV(1)=-MELEMC
  409.       IXV(2)=0
  410.       IXV(3)=1
  411.       CALL LEKCOF('Opérateur NSKE :',
  412.      & MTABX,KINC,5,IXV,MGB,MZGB,NELG,NC5,IKG,IRET)
  413.       IF(IRET.EQ.0)RETURN
  414.  
  415.       IF(IKG.EQ.2)IKG=1
  416.       ENDIF
  417.  
  418.       ENDIF
  419.  
  420. C     write(6,*)' Opérateur NSKE : Fin lecture Arguments '
  421. C Fin lecture Arguments ************************************************
  422.  
  423.  
  424.       CALL LEKTAB(MTABZ,'XXDXDY',MCHPDX)
  425.       IF(IRET.EQ.0)RETURN
  426.       CALL LICHT(MCHPDX,IZTCO,TYPC,IGEOM)
  427.       NELZ=IZTCO.VPOCHA(/1)
  428.  
  429.  
  430. C     write(6,*)' FORMULATION ',kform
  431. C*********** FORMULATIONS **********
  432.  
  433.       IF(KFORM.EQ.0)THEN
  434. C Formulation EFM1
  435.       IF(KIMPL.NE.0)THEN
  436.       WRITE(6,*)' Operateur NSKE'
  437. C        Option %m1:8 incompatible avec les données
  438.             MOTERR( 1: 8) = '  EFM1  '
  439.       CALL ERREUR(803)
  440.       RETURN
  441.       ENDIF
  442.  
  443.       CALL LEKTAB(MTABZ,'MATESI',MATRIK)
  444.       IF(MATRIK.EQ.0)GO TO 90
  445.       SEGACT MATRIK
  446.       IMATRI=IRIGEL(4,1)
  447.       SEGACT IMATRI
  448.  
  449.       CALL LEKTAB(MTABZ,'XXPSOML',MCHELM)
  450.       CALL LEKTAB(MTABZ,'XXVOLUM',MCHVOL)
  451.       IF(IRET.EQ.0)RETURN
  452.  
  453.       SEGACT MCHELM
  454.       CALL LICHT(MCHVOL,IZVOL,TYPC,IGEOM)
  455.  
  456.       CALL LEKTAB(MTAB1,'KIZG',KIZG)
  457.       IF(KIZG.EQ.0)THEN
  458.       CALL CRTABL(KIZG)
  459.       CALL ECMM(KIZG,'SOUSTYPE','KIZG')
  460.       CALL ECMO(MTAB1,'KIZG','TABLE   ',KIZG)
  461.       ENDIF
  462.  
  463.       CALL LEKTAB(MTAB1,'KIZG1',KIZG1)
  464.       IF(KIZG1.EQ.0)THEN
  465.       CALL CRTABL(KIZG1)
  466.       CALL ECMM(KIZG1,'SOUSTYPE','KIZG1')
  467.       CALL ECMO(MTAB1,'KIZG1','TABLE   ',KIZG1)
  468.       ENDIF
  469.  
  470.       CALL LEKTAB(MTAB1,'KIZD',KIZD)
  471.       IF(KIZD.EQ.0)THEN
  472.       WRITE(6,*)'Il n''y a pas de table KIZD '
  473.       GO TO 90
  474.       ENDIF
  475.  
  476. C*****************************************************************************
  477.  
  478.  
  479.       TYPE=' '
  480.       CALL ACMO(KIZG,NOMI,TYPE,IZG1)
  481.       IF(TYPE.NE.'CHPOINT ')THEN
  482.       NC=IZTU1.VPOCHA(/2)
  483.       TYPE='SOMMET'
  484.       CALL CRCHPT(TYPE,MELEM1,NC,IZG1)
  485.       CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1)
  486.       ENDIF
  487.  
  488.       CALL LICHT(IZG1,IZGG1,TYPC,IGEOM)
  489.  
  490.       IF(IGEOM.NE.MELEM1)THEN
  491.       WRITE(6,*)' Opérateur NSKE'
  492.       WRITE(6,*)'Incompatibilite de SPG entre 1eres inconnues '
  493. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  494.          MOTERR(1: 8) = 'INC '//NOMI
  495.          MOTERR(9:16) = 'CHPOINT '
  496.          CALL ERREUR(788)
  497.       RETURN
  498.       ENDIF
  499.  
  500.  
  501.       NOMI=LINCO.MOTS(2)
  502.  
  503.       TYPE=' '
  504.       CALL ACMO(KINC,NOMI,TYPE,MCHPOI)
  505.       IF(TYPE.NE.'CHPOINT ')THEN
  506.       WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table'
  507. C        Indice %m1:8 : ne contient pas un objet de type %m9:16
  508.          MOTERR( 1: 8) = 'INC '//NOMI
  509.          MOTERR( 9:16) = 'CHPOINT '
  510.          CALL ERREUR(800)
  511.          RETURN
  512.       RETURN
  513.       ELSE
  514.       CALL LICHT(MCHPOI,IZTU2,TYPC,IGEOM0)
  515.       IF(IGEOM0.NE.MELEM1)THEN
  516.       WRITE(6,*)' Opérateur NSKE '
  517.       WRITE(6,*)' Le SPG de l''inconnue 2 n''est pas convenable'
  518. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  519.          MOTERR(1: 8) = 'INC '//NOMI
  520.          MOTERR(9:16) = 'CHPOINT '
  521.          CALL ERREUR(788)
  522.       RETURN
  523.       ENDIF
  524.       ENDIF
  525.  
  526.       TYPE=' '
  527.       CALL ACMO(KIZG,NOMI,TYPE,IZG2)
  528.       IF(TYPE.NE.'CHPOINT ')THEN
  529.       NC=IZTU2.VPOCHA(/2)
  530.       TYPE='SOMMET'
  531.       CALL CRCHPT(TYPE,MELEM1,NC,IZG2)
  532.       CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG2)
  533.       ENDIF
  534.  
  535.       CALL LICHT(IZG2,IZGG2,TYPC,IGEOM)
  536.  
  537.       IF(IGEOM.NE.MELEM1)THEN
  538.       WRITE(6,*)' Opérateur NSKE'
  539.       WRITE(6,*)'Incompatibilite de SPG entre 2emes inconnues'
  540. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  541.          MOTERR(1: 8) = 'INC '//NOMI
  542.          MOTERR(9:16) = 'CHPOINT '
  543.          CALL ERREUR(788)
  544.       RETURN
  545.       ENDIF
  546.  
  547.       TYPE=' '
  548.       CALL ACMO(KIZG1,NOMI,TYPE,IZGD2)
  549.       IF(TYPE.NE.'CHPOINT ')THEN
  550.       NC=IZTU2.VPOCHA(/2)
  551.       TYPE='SOMMET'
  552.       CALL CRCHPT(TYPE,MELEM1,NC,IZGD2)
  553.       CALL ECMO(KIZG1,NOMI,'CHPOINT ',IZGD2)
  554.       ENDIF
  555.  
  556.       CALL LICHT(IZGD2,IZGDD2,TYPC,IGEOM)
  557.  
  558.       IF(IGEOM.NE.MELEM1)THEN
  559.       WRITE(6,*)' Opérateur NSKE'
  560.       WRITE(6,*)'Incompatibilite de SPG entre 2emes inconnues'
  561. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  562.          MOTERR(1: 8) = 'INC '//NOMI
  563.          MOTERR(9:16) = 'CHPOINT '
  564.          CALL ERREUR(788)
  565.       RETURN
  566.       ENDIF
  567.  
  568.       TYPE=' '
  569.       CALL ACMO(KIZD,NOMI,TYPE,IZD2)
  570.       IF(TYPE.NE.'CHPOINT ')THEN
  571.       WRITE(6,*)' Il n y a pas de diagonale associee a l''inconnue ',
  572.      &NOMI
  573.       GO TO 90
  574.       ENDIF
  575.  
  576.       CALL LICHT(IZD2,IZDD2,TYPC,IGEOM)
  577.  
  578.       NOMI=LINCO.MOTS(3)
  579.  
  580.       TYPE=' '
  581.       CALL ACMO(KINC,NOMI,TYPE,MCHPOI)
  582.       IF(TYPE.NE.'CHPOINT ')THEN
  583.       WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table'
  584. C        Indice %m1:8 : ne contient pas un objet de type %m9:16
  585.          MOTERR( 1: 8) = 'INC '//NOMI
  586.          MOTERR( 9:16) = 'CHPOINT '
  587.          CALL ERREUR(800)
  588.       RETURN
  589.       ELSE
  590.       CALL LICHT(MCHPOI,IZTU3,TYPC,IGEOM0)
  591.       IF(IGEOM0.NE.MELEM1)THEN
  592.       WRITE(6,*)' Opérateur NSKE '
  593.       WRITE(6,*)' Le SPG de l''inconnue 3 n''est pas convenable'
  594. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  595.          MOTERR(1: 8) = 'INC '//NOMI
  596.          MOTERR(9:16) = 'CHPOINT '
  597.          CALL ERREUR(788)
  598.       RETURN
  599.       ENDIF
  600.       ENDIF
  601.  
  602.       TYPE=' '
  603.       CALL ACMO(KIZG,NOMI,TYPE,IZG3)
  604.       IF(TYPE.NE.'CHPOINT ')THEN
  605.       SEGACT IZTU3
  606.       NC=IZTU3.VPOCHA(/2)
  607.       TYPE='SOMMET'
  608.       CALL CRCHPT(TYPE,MELEM1,NC,IZG3)
  609.       CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG3)
  610.       ENDIF
  611.  
  612.       CALL LICHT(IZG3,IZGG3,TYPC,IGEOM)
  613.  
  614.       IF(IGEOM.NE.MELEM1)THEN
  615.       WRITE(6,*)' Opérateur NSKE'
  616.       WRITE(6,*)' Incompatibilite de SPG entre 3emes inconnues'
  617. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  618.          MOTERR(1: 8) = 'INC '//NOMI
  619.          MOTERR(9:16) = 'CHPOINT '
  620.          CALL ERREUR(788)
  621.       RETURN
  622.       ENDIF
  623.  
  624.       TYPE=' '
  625.       CALL ACMO(KIZG1,NOMI,TYPE,IZGD3)
  626.       IF(TYPE.NE.'CHPOINT ')THEN
  627.       NC=IZTU3.VPOCHA(/2)
  628.       TYPE='SOMMET'
  629.       CALL CRCHPT(TYPE,MELEM1,NC,IZGD3)
  630.       CALL ECMO(KIZG1,NOMI,'CHPOINT ',IZGD3)
  631.       ENDIF
  632.  
  633.       CALL LICHT(IZGD3,IZGDD3,TYPC,IGEOM)
  634.  
  635.       IF(IGEOM.NE.MELEM1)THEN
  636.       WRITE(6,*)' Opérateur NSKE'
  637.       WRITE(6,*)' Incompatibilite de SPG entre 3emes inconnues'
  638. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  639.          MOTERR(1: 8) = 'INC '//NOMI
  640.          MOTERR(9:16) = 'CHPOINT '
  641.          CALL ERREUR(788)
  642.       RETURN
  643.       ENDIF
  644.  
  645.       TYPE=' '
  646.       CALL ACMO(KIZD,NOMI,TYPE,IZD3)
  647.       IF(TYPE.NE.'CHPOINT ')THEN
  648.       WRITE(6,*)' Il n y a pas de diagonale associee a l''inconnue ',
  649.      &NOMI
  650.       GO TO 90
  651.       ENDIF
  652.  
  653.       CALL LICHT(IZD3,IZDD3,TYPC,IGEOM)
  654.  
  655.       NPT=IZGG1.VPOCHA(/1)
  656.  
  657.       SEGDES LINCO
  658.  
  659.  
  660. C######################################################################
  661.  
  662.       SEGACT MELEME
  663.       NBSOUS=LISOUS(/1)
  664.       IF(NBSOUS.EQ.0)NBSOUS=1
  665.       NUTOEL=0
  666.       DT=1.D30
  667.       IES=IDIM
  668.  
  669.       DO 1 L=1,NBSOUS
  670.       IPT1=MELEME
  671.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  672.       SEGACT IPT1
  673.       IZAFM=LIZAFM(L,1)
  674.       IPM1=IZAFM
  675.       SEGACT IZAFM
  676.       IF(IAXI.NE.0)THEN
  677.       IPM1=LIZAFM(L,2)
  678.       SEGACT IPM1
  679.       ENDIF
  680.  
  681.       MCHAML=ICHAML(L)
  682.       SEGACT MCHAML
  683.       MELVAL=IELVAL(1)
  684.       SEGACT MELVAL
  685.  
  686.       IF(IMACHE(L).NE.IPT1)THEN
  687.        write(*,*)'IPT1,IMACHE ',IPT1,IMACHE(L)
  688.        goto 90
  689.       ENDIF
  690.  
  691.       NP  =IPT1.NUM(/1)
  692.       NBEL=IPT1.NUM(/2)
  693.  
  694.       CALL ZCVIT(AM,IPM1.AM,VELCHE,
  695.      & IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,IAXI,
  696.      & IPADI.LECT,IKOMP,IARG,
  697.      & MZRO.VPOCHA,IKR,
  698.      & MZNU.VPOCHA,IKN,MZGB.VPOCHA,IKG,NELG,MZTN.VPOCHA,IKTN,
  699.      & MZTR.VPOCHA,IKTR,MZNT.VPOCHA,
  700.      & IZTU1.VPOCHA,UTRANS.VPOCHA,IZTU2.VPOCHA,IZTU3.VPOCHA,
  701.      & IZGG1.VPOCHA,IZGG2.VPOCHA,IZGG3.VPOCHA,
  702.      & IZGDD2.VPOCHA,IZGDD3.VPOCHA,
  703.      & IZDD2.VPOCHA,IZDD3.VPOCHA,
  704.      & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,IMODEL,
  705.      & DT,DTT1,DTT2,NUEL,DIAEL,ECHLM)
  706.  
  707.       SEGDES IZAFM,IPT1,MCHAML,MELVAL
  708.       NUTOEL=NUTOEL+NBEL
  709.  
  710.  1    CONTINUE
  711.       SEGDES MELEME
  712.       SEGDES MATRIK,MCHELM
  713.  
  714.       SEGDES MZTN
  715.       SEGDES IZTU1,IZTU2,IZTU3
  716.       SEGDES IZGG1,IZGG2,IZGG3
  717.       SEGDES IZGDD2,IZGDD3
  718.       SEGDES IZDD2,IZDD3
  719.       SEGDES IZVOL,IZTCO
  720.  
  721.       CALL LEKTAB(MTAB1,'PASDETPS',MTABT)
  722.       IF(MTABT.EQ.0)THEN
  723.       CALL CRTABL(MTABT)
  724.       CALL ECMM(MTABT,'SOUSTYPE','PASDETPS')
  725.       CALL ECMO(MTAB1,'PASDETPS','TABLE   ',MTABT)
  726.       DTP=1.D30+DT
  727.       IPAT=1
  728.       CALL ECME(MTABT,'NUPASDT',IPAT)
  729.       ELSE
  730.       CALL ACMF(MTABT,'DELTAT',DTP)
  731.       ENDIF
  732.  
  733.       IF(DT.LT.DTP)THEN
  734.       CALL ECMF(MTABT,'DELTAT',DT)
  735.       CALL ECMM(MTABT,'OPER','NSKE')
  736.       CALL ACMM(MTABX,'NOMZONE',NOMZ)
  737.       CALL ECMM(MTABT,'ZONE',NOMZ)
  738.       CALL ECMF(MTABT,'DTCONV',DTT1)
  739.       CALL ECMF(MTABT,'DTDIFU',DTT2)
  740.       CALL ECMF(MTABT,'DIAEL',DIAEL)
  741.       CALL ECME(MTABT,'NUEL',NUEL)
  742.       ENDIF
  743. C*************************************************************************
  744.       ELSE IF(KFORM.EQ.1)THEN
  745. C CAS FORMULATION EF
  746.  
  747.       IF(KIMPL.EQ.0)THEN
  748. C        Option %m1:8 incompatible avec les données
  749.             MOTERR( 1: 8) = '  EF    '
  750.             CALL ERREUR(803)
  751.             RETURN
  752.         ENDIF
  753.  
  754.       DT=0.D0
  755.       IF(IDCEN.EQ.4)THEN
  756.       TYPE=' '
  757.       CALL ACMO(MTABT,'DELTAT',TYPE,IENT)
  758.       IF(TYPE.NE.'ENTIER')THEN
  759.       WRITE(6,*)' Opérateur NS '
  760.       WRITE(6,*)' On reclame un pas de temps'
  761. C        Option %m1:8 incompatible avec les données
  762.             MOTERR( 1: 8) = '  EF    '
  763.             CALL ERREUR(803)
  764.       RETURN
  765.       ELSE
  766.       CALL ACMF(MTABT,'DELTAT',DT)
  767.       ENDIF
  768.       ENDIF
  769.  
  770.       IHV=1
  771.       NUTOEL=0
  772.       NINKO=VITESS.VPOCHA(/2)
  773.       SEGACT MELEME
  774.       NBSOUS=LISOUS(/1)
  775.       IF(NBSOUS.EQ.0)NBSOUS=1
  776.  
  777.       TYPE=' '
  778.       CALL ACMO(MTABX,'MATELM',TYPE,MATRIK)
  779.       IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN
  780.       SEGACT MATRIK
  781.       NMATRI=IRIGEL(/2)
  782.       MELEME=IRIGEL(1,1)
  783.       SEGACT MELEME
  784.       IMATRI=IRIGEL(4,1)
  785.       SEGACT IMATRI
  786.       NBME=LIZAFM(/2)
  787.       NINKO=NBME
  788.       MELEMS=KSPGP
  789.  
  790.  
  791.       ELSE
  792.  
  793.       NRIGE=7
  794.       NKID =9
  795.       NKMT =7
  796.       NMATRI=1
  797.       SEGINI MATRIK
  798.       IRIGEL(1,1)=MELEME
  799.       IRIGEL(2,1)=MELEME
  800.  
  801.       IRIGEL(7,1)=2
  802.       NBOP=0
  803.       NBME=NINKO
  804.       NBELC=0
  805.       SEGINI IMATRI,IMATRS
  806.       IRIGEL(4,1)=IMATRI
  807.       KSPGP=MELEMS
  808.       KSPGD=MELEMS
  809.  
  810.       IF(NBME.EQ.1)THEN
  811.       LISPRI(1)=NOMI(1:4)//'    '
  812.       LISDUA(1)=NOMA(1:4)//'    '
  813.       ELSE
  814.       DO 102 I=1,NBME
  815.       WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7)
  816.       LISPRI(I)=NOM(1:4)//'    '
  817.       WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7)
  818.       LISDUA(I)=NOM(1:4)//'    '
  819.  102  CONTINUE
  820.       ENDIF
  821.  
  822.       NUTOEL=0
  823.       DO 101 L=1,NBSOUS
  824.       IPT1=MELEME
  825.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  826.       SEGACT IPT1
  827.       WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'    '
  828.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  829.       SEGACT IZFFM*MOD
  830.       IZHR=KZHR(1)
  831.       SEGACT IZHR*MOD
  832.       NES=GR(/1)
  833.       NPG=GR(/3)
  834.  
  835.       NP = IPT1.NUM(/1)
  836.       MP = NP
  837.       NBEL=IPT1.NUM(/2)
  838.       SEGINI IPM1,IPS1
  839.       LIZAFM(L,1)=IPM1
  840.       LIZAFS(L,1)=IPS1
  841.       IPM2=IPM1
  842.       IPM3=IPM1
  843.       IPS2=IPS1
  844.       IPS3=IPS1
  845.       IF(NBME.GE.2)THEN
  846.       SEGINI IPM2,IPS2
  847.       LIZAFM(L,2)=IPM2
  848.       LIZAFS(L,2)=IPS2
  849.       ENDIF
  850.       IF(NBME.GE.3)THEN
  851.       SEGINI IPM3,IPS3
  852.       LIZAFM(L,3)=IPM3
  853.       LIZAFS(L,3)=IPS3
  854.       ENDIF
  855.  
  856.  
  857.       KITT=2
  858.       KJTT=IKN
  859.       NPT=UTRANS.VPOCHA(/1)
  860.       NPTG=IZTU1.VPOCHA(/1)
  861.  
  862.       CALL ZCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  863.      & NES,IDIM,NP,NPG,IAXI,AIMPL,IKOMP,
  864.      & RO,1,UTRANS.VPOCHA,IKW,NPT,IPADU.LECT,MZNU.VPOCHA,IKN,
  865.      & IPT1.NUM,NBEL,NUTOEL,XCOOR,
  866.      & IPM1.AM,IPM2.AM,IPM3.AM,
  867.      & IPS1.AM,IPS2.AM,IPS3.AM,
  868.      & NINKO,IDCEN,DT,
  869.      & IZTU1.VPOCHA,0,NPTG,IPADI.LECT,IZTCO.VPOCHA,NELZ)
  870.  
  871.       CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,
  872.      & MZNU.VPOCHA,MZNU.VPOCHA,MZNU.VPOCHA,KITT,KJTT,IKN,
  873.      & IPT1.NUM,NBEL,NUTOEL,XCOOR,AIMPL,IKOMP,
  874.      & IPM1.AM,IPM2.AM,IPM3.AM,
  875.      & IPS1.AM,IPS2.AM,IPS3.AM,
  876.      & NINKO,IHV,IARG,MZNU.VPOCHA)
  877.  
  878.       NUTOEL=NUTOEL+NBEL
  879.  101  CONTINUE
  880.  
  881.       ENDIF
  882.  
  883.  
  884.       IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN
  885.       NAT=2
  886.       NSOUPO=1
  887.       SEGACT MELEMS
  888.       N=MELEMS.NUM(/2)
  889.       NC=NINKO
  890.       SEGINI MCHPO1,MSOUP1,MPOVA1
  891.       MCHPO1.IFOPOI=IFOUR
  892.       MCHPO1.MOCHDE=TITREE
  893.       MCHPO1.MTYPOI='SMBR'
  894.       MCHPO1.JATTRI(1)=2
  895.       MCHPO1.IPCHP(1)=MSOUP1
  896.       DO 177 N=1,NINKO
  897.       MSOUP1.NOCOMP(N)=LISDUA(N)
  898.  177  CONTINUE
  899.       MSOUP1.IGEOC=MELEMS
  900.       MSOUP1.IPOVAL=MPOVA1
  901.       ENDIF
  902.  
  903.       IF(IARG.EQ.3.OR.IARG.EQ.5)THEN
  904.        CALL KRIPAD(MELEMQ,IPADQ)
  905.       IF(IARG.EQ.3)THEN
  906.        IKAS=2
  907.       ELSEIF(IARG.EQ.5)THEN
  908.        IKAS=3
  909.       ENDIF
  910.  
  911.  
  912.  
  913.       IF(MACRO.NE.0.AND.KPRE.EQ.2)MELEMI=MELEME
  914.       SEGACT MELEMI
  915.       NBSOUS=MELEMI.LISOUS(/1)
  916.       IF(NBSOUS.EQ.0)NBSOUS=1
  917.  
  918.       NUTOEL=0
  919.       DO 1102 L=1,NBSOUS
  920.       IPT1=MELEMI
  921.       IF(NBSOUS.NE.1)IPT1=MELEMI.LISOUS(L)
  922.       SEGACT IPT1
  923.  
  924.        IF(MQUAD.NE.0)THEN
  925.        IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP0'
  926.        IF(KPRE.EQ.3)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP0'
  927.        IF(KPRE.EQ.4)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'PRP1'
  928.        ELSEIF(MACRO.NE.0)THEN
  929.        IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'    '
  930.        IF(KPRE.EQ.3)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'MCP0'
  931.        IF(KPRE.EQ.4)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'MCP1'
  932.        ELSE
  933.        IF(KPRE.EQ.2)WRITE(NOM0,FMT='(A8)')NOMS(IPT1.ITYPEL)//'    '
  934.        ENDIF
  935.        CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  936.  
  937.  
  938.       SEGACT IZFFM*MOD
  939.       IZHR=KZHR(1)
  940.       SEGACT IZHR*MOD
  941.       NES=GR(/1)
  942.       NPG=GR(/3)
  943.       IZF1=KTP(1)
  944.       SEGACT IZF1*MOD
  945.       MP1=IZF1.FN(/1)
  946.       NP = IPT1.NUM(/1)
  947.       MP = NP
  948.       NBEL=IPT1.NUM(/2)
  949.       NELG=MZGB.VPOCHA(/1)
  950.       NPT =MPOVA1.VPOCHA(/1)
  951.  
  952.       SEGACT MELEP1
  953.  
  954.  
  955.       CALL XSOUR(FN,IZF1.FN,GR,PG,XYZ,HR,PGSQ,RPG,
  956.      & NES,IDIM,NP,MP1,NPG,IAXI,IPT1.NUM,IKAS,KPRE,
  957.      & MZGB.VPOCHA,IKG,NELG,IPADQ.LECT,MELEP1.NUM,
  958.      & MZTN.VPOCHA,IKTN,MZTR.VPOCHA,IKTR,IPADS.LECT,
  959.      & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT)
  960.  
  961.       NUTOEL=NUTOEL+NBEL
  962.  1102 CONTINUE
  963.  
  964.       ENDIF
  965.  
  966.       IF(KIMPL.EQ.2.OR.KIMPL.EQ.0)THEN
  967.  
  968.       NBSOUS=LISOUS(/1)
  969.       IF(NBSOUS.EQ.0)NBSOUS=1
  970.  
  971.       DO 1533 L=1,NBSOUS
  972.       IPT1=MELEME
  973.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  974.       SEGACT IPT1
  975.       NP=IPT1.NUM(/1)
  976.       NBEL=IPT1.NUM(/2)
  977.       DO 2 N=1,NINKO
  978.       IPMS=LIZAFS(L,N)
  979.       SEGACT IPMS
  980.       DO 12 K=1,NBEL
  981.       DO 13 J=1,NP
  982.       UU=0.D0
  983.       IU=IPADS.LECT(IPT1.NUM(J,K))
  984.       DO 14 I=1,NP
  985.       IK=IPADI.LECT(IPT1.NUM(I,K))
  986.       UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N)
  987.  14   CONTINUE
  988.       MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU
  989.  13   CONTINUE
  990.  12   CONTINUE
  991.  
  992.  2    CONTINUE
  993.  
  994.  1533 CONTINUE
  995.       ENDIF
  996.  
  997.       SEGDES IPM1,IPM2,IPM3
  998.       IPS=IPS1
  999.       SEGSUP IPS1
  1000.       IF(IPS2.NE.IPS)SEGSUP IPS2
  1001.       IF(IPS3.NE.IPS)SEGSUP IPS3
  1002.       SEGDES IZTCO
  1003.  
  1004.       IF(KIMPL.EQ.2.OR.KIMPL.EQ.0.OR.IARG.GT.1)THEN
  1005.  
  1006.       TYPE=' '
  1007.       CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2)
  1008.       IF(TYPE.NE.'CHPOINT')THEN
  1009.       CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPO1)
  1010.       ELSE
  1011.       CALL ECROBJ('CHPOINT',MCHPO2)
  1012.       CALL ECROBJ('CHPOINT',MCHPO1)
  1013. C?    CALL OPERAD
  1014.       CALL PRFUSE
  1015.       CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
  1016.       CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI)
  1017.       ENDIF
  1018.  
  1019.       ENDIF
  1020.  
  1021.       SEGDES IMATRI
  1022.       SEGDES MELEME,MATRIK
  1023.       IF(IKN.EQ.0)THEN
  1024.       SEGDES MZNU
  1025.       ENDIF
  1026.       CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK)
  1027.  
  1028. C*************************************************************************
  1029.       ELSE IF(KFORM.EQ.2)THEN
  1030. C CAS FORMULATION VF
  1031.       WRITE(6,*)' FORMULATION VF NON DISPONIBLE '
  1032. C        Option %m1:8 incompatible avec les données
  1033.             MOTERR( 1: 8) = '  EF    '
  1034.             CALL ERREUR(803)
  1035.             RETURN
  1036.       ENDIF
  1037. C*************************************************************************
  1038.  
  1039.  
  1040.  
  1041.       SEGSUP IPADI
  1042.       IPAS=1
  1043. C     write(6,*)' FIN NSKE '
  1044.       RETURN
  1045.  
  1046.  90   CONTINUE
  1047.       WRITE(6,*)' Interuption anormale de NSKE'
  1048. C        Option %m1:8 incompatible avec les données
  1049.             MOTERR( 1: 8) = '  EF    '
  1050.       CALL ERREUR(803)
  1051.       RETURN
  1052.  1002 FORMAT(10(1X,1PE11.4))
  1053.       END
  1054.  
  1055.  
  1056.  
  1057.  
  1058.  
  1059.  
  1060.  
  1061.  
  1062.  
  1063.  
  1064.  
  1065.  
  1066.  
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072.  
  1073.  
  1074.  
  1075.  
  1076.  

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