C TCNM      SOURCE    GOUNAND   13/01/22    21:15:06     7679           
      SUBROUTINE TCNM
C-----------------------------------------------------------------------
C Mise à jour des CHPOINTs à l'occasion du changement de pas de temps.
C-----------------------------------------------------------------------
C Les tables de sous type KIZX associées à l'opérateur DFDT permettent
C d'effectuer la mise à jour. Pour chaque opérateur DFDT, selon la
C syntaxe ayant été utilisée
C 1) si l'objet pointé à l'indice ARG2 de la table associée à
C    l'opérateur DFDT considéré est un CHPOINT on l'update ou
C 2) on récupere à l'indice ARG2 de la table associée à DFDT le nom
C    associé à l'inconnue à updater dans la table INCO et on update le
C    CHPOINT dans INCO.
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C IRT = TCNM TAB1 ;
C
C------------------------
C Opérandes et résultat :
C------------------------
C
C TAB1 : TABLE de sous type EQEX contenant l'ensemble des données pour
C        la modélisation.
C
C IRT  : = 1 Temps final atteint  = 0 sinon
C
C----------------------------
C Indices de table modifiés :
C----------------------------
C
C Indice ARG2 des tables DFDT si ISYNT=1.
C Indices de la table INCO alias du nom des inconnues à traiter sinon.
C
C----------------------
C Variables principales
C----------------------
C
C ISYNT  : Flag indiquant le type de syntaxe utilisé
C MTAB1  : Pointeur vers la table de sous type EQEX
C MTAB2  : Pointeur vers la table INCO
C MTABLE : Pointeur vers une table associée à un opérateur (DFDT...)
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                 
      CHARACTER*8 NOMZ,TYPE,NOMINC,TYP2,NOM,NOMA,NOMA2,TYPE1
      CHARACTER*8 NOMIX(10),NOMI1,TYP0
C
-INC CCOPTIO
-INC SMLMOTS
-INC SMCHPOI
      POINTEUR IPHI.MPOVAL,IPHH.MPOVAL
-INC SMELEME
      POINTEUR MAH.MELEME
      POINTEUR IGEOM0.MELEME
-INC SMLREEL
-INC SMLENTI
-INC SMEVOLL
C
      PARAMETER (NTB=1)
      DIMENSION   KTAB(NTB)
      CHARACTER*8 LTAB(NTB)
      DATA LTAB /'EQEX    '/
C
C- Lecture de la table de sous type EQEX
C
      NTO = 1
      CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
      IF (IRET.EQ.0) RETURN
      MTAB1 = KTAB(1)
               IUPDT=1
               CALL LIRCHA(NOM,0,LCHAR)
               IF(LCHAR.NE.0.AND.NOM.EQ.'NOUP')THEN
               IUPDT=0
               ENDIF
C
C- Appel  ancien TCNM
C
      CALL ACME(MTAB1,'NAVISTOK',NASTOK)
      IF(NASTOK.EQ.0)THEN
      CALL TCNMA(MTAB1)
      RETURN
      ENDIF
C
C- Lecture de la table INCO
C
      TYPE  = 'TABLE   '
      CALL ACMO(MTAB1,'INCO',TYPE,MTAB2)
      IF (IERR.NE.0) RETURN
C
C- Récupération du LISTMOTS à l'indice 'LISTOPER' de la table EQEX
C
      TYPE = 'LISTMOTS'
      CALL ACMO(MTAB1,'LISTOPER',TYPE,MLMOTS)
      IF (IERR.NE.0) RETURN
      SEGACT MLMOTS
      NBIND = MOTS(/2)
      IF (NBIND.GE.1000) THEN
          INTERR(1) = 1000
          CALL ERREUR(762)
      ENDIF
C
C- Initialisation des données temporelles
C  --------------------------------------
      CALL ACMF(MTAB1,'TFINAL',TFINAL)
      CALL ACMF(MTAB1,'ALFA',ALFA)
      CALL ACME(MTAB1,'FIDT',IMPR)

      TYPE=' '
      CALL ACMO(MTAB1,'PASDETPS',TYPE,MTABT)

      IF (MTABT.NE.0) THEN
         CALL ACMF(MTABT,'DELTAT',DT)
         IF (IERR.NE.0) RETURN
         CALL ACMF(MTABT,'TPS',TPS)
         IF (IERR.NE.0) RETURN
         CALL ACME(MTABT,'NUPASDT',IPT)
         IF (IERR.NE.0) RETURN
      ELSE
C?       DT  = 1.D0
C?       TPS = 0.D0
C?       IPT = 1
      ENDIF
      DT  = DT * ALFA

      IFINAL=0
      TPS1 = TPS + DT
