Télécharger la plaquette Cast3M


fr en

Télécharger chitet.eso

Retour à la liste

Numérotation des lignes : 

chitet

  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.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.       SEGMENT IDSCHI
  17.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  18.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  19.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  20.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  21.       ENDSEGMENT
  22.       SEGMENT LGKMOD
  23.            REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  24.       ENDSEGMENT
  25.       SEGMENT LGKTMP
  26.            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  27.            REAL*8 TMIMA(NYDIM,NT)
  28.            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  29.       ENDSEGMENT
  30.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  31. C
  32.       NYDIM=IDY(/1)
  33.       NXDIM=IDX(/1)
  34.       NZDIM=IDZ(/1)
  35.       NPDIM=IDP(/1)
  36.       SEGACT MTAB1
  37.       IF(LBDD.EQ.0)THEN
  38. C               BASE MINEQL
  39.       CALL CHITMP(IDSCHI,LGKMOD,IOCHI3)
  40.       IVALI=0
  41.       XVALI=0.D0
  42.       IRETI=0
  43.       IVALR=0
  44.       XVALR=0.D0
  45.       MTYPI='MOT     '
  46.       JG=NYDIM
  47.       SEGINI MLREEL
  48.       CALL RSETD(PROG,DELH0,JG)
  49.       IRETR=MLREEL
  50.       MTYPR='LISTREEL'
  51.       CHARR='        '
  52.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  53.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  54.       SEGDES MLREEL
  55.       SEGINI MLREEL
  56.       CALL RSETD(PROG,DELCP0,JG)
  57.       IRETR=MLREEL
  58.       MTYPR='LISTREEL'
  59.       CHARR='        '
  60.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  61.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  62.       SEGDES MLREEL
  63.       SEGSUP LGKMOD
  64.       IRETR=0
  65.       MTYPR='ENTIER  '
  66.       CHARR='        '
  67.       IVALR=LTMP
  68.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  69.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  70.       ELSEIF(LBDD.EQ.1)THEN
  71. C                   BASE DE STASBOURG
  72.       CALL CHITPS(IDSCHI,LGKTMP,IOCHI3)
  73.       NT=TMIMA(/2)
  74.       IVALI=0
  75.       XVALI=0.D0
  76.       IRETI=0
  77.       IVALR=0
  78.       XVALR=0.D0
  79.       MTYPI='MOT     '
  80.       JG=NYDIM*NT
  81.       SEGINI MLREEL
  82.       CALL RSETD(PROG,TMIMA,JG)
  83.       IRETR=MLREEL
  84.       MTYPR='LISTREEL'
  85.       CHARR='        '
  86.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  87.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  88.       SEGDES MLREEL
  89.       JG=NYDIM*NT*4
  90.       SEGINI MLREEL
  91.       CALL RSETD(PROG,POLYT,JG)
  92.       IRETR=MLREEL
  93.       MTYPR='LISTREEL'
  94.       CHARR='        '
  95.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
  96.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  97.       SEGDES MLREEL
  98.       JG=NYDIM*NT
  99.       SEGINI MLREEL
  100.       CALL RSETD(PROG,TGKLU,JG)
  101.       IRETR=MLREEL
  102.       MTYPR='LISTREEL'
  103.       CHARR='        '
  104.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  105.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  106.       SEGDES MLREEL
  107.       JG=NYDIM
  108.       SEGINI MLENTI
  109.       CALL RSETI(LECT,NTVT,JG)
  110.       IRETR=MLENTI
  111.       MTYPR='LISTENTI'
  112.       CHARR='        '
  113.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
  114.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  115.       SEGDES MLENTI
  116.       JG=NYDIM
  117.       SEGINI MLENTI
  118.       CALL RSETI(LECT,NUMT,JG)
  119.       IRETR=MLENTI
  120.       MTYPR='LISTENTI'
  121.       CHARR='        '
  122.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
  123.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  124.       SEGDES MLENTI
  125.       SEGSUP LGKTMP
  126.       ENDIF
  127.       RETURN
  128.       END
  129.  
  130.  
  131.  
  132.  
  133.  

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