Télécharger konv.eso

Retour à la liste

konv
C KONV      SOURCE    CB215821  20/11/25    13:32:40     10792          
      SUBROUTINE KONV
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C
C  CET OPERATEUR DISCRETISE LE TERME DE TRANSPORT
C    EN 2D SUR LES ELEMENTS QUA4 ET TRI3      PLAN OU AXI
C    EN 3D SUR LES ELEMENTS CUB8 ET PRI6
C    EN 0D SUR LES ELEMENTS POI1
C
C  EN VOLUMES FINIS, DISCRETISATION DES EQUATIONS D'EULERS
C
C
C  SYNTAXE :
C  ---------
C
C         KONV RO UN <MU>        INCO TN :
C
C  COEFFICIENTS :
C  --------------
C
C
C  ALF  (SCAL DOMA)  DIFFUSIVITE THERMIQUE
C       (SCAL ELEM)
C
C  INCONNUES :
C  -----------
C
C   TN                 CHAMP DE TEMPERATURE
C
C************************************************************************
 
-INC CCVQUA4
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMLENTI
      POINTEUR IZIPAD.MLENTI,IPADI.MLENTI,IPADS.MLENTI,IPADU.MLENTI
-INC SMELEME
      POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEMI.MELEME
      POINTEUR MELEMA.MELEME,MELEMF.MELEME
-INC SMCHAML
-INC SMCHPOI
      POINTEUR MCHPIN.MCHPOI
      POINTEUR MZUN.MPOVAL,MZUN2.MPOVAL,MZMU.MPOVAL
      POINTEUR MZDT.MPOVAL,MZPHI.MPOVAL
      POINTEUR MRO.MCHPOI,MZRO.MPOVAL
      POINTEUR IZTG2.MCHPOI,IZTG3.MCHPOI
      POINTEUR IZTGG2.MPOVAL,IZTGG3.MPOVAL
      POINTEUR IZTU1.MPOVAL,IZTU2.MPOVAL,IZTU3.MPOVAL,IZTU4.MPOVAL
      POINTEUR IZTG5.MPOVAL
      POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL,IZDIAE.MPOVAL,IZTDI.MPOVAL
 
-INC SIZFFB
      PARAMETER (LRV=64)
      SEGMENT PETROV
      REAL*8 WT(LRV,NP,NPG,KDIM),WS(LRV,NP,NPG,KDIM),HK(LRV,IDIM,NP,NPG)
      REAL*8 UIL(LRV,IDIM,NPG),DUIL(LRV,IDIM,NPG)
      REAL*8 PGSK(LRV,NPG),RPGK(LRV,NPG),AIRE(LRV),ANUK(LRV),COEFK(LRV)
      REAL*8 AJK(LRV,IDIM,IDIM,NPG)
      ENDSEGMENT
 
-INC SMMATRIK
      POINTEUR IPM.IZAFM
 
      SEGMENT IMATRS
      INTEGER LIZAFS(NBSOUS,NBME)
      ENDSEGMENT
      POINTEUR IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM,IPMS.IZAFM
 
-INC SMTABLE
      POINTEUR KIZG.TABLE,MTABX.MTABLE,MTABT.MTABLE
      POINTEUR KINC.TABLE,RESU.MTABLE
      POINTEUR MTABZ.MTABLE
-INC SMLMOTS
      POINTEUR LINCO.MLMOTS
      CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC,TYPCFI,NOM
      CHARACTER*8 NOM0,NOMII,MTYP,NMACO
      CHARACTER*4 NOM4(3), CELCAR
      REAL*8 XYZI(24)
      LOGICAL LOGI
      PARAMETER (NTB=2)
      CHARACTER*8 LTAB(NTB)
      DIMENSION KTAB(NTB),IXV(3)
*      save ipas
*      data ipas/1/
C
C**** EN VOLUMES FINIS, KONV est un operatéur normal,
C     (voir KONV1)
C     i.e.
C
C     JACO RESI DELTAT = 'KONV' 'VF' ...
C
C*****************************************************************************
 