C     write(6,*)' TPS=',tps,' TFINAL=',tfinal,' DT=',dt
      IF(TPS.GT.TFINAL)THEN
      IFINAL=1
      GO TO 800
      ELSEIF(TPS1.GT.TFINAL)THEN
      DT=TFINAL-TPS
      IFINAL=1
      ENDIF
      TPS = TPS + DT

C
C- Recherche de l'ensemble des champs à mettre à jour via DFDT
C
      DO 10 K=1,NBIND
         NOMA = MOTS(K)
         IF (NOMA(1:4).EQ.'DFDT') THEN
            IF (K.LT.10) THEN
               WRITE(NOMA2,FMT='(I1,A7)') K,NOMA(1:7)
            ELSE
               WRITE(NOMA2,FMT='(I2,A6)') K,NOMA(1:6)
            ENDIF
            TYPE = '        '
            CALL ACMO(MTAB1,NOMA2,TYPE,MTABLE)
            IF (TYPE.EQ.'TABLE') THEN
C
C- Caractérisation de la syntaxe de DFDT : le champoint contenant
C- les valeurs de l'inconnue au pas de temps précédant se trouve
C-   ISYNT =1 -> Dans la table DFDT  MTABLE
C-   ISYNT =2 -> Dans la table INCO  MTAB2
C
           TYPE = '        '
           CALL ACMO(MTABLE,'KOPT    ',TYPE,KOPT)
           CALL ACME(KOPT,'ISCHT',ISCHT)
           IF(ISCHT.EQ.1.OR.ISCHT.EQ.2)THEN
C
C- Récupération du nom de l'indice de la table INCO contenant
C- le CHPOINT au temps précédent N.   
C
            TYPE = '        '
            CALL ACMO(MTABLE,'ARG2',TYPE,MCHPI)
            IF (IERR.NE.0) RETURN
            IF (TYPE.EQ.'CHPOINT ') THEN
               ISYNT = 1
            ELSEIF (TYPE.EQ.'MOT     ') THEN
               ISYNT = 2
               CALL ACMM(MTABLE,'ARG2',NOM)
               IF (IERR.NE.0) RETURN
               TYP2 = 'CHPOINT '
               CALL ACMO(MTAB2,NOM,TYP2,MCHPI)
               IF (IERR.NE.0) RETURN
            ELSE
               MOTERR( 1: 8) = NOMA
               MOTERR( 9:16) = 'ARG2    '
               MOTERR(17:30) = 'CHPOINT ou MOT'
               CALL ERREUR(763)
               RETURN
            ENDIF
C
C Récupération du nom de l'indice de la table INCO contenant le
C point au 2eme temps précédent N-1.
C
               TYPE = '        '
               CALL ACMO(MTABLE,'ARG3',TYPE,MCHPN)
               IF (IERR.NE.0) RETURN
               IF (TYPE.EQ.'CHPOINT ') THEN
                  ISYNT = 1
               ELSEIF (TYPE.EQ.'MOT     ') THEN
                  ISYNT = 2
                  CALL ACMM(MTABLE,'ARG3',NOM)
                  IF (IERR.NE.0) RETURN
                  TYP2 = 'CHPOINT '
                  CALL ACMO(MTAB2,NOM,TYP2,MCHPN)
                  IF (IERR.NE.0) RETURN
               ELSE
                  MOTERR( 1: 8) = NOMA
                  MOTERR( 9:16) = 'ARG3    '
                  MOTERR(17:30) = 'CHPOINT ou MOT'
                  CALL ERREUR(763)
                  RETURN
               ENDIF
C
C- Duplication du CHPOINT contenant l'inconnue au temps N vers N-1
C
             IF(IUPDT.EQ.1)THEN
* gounand 07/12/2012 : dans TCRR, on change de stratégie et on crée un
* chpoint tout neuf, cela permet d'éviter les appels à COPIER dans TCNM
* et dans les procédures utilisateurs. On pourra aussi se référer au
* pointeur pour préconditionner.
*               CALL ECROBJ('CHPOINT',MCHPI)
*               CALL COPIER
*               CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
                MCHPOI=MCHPI

C
C- Update du CHPOINT contenant l'inconnue au temps précédant
C
               IF (ISYNT.EQ.1) THEN
                  CALL ECMO(MTABLE,'ARG3',TYPE,MCHPOI)
               ELSE
                  CALL ECMO(MTAB2,NOM,TYP2,MCHPOI)
               ENDIF

             ENDIF
            ENDIF
C
C- Récupération du nom de l'indice de la table INCO contenant
C- le CHPOINT au temps courant N+1 (donc près calcul).
C
               TYPE = 'LISTMOTS'
               CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT1)
               IF (IERR.NE.0) RETURN
               SEGACT MLMOT1
               NOMINC = MLMOT1.MOTS(1)
               SEGDES MLMOT1
