Download chitet.eso

Back to the list

   1 : C CHITET    SOURCE    CHAT      05/01/12    21:58:20     5004           
   2 :       SUBROUTINE CHITET(MTAB1,IDSCHI,LBDD,IOCHI3,LTMP)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C       CHARGEMENT DE LA TABLE TEMPE
   8 : C
   9 : C------------------------------------------------------------------
  10 : -INC SMTABLE
  11 : -INC SMLENTI
  12 : -INC SMLREEL
  13 : -INC CCOPTIO
  14 :       SEGMENT IDSCHI
  15 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  16 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  17 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  18 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  19 :       ENDSEGMENT
  20 :       SEGMENT LGKMOD
  21 :            REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  22 :       ENDSEGMENT
  23 :       SEGMENT LGKTMP
  24 :            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  25 :            REAL*8 TMIMA(NYDIM,NT)
  26 :            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  27 :       ENDSEGMENT
  28 :       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  29 : C
  30 :       NYDIM=IDY(/1)
  31 :       NXDIM=IDX(/1)
  32 :       NZDIM=IDZ(/1)
  33 :       NPDIM=IDP(/1)
  34 :       SEGACT MTAB1
  35 :       IF(LBDD.EQ.0)THEN
  36 : C               BASE MINEQL
  36 :       CALL CHITMP(IDSCHI,LGKMOD,IOCHI3)
  37 :       IVALI=0
  38 :       XVALI=0.D0
  39 :       IRETI=0
  40 :       IVALR=0
  41 :       XVALR=0.D0
  42 :       MTYPI='MOT     '
  43 :       JG=NYDIM
  44 :       SEGINI MLREEL
  44 :       CALL RSETD(PROG,DELH0,JG)
  45 :       IRETR=MLREEL
  46 :       MTYPR='LISTREEL'
  47 :       CHARR='        '
  47 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  48 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  49 :       SEGDES MLREEL
  50 :       SEGINI MLREEL
  50 :       CALL RSETD(PROG,DELCP0,JG)
  51 :       IRETR=MLREEL
  52 :       MTYPR='LISTREEL'
  53 :       CHARR='        '
  53 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  54 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  55 :       SEGDES MLREEL
  56 :       SEGSUP LGKMOD
  57 :       IRETR=0
  58 :       MTYPR='ENTIER  '
  59 :       CHARR='        '
  60 :       IVALR=LTMP
  60 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  61 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  62 :       ELSEIF(LBDD.EQ.1)THEN
  63 : C                   BASE DE STASBOURG
  63 :       CALL CHITPS(IDSCHI,LGKTMP,IOCHI3)
  64 :       NT=TMIMA(/2)
  65 :       IVALI=0
  66 :       XVALI=0.D0
  67 :       IRETI=0
  68 :       IVALR=0
  69 :       XVALR=0.D0
  70 :       MTYPI='MOT     '
  71 :       JG=NYDIM*NT
  72 :       SEGINI MLREEL
  72 :       CALL RSETD(PROG,TMIMA,JG)
  73 :       IRETR=MLREEL
  74 :       MTYPR='LISTREEL'
  75 :       CHARR='        '
  75 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  76 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  77 :       SEGDES MLREEL
  78 :       JG=NYDIM*NT*4
  79 :       SEGINI MLREEL
  79 :       CALL RSETD(PROG,POLYT,JG)
  80 :       IRETR=MLREEL
  81 :       MTYPR='LISTREEL'
  82 :       CHARR='        '
  82 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
  83 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  84 :       SEGDES MLREEL
  85 :       JG=NYDIM*NT
  86 :       SEGINI MLREEL
  86 :       CALL RSETD(PROG,TGKLU,JG)
  87 :       IRETR=MLREEL
  88 :       MTYPR='LISTREEL'
  89 :       CHARR='        '
  89 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  90 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  91 :       SEGDES MLREEL
  92 :       JG=NYDIM
  93 :       SEGINI MLENTI
  93 :       CALL RSETI(LECT,NTVT,JG)
  94 :       IRETR=MLENTI
  95 :       MTYPR='LISTENTI'
  96 :       CHARR='        '
  96 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
  97 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  98 :       SEGDES MLENTI
  99 :       JG=NYDIM
 100 :       SEGINI MLENTI
 100 :       CALL RSETI(LECT,NUMT,JG)
 101 :       IRETR=MLENTI
 102 :       MTYPR='LISTENTI'
 103 :       CHARR='        '
 103 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
 104 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
 105 :       SEGDES MLENTI
 106 :       SEGSUP LGKTMP
 107 :       ENDIF
 108 :       RETURN
 109 :       END
 110 :  
 111 :  
 112 :  
 113 :  

© Cast3M 2003 - All rights reserved.
Disclaimer