CKONV
C     WRITE(6,*)' Opérateur KONV'
C
C*****************************************************************************
C
C Deux traitements différents suivant la discrétisation 2D/3D ou 0D
C (respectivement, table d'entrée de soustype KIZX
C                              ou de soustype OPER_0D)
C
 
      segact mcoord
C Nouvelle directive EQUA de EQEX
      MTYP=' '
      CALL QUETYP(MTYP,0,IRET)
      IF(IRET.EQ.0)THEN
C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
      MOTERR( 1: 8) = 'CHAI    '
      MOTERR( 9:16) = 'MMODEL  '
C      MOTERR(17:24) = 'TABLE   '
      CALL ERREUR(472)
      RETURN
      ENDIF
 
      IF(MTYP.EQ.'MMODEL')THEN
        CALL LIRCHA(CHAI,1,IRET)
          IF(CHAI.EQ. 'VF  ')THEN
            CALL KONV1
            GOTO 9999
          ENDIF
          CALL YTCLSF(' C      ','KONV    ')
          RETURN
      ELSEIF(MTYP.EQ.'MOT     ')THEN
        CALL LIRCHA(CHAI,1,IRET)
          IF(CHAI.EQ. 'VF  ')THEN
            CALL KONV1
            GOTO 9999
          ELSE
            CALL YTCLSF(CHAI,'KONV    ')
          ENDIF
        RETURN
      ENDIF
C Fin Nouvelle directive EQUA de EQEX
 
 
 
      LTAB(1) = 'KIZX    '
      LTAB(2) = 'OPER_0D '
      KTAB(1) = 0
      KTAB(2) = 0
      CALL LITABS(LTAB,KTAB,NTB,0,IRET)
      IF(IRET.EQ.0)THEN
        WRITE(6,*)' Opérateur KONV :'
        WRITE(6,*)' On attend un ensemble de table soustypes'
        RETURN
      ENDIF
C
C Bifurcation en cas de discrétisation 0D
C
      IF (KTAB(1).NE.0) THEN
        MTABX = KTAB(1)
 
      CALL LEKTAB(MTABX,'EQEX',MTAB1)
      IF(MTAB1.EQ.0)THEN
      WRITE(6,*)' Opérateur KONV :'
      WRITE(6,*)' On ne trouve pas l''indice EQEX ? '
      RETURN
      ENDIF
      CALL ACME(MTAB1,'NAVISTOK',NASTOK)
      IF(NASTOK.EQ.0)THEN
      CALL ZKONV(MTABX,MTAB1)
      RETURN
      ENDIF
      ELSEIF (KTAB(2).NE.0) THEN
        IPTAB1 = KTAB(2)
        CALL TOCONV (IPTAB1)
        RETURN
      ELSE
        WRITE(6,*)' Opérateur KONV :'
        WRITE(6,*)' On attend une table de soustype KIZX ou OPER_0D'
        RETURN
      ENDIF
 
 
C*****************************************************************************
C Traitement des options
C KIMPL = 0 -> EXPL     1 -> IMPL     2 -> CN
C KFORM = 0 -> SI       1 -> EF       2 -> VF    3 -> EFMC
C IDCEN = 0 -> rien     1 -> CENTREE  2 -> HU.BR 3 -> SUPG    4 -> T VISQ
 
C
C- Récupération de la table des options KOPT (pointeur KOPTI)
C
      CALL LEKTAB(MTABX,'KOPT',KOPTI)
      IF (KOPTI.EQ.0) THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  KOPT  '
         MOTERR( 9:16) = '  KOPT  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
      ENDIF
 
      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=2
 
      KDIM=1
      CALL ACME(KOPTI,'IDCEN',IDCEN)
      IF(IDCEN.EQ.2)KDIM=IDIM
      CALL ACME(KOPTI,'IKOMP',IKOMP)
      CALL ACME(KOPTI,'KIMPL',KIMPL)
      CALL ACME(KOPTI,'KFORM',KFORM)
      CALL ACME(KOPTI,'ISCHT',ISCHT)
      CALL ACME(KOPTI,'IDIV',IDIV)
      CALL ACMF(KOPTI,'CMD',CMD)
      CALL ACME(KOPTI,'KMACO',KMACO)
      CALL ACMF(KOPTI,'AIMPL',AIMPL)
      AG=AIMPL
      AD=AIMPL-1.D0
      IF(ISCHT.EQ.2)THEN
      AG=1.D0
      AD=-1.D0
      ENDIF
      IF (IERR.NE.0) RETURN
 