C
C- Récupération du pointeur du CHPOINT dans la table INCO à l'instant N.
C
               TYPE = 'CHPOINT '
               CALL ACMO(MTAB2,NOMINC,TYPE,MCHPI)
               IF (IERR.NE.0) RETURN
               TYPE = '        '
               CALL ACMO(MTABLE,'ARG2',TYPE,MCHPN)
               IF (IERR.NE.0) RETURN
               IF (TYPE.EQ.'CHPOINT ') THEN
                  ISYNT = 1
               ELSEIF (TYPE.EQ.'MOT     ') THEN
                  ISYNT = 2
                  CALL ACMM(MTABLE,'ARG2',NOM)
                  IF (IERR.NE.0) RETURN
                  TYP2 = 'CHPOINT '
                  CALL ACMO(MTAB2,NOM,TYP2,MCHPN)
                  IF (IERR.NE.0) RETURN
               ELSE
                  MOTERR( 1: 8) = NOMA
                  MOTERR( 9:16) = 'ARG2    '
                  MOTERR(17:30) = 'CHPOINT ou MOT'
                  CALL ERREUR(763)
                  RETURN
               ENDIF
C
C- Duplication du CHPOINT contenant l'inconnue au temps courant N+1 vers N
C
             IF(IUPDT.EQ.1)THEN
* gounand 07/12/2012 : dans TCRR, on change de stratégie et on crée un
* chpoint tout neuf, cela permet d'éviter les appels à COPIER dans TCNM
* et dans les procédures utilisateurs. On pourra aussi se référer au
* pointeur pour préconditionner.
*               CALL ECROBJ('CHPOINT',MCHPI)
*               CALL COPIER
*               CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
                MCHPOI=MCHPI
C
C- Update du CHPOINT contenant l'inconnue au temps précédant
C
               IF (ISYNT.EQ.1) THEN
                  CALL ECMO(MTABLE,'ARG2',TYPE,MCHPOI)
               ELSE
                  CALL ECMO(MTAB2,NOM,TYP2,MCHPOI)
               ENDIF
             ENDIF
            ENDIF
C
C- Activation du MPOVAL de l'inconnue au temps précédant
C  -----------------------------------------------------
         CALL LICHT(MCHPI,IPHI,TYP0,IGEOM0)
C
C- Traitement des historiques
C  --------------------------
         IF (MTABT.NE.0) THEN
            TYPE=' '
            CALL ACMO(MTAB1,'HIST',TYPE,KHIS)
            IF (KHIS.NE.0)THEN
               NUCOMP   = IPHI.VPOCHA(/2)
               NOMIX(1) = NOMINC
               NOMIX(2) = '1'//NOMINC(1:7)
               NOMIX(3) = '2'//NOMINC(1:7)
               NOMIX(4) = '3'//NOMINC(1:7)
               DO 82 NUC=1,NUCOMP+1
                  NUCR = 1
                  IF (NUC.GT.1) NUCR=NUC-1
                  TYPE = ' '
                  CALL ACMO(KHIS,NOMIX(NUC),TYPE,MEVOLL)
                  IF (TYPE.EQ.'EVOLUTIO')THEN
                     TYPE1=' '
                     NOMI1='$'//NOMIX(NUC)
                     CALL ACMO(KHIS,NOMI1,TYPE1,MAH)
                     IF (TYPE1.EQ.'MAILLAGE') THEN
                        SEGACT MAH
                     ELSE
                     CALL ERREUR(503)
                     RETURN
                     ENDIF
                     CALL ECROBJ('CHPOINT',MCHPI)
                     CALL ECROBJ('MAILLAGE',MAH)
                     CALL REDU
                     CALL LIROBJ('CHPOINT',IZH,1,IRET)
                     CALL LICHT(IZH,IPHH,TYP0,IGEOM)
                     CALL KRIPAD(IGEOM,MLENTI)
                     TYPE1=' '
                     CALL ACMO(KHIS,'KFIH',TYPE1,KFIH)
                     IF (TYPE1.EQ.'ENTIER') THEN
                        CALL ACME(KHIS,'KFIH',KFIH)
                     ELSE
                        KFIH = 20
                     ENDIF
                     INDH = IPT - IPT/KFIH * KFIH
                     IF (INDH.NE.0) GOTO 80

                     SEGACT MEVOLL,MAH
                     NH=MAH.NUM(/2)
                     DO 81 IH=1,NH
                        KEVOLL=IEVOLL(IH)
                        SEGACT KEVOLL
                        MLREE1=IPROGX
                        IF (IH.EQ.1)THEN
                            SEGACT MLREE1
                            JG=MLREE1.PROG(/1)+1
                            SEGADJ MLREE1
                            MLREE1.PROG(JG)=TPS
                            SEGDES MLREE1
                        ENDIF

                        MLREE2=IPROGY
                        SEGACT MLREE2
                        SEGADJ MLREE2
                        IH1=LECT(MAH.NUM(1,IH))
