C CHITET SOURCE CHAT 05/01/12 21:58:20 5004 SUBROUTINE CHITET(MTAB1,IDSCHI,LBDD,IOCHI3,LTMP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C------------------------------------------------------------------ C C CHARGEMENT DE LA TABLE TEMPE C C------------------------------------------------------------------ -INC SMTABLE -INC SMLENTI -INC SMLREEL -INC PPARAM -INC CCOPTIO SEGMENT IDSCHI REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) INTEGER IDECY(NYDIM),IONZ(NXDIM) CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) ENDSEGMENT SEGMENT LGKMOD REAL*8 DELH0(NYDIM),DELCP0(NYDIM) ENDSEGMENT SEGMENT LGKTMP INTEGER NUMT(NYDIM),NTVT(NYDIM) REAL*8 TMIMA(NYDIM,NT) REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT) ENDSEGMENT CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR C NYDIM=IDY(/1) NXDIM=IDX(/1) NZDIM=IDZ(/1) NPDIM=IDP(/1) SEGACT MTAB1 IF(LBDD.EQ.0)THEN C BASE MINEQL CALL CHITMP(IDSCHI,LGKMOD,IOCHI3) IVALI=0 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 MTYPI='MOT ' JG=NYDIM SEGINI MLREEL CALL RSETD(PROG,DELH0,JG) IRETR=MLREEL MTYPR='LISTREEL' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLREEL SEGINI MLREEL CALL RSETD(PROG,DELCP0,JG) IRETR=MLREEL MTYPR='LISTREEL' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLREEL SEGSUP LGKMOD IRETR=0 MTYPR='ENTIER ' CHARR=' ' IVALR=LTMP CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) ELSEIF(LBDD.EQ.1)THEN C BASE DE STASBOURG CALL CHITPS(IDSCHI,LGKTMP,IOCHI3) NT=TMIMA(/2) IVALI=0 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 MTYPI='MOT ' JG=NYDIM*NT SEGINI MLREEL CALL RSETD(PROG,TMIMA,JG) IRETR=MLREEL MTYPR='LISTREEL' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLREEL JG=NYDIM*NT*4 SEGINI MLREEL CALL RSETD(PROG,POLYT,JG) IRETR=MLREEL MTYPR='LISTREEL' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLREEL JG=NYDIM*NT SEGINI MLREEL CALL RSETD(PROG,TGKLU,JG) IRETR=MLREEL MTYPR='LISTREEL' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLREEL JG=NYDIM SEGINI MLENTI CALL RSETI(LECT,NTVT,JG) IRETR=MLENTI MTYPR='LISTENTI' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLENTI JG=NYDIM SEGINI MLENTI CALL RSETI(LECT,NUMT,JG) IRETR=MLENTI MTYPR='LISTENTI' CHARR=' ' CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE., *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) SEGDES MLENTI SEGSUP LGKTMP ENDIF RETURN END