C*****************************************************************************
C*****************************************************************************
C
C ----- Cas d'un schéma Explicite en Volume Fini :
C       ----------------------------------------
      if (KIMPL .EQ. 0 .and. KFORM . EQ. 2) then
              call ckon(MTABX)
              RETURN
      ENDIF
C*****************************************************************************
C
C- Récupération de la table DOMAINE associée au domaine local
C
      CALL ACMM(MTABX,'NOMZONE',NOMZ)
 
      MTYP='MMODEL'
      CALL QUETYP(MTYP,0,IRET)
      IF(IRET.EQ.1)THEN
      CALL LIROBJ('MMODEL',MMDZ,1,IRET)
      ELSE
      TYPE=' '
      CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ)
       IF(TYPE.NE.'MMODEL')THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  DOMZ  '
         MOTERR( 9:16) = '  DOMZ  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
       ENDIF
      ENDIF
 
C*****************************************************************************
C
C- Récupération de la table DOMAINE associée au domaine local
C
 
C E/  MMODEL : Pointeur de la table contenant l'information cherchée
C  /S IPOINT : Pointeur sur la table DOMAINE
C  /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE
C                               INEFMD=4 LINB
 
      CALL LEKMOD(MMDZ,MTABZ,INEFMD)
 
      CALL LEKTAB(MTABZ,'MAILLAGE',MELEME)
      CALL LEKTAB(MTABZ,'SOMMET',MELEMS)
      CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
      IF (IERR.NE.0) RETURN
 
C*************************************************************************
C VERIFICATIONS SUR LES INCONNUES
C     write(6,*)' Verification des inconnues '
 
      TYPE='LISTMOTS'
      CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO)
      SEGACT LINCO
 
      NBINC=LINCO.MOTS(/2)
      IF((NBINC.NE.1).AND.(KFORM.NE.3))THEN
      WRITE(6,*)' Opérateur KONV :'
      WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 1'
      RETURN
      ENDIF
 
      IF((NBINC.NE.2).AND.(KFORM.EQ.3))THEN
      WRITE(6,*)' Opérateur KONV :'
      WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 2'
      RETURN
      ENDIF
 
      NOMI=LINCO.MOTS(1)
 
      IF (KFORM.EQ.3) NOMII=LINCO.MOTS(2)
 
      CALL LEKTAB(MTAB1,'INCO',KINC)
      IF(KINC.EQ.0)THEN
      WRITE(6,*)' Opérateur KONV :'
      WRITE(6,*)'Il n''y a pas de table INCO ? ?.'
      RETURN
      ENDIF
 
      TYPE=' '
      CALL ACMO(KINC,NOMI,TYPE,MCHPOI)
      IF(TYPE.NE.'CHPOINT ')THEN
      WRITE(6,*)' Opérateur KONV :'
      WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table'
      RETURN
      ELSE
      CALL LICHTL(MCHPOI,IZTU1,TYPC,MELEMI)
      MCHPIN=MCHPOI
      IKT=0
      ENDIF
 
      NINKO=IZTU1.VPOCHA(/2)
      NPTI  = IZTU1.VPOCHA(/1)
      IF(NINKO.EQ.1)THEN
      WRITE(NOM4(1),FMT='(A4)')NOMI(1:4)
      ELSE
      DO 15 I=1,NINKO
      WRITE(NOM4(I),FMT='(I1,A3)')I,NOMI(1:3)
 15   CONTINUE
      ENDIF
 
      IF (KFORM.EQ.3) THEN
         TYPE=' '
         CALL ACMO(KINC,NOMII,TYPE,MCHPOI)
         IF(TYPE.NE.'CHPOINT ')THEN
            WRITE(6,*)' Opérateur KONV :'
            WRITE(6,*)' L objet CHPOINT ',NOMII,
     &           ' n existe pas dans la table'
            RETURN
         ELSE
            CALL LICHTL(MCHPOI,IZTU2,TYPCFI,IGEOM0)
            MZPHI=IZTU2
            IKT=0
         ENDIF
      END IF