C                       write(6,*)' IH,IH1,NUCR=',IH,IH1,NUCR,JG
                        IF(IH1.EQ.0)THEN
                        MLREE2.PROG(JG)=0.D0
                        ELSE
                        MLREE2.PROG(JG)=IPHH.VPOCHA(IH1,NUCR)
                        ENDIF
                        SEGDES MLREE2,KEVOLL
 81                  CONTINUE
                     SEGDES MEVOLL,MAH
 80                  CONTINUE
                     SEGDES MAH
                   SEGSUP MLENTI
                  ENDIF

 82            CONTINUE
            ENDIF
         ELSE
        WRITE(IOIMP,*)' Pour des historiques il faut une table PASDETPS'
         ENDIF
C
         SEGDES IPHI
         SEGDES IGEOM0
         ENDIF
 10   CONTINUE
C
C
C- Impressions de controle
C  -----------------------
      IF (IMPR.NE.0) THEN
         KFIDT = IMPR
         IF (MTABT.NE.0) THEN
            CALL ACMM(MTABT,'OPER',NOMINC)
            CALL ACMM(MTABT,'ZONE',NOMZ)
            CALL ACMF(MTABT,'DTCONV',DTT1)
            CALL ACMF(MTABT,'DTDIFU',DTT2)
            CALL ACMF(MTABT,'DIAEL',DIAEL)
            CALL ACME(MTABT,'NUEL',NUEL)
            CALL ACME(MTABT,'NUPASDT',IPT)
         ELSE
            IPT=1
         ENDIF
         IND = IPT - IPT/KFIDT * KFIDT

C           write(6,*)' TCNM NOMZ=',NOMZ
          IF(NOMZ(1:4).NE.'EQEX')THEN
         IF (IPT.EQ.1) THEN
            WRITE(IOIMP,*)
     & ' IPT : NUMERO DU PAS DE TEMPS , NUEL : NUMERO DE L ELEMENT , '
     &,' DIAEL : DIAMETRE MOYEN DE L ELEMENT '
            WRITE(IOIMP,*)
     &' ALFA : TOLERANCE SUR LE PAS DE TEMPS , DTMAX : PAS DE TEMPS MAX'
     &,' DTT1 : PAS DE TEMPS DE CONVECTION , DTT2 : PAS DE TEMPS DE'
     &,' DIFFUSION '
            WRITE(IOIMP,*) ' TPS : TEMPS CUMULE'
         ENDIF
         IF (IND.EQ.0)THEN
            WRITE(IOIMP,1011)NOMZ,NOMINC
            WRITE(IOIMP,1010)IPT,NUEL,DIAEL,ALFA,DT,DTT1,DTT2,TPS
         ENDIF
          ELSE

         IF (IPT.EQ.1) THEN
            WRITE(IOIMP,*) ' PAS DE TEMPS IMPOSE : DT , ',
     & ' IPT : NUMERO DU PAS DE TEMPS , TPS : TEMPS CUMULE'
         ENDIF
         IF (IND.EQ.0)THEN
            WRITE(IOIMP,1012)IPT,DT,TPS
         ENDIF
          ENDIF

      ENDIF
C
C- Mise à jour de la table PASDETPS
C  --------------------------------
 800  CONTINUE
C???  IF (KIZD.NE.0.AND.KIZG.NE.0) THEN
         IF (MTABT.NE.0) THEN
           IF(IUPDT.EQ.1)THEN
            CALL ECMF(MTABT,'DELTAT-1',DT)
            CALL ECMF(MTABT,'TPS',TPS)
            DT=1.D30
            CALL ECMF(MTABT,'DELTAT',DT)
            IPT = IPT + 1
            CALL ECME(MTABT,'NUPASDT',IPT)
           ENDIF
         ENDIF
C???  ENDIF

      CALL ECRENT(IFINAL)

C
C- Désactivation et ménage
C
      SEGDES MLMOTS
      RETURN
C
C- Formats associés aux impression de controle
C  -------------------------------------------
 1010 FORMAT(2X,'N.DT',I5,' NU.EL',I5,' DIAEL=',1PE11.4,' ALFA=',
     &       1PE11.4,' DTMAX=',1PE11.4,
     &       ' DT1=',1PE11.4,' DT2=',1PE11.4,' TPS=',1PE11.4)
 1011 FORMAT(2X,' ZONE :',A8,' OPERATEUR :',A8)
 1012 FORMAT(2X,'N.DT',I5,' DT=',1PE11.4,' TPS=',1PE11.4)
      END