Esope source files

   1 : C CHMTET    SOURCE    CHAT      05/01/12    22:00:23     5004           
   2 :       SUBROUTINE CHMTET(ITEMPE,LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C       LECTURE DE LA TABLE TEMPE SI ELLE EXISTE
   8 : C       SINON ON INITIALISE TOUS LES POINTEURS A 0
   9 : C
  10 : C------------------------------------------------------------------
  11 : -INC SMTABLE
  12 : -INC SMLENTI
  13 : -INC SMLREEL
  14 : -INC CCOPTIO
  15 :       SEGMENT LGKMOD
  16 :            REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  17 :       ENDSEGMENT
  18 :       SEGMENT LGKTMP
  19 :            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  20 :            REAL*8 TMIMA(NYDIM,NT)
  21 :            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  22 :       ENDSEGMENT
  23 :       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR,MTYPS,CHARS
  24 :       LOGICAL LOGRE
  25 : C
  26 :       LGKMOD=0
  27 :       LGKTMP=0
  28 :       IP1=0
  29 :       IP2=0
  30 :       IP3=0
  31 :       IP4=0
  32 :       IP5=0
  33 :       IF(ITEMPE.EQ.0)RETURN
  34 : C                    BASE MINEQL
  35 :       MTAB1=ITEMPE
  36 :       SEGACT MTAB1
  37 :       IRETR=0
  38 :       IVALI=0
  39 :       XVALI=0.D0
  40 :       IRETI=0
  41 :       IVALR=0
  42 :       XVALR=0.D0
  43 :       MTYPI='MOT     '
  44 :       MTYPR='        '
  45 :       CHARR='        '
  45 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  46 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  47 :       IF(MTYPR.NE.'        ')THEN
  48 :               IF(MTYPR.NE.'LISTREEL')THEN
  49 :                     MOTERR(1:11)='DELTAH     '
  50 :                     MOTERR(12:20)='LISTREEL'
  50 :                     CALL ERREUR(627)
  51 :                     RETURN
  52 :               ENDIF
  53 :               MLREEL=IP1
  54 :               SEGACT MLREEL
  55 :               NYDIM=PROG(/1)
  56 :               MTYPS='LISTREEL'
  57 :               CHARS='        '
  57 :               CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  58 :      *         IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IP2)
  59 :               MLREEL=IP2
  60 :               SEGACT MLREEL
  61 :               SEGINI LGKMOD
  62 :               IP3=1
  63 :               MTYPS='ENTIER  '
  64 :               CHARS='        '
  64 :               CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  65 :      *         IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IRET)
  66 :               IP3=IVALR
  67 :               SEGDES MTAB1
  68 :               RETURN
  69 :       ENDIF
  70 : C                   BASE DE STASBOURG
  71 :       IVALI=0
  72 :       XVALI=0.D0
  73 :       IRETI=0
  74 :       IVALR=0
  75 :       XVALR=0.D0
  76 :       MTYPI='MOT     '
  77 :       MTYPR='        '
  78 :       CHARR='        '
  78 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
  79 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP5)
  80 :       IF(MTYPR.EQ.'        ')THEN
  81 :              IP5=0
  82 :              SEGDES MTAB1
  83 :              RETURN
  84 :       ELSE
  85 :               IF(MTYPR.NE.'LISTENTI')THEN
  86 :                     MOTERR(1:11)='NUMT       '
  87 :                     MOTERR(12:20)='LISTENTI'
  87 :                     CALL ERREUR(627)
  88 :                     RETURN
  89 :               ENDIF
  90 :               MLENTI=IP5
  91 :               SEGACT MLENTI
  92 :               NYDIM=LECT(/1)
  93 :       ENDIF
  94 :       IP1=0
  95 :       MTYPR='LISTREEL'
  96 :       CHARR='        '
  96 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  97 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  98 :       IF(IERR.NE.0)RETURN
  99 :       MLREEL=IP1
 100 :       SEGACT MLREEL
 101 :       JG=PROG(/1)
 102 :       NT=JG/NYDIM
 103 :       NT4=NT*4
 104 :       SEGINI LGKTMP
 105 :       MTYPR='LISTREEL'
 106 :       CHARR='        '
 106 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
 107 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP2)
 108 :       IF(IERR.NE.0)RETURN
 109 :       MLREEL=IP2
 110 :       SEGACT MLREEL
 111 :       MTYPR='LISTREEL'
 112 :       CHARR='        '
 112 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
 113 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP3)
 114 :       IF(IERR.NE.0)RETURN
 115 :       MLREEL=IP3
 116 :       SEGACT MLREEL
 117 :       MTYPR='LISTENTI'
 118 :       CHARR='        '
 118 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
 119 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP4)
 120 :       IF(IERR.NE.0)RETURN
 121 :       MLENTI=IP4
 122 :       SEGACT MLENTI
 123 :       SEGDES MTAB1
 124 :       RETURN
 125 :       END
 126 :  
 127 :  
 128 :  
 129 :