C*****************************************************************************
C Le domaine de definition est donne par le SPG  de la premiere inconnue
C Les inconnues suivantes devront posseder ce meme pointeur
C On verifie que les points de la zone sont tous inclus dans ce SPG
 
      CALL KRIPAD(MELEMI,IPADI)
      IPADS=IPADI
      NPTS=NPTI
      IF(MELEMI.NE.MELEMS)THEN
      CALL KRIPAD(MELEMS,IPADS)
      NPTS=MELEMS.NUM(/2)
      ENDIF
      IPADU=IPADI
      NPTU=NPTI
*  TC mise en commentaired des lignes suivantes car ipasn'est jamais =0
*      IF(IPAS.EQ.0)THEN
*      IF (KFORM.EQ.3) CALL KRIPAD(MELEMC,MLENT1)
*      CALL VERPAD(IPADI,MELEME,IRET)
*      IF(IRET.NE.0)THEN
*      WRITE(6,*)' Opérateur KONV'
*      WRITE(6,*)' La zone ',NOMZ,' n''est pas incluse dans le domaine'
*      IPAS=0
*      RETURN
*      ENDIF
*      ENDIF
 
C*****************************************************************************
 
      IF(KFORM.NE.1)THEN
C*****************************************************************************
C Lecture du ou des coefficients
C Type du coefficient :
C IK1=0 CHPOINT IK1=1 scalaire  IK1=2 vecteur
 
c     write(6,*)' Opérateur KONV lecture des coefficients'
      CALL ACME(MTABX,'IARG',IARG)
      ICD=0
      IF(ISCHT.EQ.2)ICD=1
      IF((IARG.LT.(2+ICD).AND.IDCEN.EQ.1)
     &.OR.(IARG.LT.(3+ICD).AND.IDCEN.LT.4)
     &.OR.(IARG.LT.(4+ICD).AND.IDCEN.GE.4))THEN
      WRITE(6,*)' Opérateur KONV : option incompréssible '
      WRITE(6,*)' Nombre d''arguments incorrect : ',IARG
      WRITE(6,*)' On attend 2 ou plus suivant l''option'
      RETURN
      ENDIF
 
c     write(6,*)' KONV IARG=',iarg,melemc
C 1er coefficient  Densité
      IXV(1)=MELEMC
      IXV(2)=1
      IXV(3)=0
      CALL LEKCOF('Opérateur KONV :',
     & MTABX,KINC,1,IXV,MRO,MZRO,NPT1,NC1,IKR,IRET)
      IF(IRET.EQ.0)GO TO 90
c      write(6,*)' Apres LEKCOF'
 
      IZTGG2=MZRO
      IZTGG3=MZRO
 
C 2ème coefficient  UN , champ de vitesse transportant
      IXV(1)=-MELEMS
      IXV(2)=0
      IXV(3)=1
      CALL LEKCOF('Opérateur KONV :',
     & MTABX,KINC,2,IXV,MUN,MZUN,NPTU,NC2,IKU,IRET)
      IF(IRET.EQ.0)GO TO 90
      IF(IKU.EQ.2)IKU=1
      IF(IPADS.EQ.0.AND.IKU.EQ.0)CALL KRIPAD(MELEMS,IPADS)
      IPADU=IPADS
 
      IF(ISCHT.EQ.2)THEN
