Esope source files

   1 : C TCNMA     SOURCE    GOUNAND   12/12/10    21:15:11     7598           
   2 :       SUBROUTINE TCNMA(MTAB1)
   3 : C-----------------------------------------------------------------------
   4 : C Mise à jour des CHPOINTs à l'occasion du changement de pas de temps.
   5 : C-----------------------------------------------------------------------
   6 : C Les tables de sous type KIZX associées à l'opérateur DFDT permettent
   7 : C d'effectuer la mise à jour. Pour chaque opérateur DFDT, selon la
   8 : C syntaxe ayant été utilisée
   9 : C 1) si l'objet pointé à l'indice ARG2 de la table associée à
  10 : C    l'opérateur DFDT considéré est un CHPOINT on l'update ou
  11 : C 2) on récupere à l'indice ARG2 de la table associée à DFDT le nom
  12 : C    associé à l'inconnue à updater dans la table INCO et on update le
  13 : C    CHPOINT dans INCO.
  14 : C
  15 : C---------------------------
  16 : C Phrase d'appel (GIBIANE) :
  17 : C---------------------------
  18 : C
  19 : C TCNM TAB1 ;
  20 : C
  21 : C------------------------
  22 : C Opérandes et résultat :
  23 : C------------------------
  24 : C
  25 : C TAB1 : TABLE de sous type EQEX contenant l'ensemble des données pour
  26 : C        la modélisation.
  27 : C
  28 : C----------------------------
  29 : C Indices de table modifiés :
  30 : C----------------------------
  31 : C
  32 : C Indice ARG2 des tables DFDT si ISYNT=1.
  33 : C Indices de la table INCO alias du nom des inconnues à traiter sinon.
  34 : C
  35 : C----------------------
  36 : C Variables principales
  37 : C----------------------
  38 : C
  39 : C ISYNT  : Flag indiquant le type de syntaxe utilisé
  40 : C MTAB1  : Pointeur vers la table de sous type EQEX
  41 : C MTAB2  : Pointeur vers la table INCO
  42 : C MTABLE : Pointeur vers une table associée à un opérateur (DFDT...)
  43 : C
  44 : C-----------------------------------------------------------------------
  45 :       IMPLICIT INTEGER(I-N)
  46 :       IMPLICIT REAL*8 (A-H,O-Z)                 
  47 :       CHARACTER*8 NOMI,TYPE,NOMINC,TYP2,NOM,NOMA,NOMA2
  48 : C
  49 : -INC CCOPTIO
  50 : -INC SMLMOTS
  51 : C
  52 : C
  53 : C- Lecture de la table INCO
  54 : C
  55 :       TYPE  = 'TABLE   '
  55 :       CALL ACMO(MTAB1,'INCO',TYPE,MTAB2)
  56 :       IF (IERR.NE.0) RETURN
  57 : C
  58 : C- Récupération du LISTMOTS à l'indice 'LISTOPER' de la table EQEX
  59 : C
  60 :       TYPE = 'LISTMOTS'
  60 :       CALL ACMO(MTAB1,'LISTOPER',TYPE,MLMOTS)
  61 :       IF (IERR.NE.0) RETURN
  62 :       SEGACT MLMOTS
  63 :       NBIND = MOTS(/2)
  64 :       IF (NBIND.GE.100) THEN
  65 :           INTERR(1) = 100
  65 :           CALL ERREUR(762)
  66 :       ENDIF
  67 : C
  68 : C- Recherche de l'ensemble des champs à mettre à jour via DFDT
  69 : C
  70 :       DO 10 K=1,NBIND
  71 :          NOMA = MOTS(K)
  72 :          IF (NOMA(1:4).EQ.'DFDT') THEN
  73 :             IF (K.LT.10) THEN
  74 :                WRITE(NOMA2,FMT='(I1,A7)') K,NOMA(1:7)
  75 :             ELSE
  76 :                WRITE(NOMA2,FMT='(I2,A6)') K,NOMA(1:6)
  77 :             ENDIF
  78 :             TYPE = '        '
  78 :             CALL ACMO(MTAB1,NOMA2,TYPE,MTABLE)
  79 :             IF (TYPE.EQ.'TABLE') THEN
  80 : C
  81 : C- Récupération du nom de l'indice de la table INCO contenant
  82 : C- le CHPOINT au temps courant.
  83 : C
  84 :                TYPE = 'LISTMOTS'
  84 :                CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT1)
  85 :                IF (IERR.NE.0) RETURN
  86 :                SEGACT MLMOT1
  87 :                NOMINC = MLMOT1.MOTS(1)
  88 :                SEGDES MLMOT1
  89 : C
  90 : C- Récupération du pointeur du CHPOINT dans la table INCO.
  91 : C
  92 :                TYPE = 'CHPOINT '
  92 :                CALL ACMO(MTAB2,NOMINC,TYPE,MCHPI)
  93 :                IF (IERR.NE.0) RETURN
  94 : C
  95 : C- Caractérisation de la syntaxe de DFDT : le champoint contenant
  96 : C- les valeurs de l'inconnue au pas de temps précédant se trouve
  97 : C-   ISYNT =1 -> Dans la table DFDT
  98 : C-   ISYNT =2 -> Dans la table INCO
  99 : C
 100 :                TYPE = '        '
 100 :                CALL ACMO(MTABLE,'ARG2',TYPE,MCHPN)
 101 :                IF (IERR.NE.0) RETURN
 102 :                IF (TYPE.EQ.'CHPOINT ') THEN
 103 :                   ISYNT = 1
 104 :                ELSEIF (TYPE.EQ.'MOT     ') THEN
 105 :                   ISYNT = 2
 105 :                   CALL ACMM(MTABLE,'ARG2',NOM)
 106 :                   IF (IERR.NE.0) RETURN
 107 :                   TYP2 = 'CHPOINT '
 107 :                   CALL ACMO(MTAB2,NOM,TYP2,MCHPN)
 108 :                   IF (IERR.NE.0) RETURN
 109 :                ELSE
 110 :                   MOTERR( 1: 8) = NOMA
 111 :                   MOTERR( 9:16) = 'ARG2    '
 112 :                   MOTERR(17:30) = 'CHPOINT ou MOT'
 112 :                   CALL ERREUR(763)
 113 :                   RETURN
 114 :                ENDIF
 115 : C
 116 : C- Duplication du CHPOINT contenant l'inconnue au temps courant
 117 : C
 118 : * gounand 07/12/2012 : dans TCRR, on change de stratégie et on crée un
 119 : * chpoint tout neuf, cela permet d'éviter les appels à COPIER dans TCNM
 120 : * et dans les procédures utilisateurs. On pourra aussi se référer au
 121 : * pointeur pour préconditionner.
 121 : *               CALL ECROBJ('CHPOINT',MCHPI)
 121 : *               CALL COPIER
 121 : *               CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
 122 :                MCHPOI=MCHPI
 123 : C
 124 : C- Update du CHPOINT contenant l'inconnue au temps précédant
 125 : C
 126 :                IF (ISYNT.EQ.1) THEN
 126 :                   CALL ECMO(MTABLE,'ARG2',TYPE,MCHPOI)
 127 :                ELSE
 127 :                   CALL ECMO(MTAB2,NOM,TYP2,MCHPOI)
 128 :                ENDIF
 129 :             ENDIF
 130 :          ENDIF
 131 :  10   CONTINUE
 132 : C
 133 : C- Désactivation et ménage
 134 : C
 135 :       SEGDES MLMOTS
 136 :       RETURN
 137 :       END                                                                       
 138 :  
 139 :  
 140 :  
 141 :  
 142 :