C si ISCHT=2  TN-2 ou UN-2 , champ transporte au temps n-2
      IXV(1)=-MELEMS
      IF(NINKO.EQ.1)IXV(1)=MELEMS
      IXV(2)=0
      IXV(3)=1
      CALL LEKCOF('Opérateur KONV :',
     & MTABX,KINC,(2+ICD),IXV,MUN,MZUN2,NPTU,NC2,IKU,IRET)
      IF(IRET.EQ.0)GO TO 90
      IF(IKU.EQ.2)IKU=1
      IF(IPADS.EQ.0.AND.IKU.EQ.0)CALL KRIPAD(MELEMS,IPADS)
      IPADU=IPADS
      ENDIF
 
      IF(IARG.GE.(3+ICD))THEN
C 3ème coefficient  viscosité
      IXV(1)=MELEMC
      IXV(2)=1
      IXV(3)=0
      CALL LEKCOF('Opérateur KONV :',
     & MTABX,KINC,(3+ICD),IXV,MMU,MZMU,NPT3,NC3,IKM,IRET)
      IF(IRET.EQ.0)GO TO 90
      ELSE
      CALL LEKTAB(MTABX,'ARGS3',MMU)
      CALL LICHTL(MMU,MZMU,TYPC,IGEOM0)
      MZMU.VPOCHA(1,1)=1.D0
      IKM=1
 
      ENDIF
 
      IF(IARG.EQ.(4+ICD))THEN
C 4ème coefficient  Dt
      IXV(1)=0
      IXV(2)=1
      IXV(3)=0
      CALL LEKCOF('Opérateur KONV :',
     & MTABX,KINC,(4+ICD),IXV,MDT,MZDT,NPT4,NC4,IKT,IRET)
      IF(IRET.EQ.0)RETURN
      DT=MZDT.VPOCHA(1,1)
      ELSE
      DT=0.D0
 
      ENDIF
 
c     write(6,*)' Opérateur KONV : Fin lecture Arguments '
C Fin lecture Arguments ************************************************
      ENDIF
 
 
C*************************************************************************
      IF(KFORM.EQ.0)THEN
C CAS FORMULATION EF SI (GRESHO)
 
      WRITE(6,*)' Operateur KONV '
      WRITE(6,*)' Option invalide '
      GO TO 90
C*************************************************************************
      ELSEIF(KFORM.EQ.1)THEN
C CAS FORMULATION EF
 
c     write(6,*)' On va appeler YCLS '
      NINKO=IZTU1.VPOCHA(/2)
      IHV=0
      IF(NINKO.EQ.IDIM)IHV=1
 
      CALL YCLS('KONV    ',MTABX,MTABZ,IHV,MCHPIN,NOMI,MATRIK,MCHPO1)
 
      CALL ECROBJ('MATRIK',MATRIK)
      CALL ECROBJ('CHPOINT',MCHPO1)
 
      RETURN
C*************************************************************************
      ELSE IF(KFORM.EQ.2)THEN
C CAS FORMULATION VF
 
C     CALL LEKTAB(MTABZ,'FACE',MELEMF)
C     CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
      CALL LEKTAB(MTABZ,'FACEL',MFACEL)
      CALL LEKTAB(MTABZ,'ELTFA',MELTFA)
      CALL LEKTAB(MTABZ,'ELKONV',MELEME)
C     CALL ELCONV(MELTFA,MFACEL,MELEMF,MELEMC,MELEME)
 
      SEGACT MELEME
      NBSOUS=LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
 
      NRIGE=7
      NKID =9
      NKMT =7
      NMATRI=1
      SEGINI MATRIK
      IRIGEL(1,1)=MELEME
      IRIGEL(2,1)=MELEMC
      IRIGEL(7,1)=2
      NBOP=0
      NBME=NINKO
      SEGINI IMATRI,IMATRS
      IRIGEL(4,1)=IMATRI
      KSPGP=MELEMC
      KSPGD=MELEMC
 
      IF(NBME.EQ.1)THEN
      LISPRI(1)=NOMI(1:4)//'    '
      LISDUA(1)=NOMI(1:4)//'    '
      ELSE
      DO 202 I=1,NBME
      WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7)
      LISPRI(I)=NOM(1:4)//'    '
      LISDUA(I)=NOM(1:4)//'    '
 202  CONTINUE
      ENDIF
 
C* Lecture du tableau donnant le sens des normales par element
      CALL LEKTAB(MTABZ,'XXNORMAE',MCHELM)
      IF(MCHELM.EQ.0)GO TO 90
      SEGACT MCHELM
      CALL LEKTAB(MTABZ,'XXSURFAC',MCHPO1)
      CALL LICHTL(MCHPO1,MPOVA1,TYPE,IGEOM)
C* Lecture des connectivites elements/faces
      CALL LEKTAB(MTABZ,'ELTFA',MELEMA)
      IF(MELEMA.EQ.0)GO TO 90
      SEGACT MELEMA
      CALL KRIPAD(MELEMF,IPADI)
      IF(IKR.EQ.0)CALL KRIPAD(MELEMC,MLENT1)
 
      KK=0
      DO 201 L=1,NBSOUS
      IPT1=MELEME
      IPT2=MELEMA
      IF(NBSOUS.NE.1)IPT1=LISOUS(L)
      IF(NBSOUS.NE.1)IPT2=MELEMA.LISOUS(L)
      SEGACT IPT1,IPT2
 
      NP = IPT1.NUM(/1)
      NBF=NP-1
      MP = 1
C     write(6,*)' np,nbf,mp=',np,nbf,mp
      NBEL=IPT1.NUM(/2)
      SEGINI IPM1,IPMS
      LIZAFM(L,1)=IPM1
      LIZAFS(L,1)=IPMS
      IPM2=IPM1
      IPM3=IPM1
      IF(NBME.GE.2)THEN
      LIZAFM(L,2)=IPM1
      ENDIF
      IF(NBME.GE.3)THEN
      LIZAFM(L,3)=IPM1
      ENDIF
 
      MCHAML=ICHAML(L)
      SEGACT MCHAML
      MELVAL=IELVAL(1)
      SEGACT MELVAL
 
C     write(6,*)' IKR=',ikr
 
      IF(IKR.EQ.1)THEN
C     write(6,*)' NBEL=',NBEL,' NBF=',NBF
      DO 210 K=1,NBEL
      DO 211 I=1,NBF
      NF=IPT2.NUM(I,K)
      NF=IPADI.LECT(NF)
C     write(6,*)' NF=',NF,NP
      FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1)
     &*MZRO.VPOCHA(1,1)
      IF(FI.LE.0.D0)THEN
      IPM1.AM(K,I,1)=FI
      ELSE
      IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI
      ENDIF
 211  CONTINUE
 210  CONTINUE
 
      ELSEIF(IKR.EQ.0)THEN
 
      DO 212 K=1,NBEL
      KK=KK+1
      DO 213 I=1,NBF
      NF=IPT2.NUM(I,K)
      NF=IPADI.LECT(NF)
      NCR=MLENT1.LECT(KK)
      FI=IZTGG2.VPOCHA(NF,1)*MELVAL.VELCHE(I,K)*MPOVA1.VPOCHA(NF,1)
     &*MZRO.VPOCHA(NCR,1)
      IF(FI.LE.0.D0)THEN
      IPM1.AM(K,I,1)=FI
      ELSE
      IPM1.AM(K,NP,1)=IPM1.AM(K,NP,1)+FI
      ENDIF
 213  CONTINUE
 212  CONTINUE
 
 
      ENDIF
 
 
 
      SEGDES IPT1,IPM1,IPT2
      SEGSUP IPMS
C     write(6,*)' Fin bcl 201 '
 201  CONTINUE
C     write(6,*)' Apr bcl 201 '
      SEGSUP IPADI
      SEGDES IMATRI
      SEGSUP IMATRS
      SEGDES MELEME,MATRIK
 
      IF(IKR.EQ.0)THEN
      SEGSUP MLENT1
      SEGDES MRO,MZRO
      ENDIF
 
      CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK)
 
      RETURN
C************************************************************************
      ENDIF
C*************************************************************************
 
 90   CONTINUE
      WRITE(6,*)' Interuption anormale de KONV'
 9999 RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

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