Télécharger la plaquette Cast3M


fr en

Télécharger chmtet.eso

Retour à la liste

Numérotation des lignes : 

chmtet

  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.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.       SEGMENT LGKMOD
  18.            REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  19.       ENDSEGMENT
  20.       SEGMENT LGKTMP
  21.            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  22.            REAL*8 TMIMA(NYDIM,NT)
  23.            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  24.       ENDSEGMENT
  25.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR,MTYPS,CHARS
  26.       LOGICAL LOGRE
  27. C
  28.       LGKMOD=0
  29.       LGKTMP=0
  30.       IP1=0
  31.       IP2=0
  32.       IP3=0
  33.       IP4=0
  34.       IP5=0
  35.       IF(ITEMPE.EQ.0)RETURN
  36. C                    BASE MINEQL
  37.       MTAB1=ITEMPE
  38.       SEGACT MTAB1
  39.       IRETR=0
  40.       IVALI=0
  41.       XVALI=0.D0
  42.       IRETI=0
  43.       IVALR=0
  44.       XVALR=0.D0
  45.       MTYPI='MOT     '
  46.       MTYPR='        '
  47.       CHARR='        '
  48.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELTAH',.TRUE.,
  49.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  50.       IF(MTYPR.NE.'        ')THEN
  51.               IF(MTYPR.NE.'LISTREEL')THEN
  52.                     MOTERR(1:11)='DELTAH     '
  53.                     MOTERR(12:20)='LISTREEL'
  54.                     CALL ERREUR(627)
  55.                     RETURN
  56.               ENDIF
  57.               MLREEL=IP1
  58.               SEGACT MLREEL
  59.               NYDIM=PROG(/1)
  60.               MTYPS='LISTREEL'
  61.               CHARS='        '
  62.               CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DELCP',.TRUE.,
  63.      *         IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IP2)
  64.               MLREEL=IP2
  65.               SEGACT MLREEL
  66.               SEGINI LGKMOD
  67.               IP3=1
  68.               MTYPS='ENTIER  '
  69.               CHARS='        '
  70.               CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'APPROX',.TRUE.,
  71.      *         IRETI,MTYPS,IVALR,XVALR,CHARS,LOGRE,IRET)
  72.               IP3=IVALR
  73.               SEGDES MTAB1
  74.               RETURN
  75.       ENDIF
  76. C                   BASE DE STASBOURG
  77.       IVALI=0
  78.       XVALI=0.D0
  79.       IRETI=0
  80.       IVALR=0
  81.       XVALR=0.D0
  82.       MTYPI='MOT     '
  83.       MTYPR='        '
  84.       CHARR='        '
  85.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NUMT',.TRUE.,
  86.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP5)
  87.       IF(MTYPR.EQ.'        ')THEN
  88.              IP5=0
  89.              SEGDES MTAB1
  90.              RETURN
  91.       ELSE
  92.               IF(MTYPR.NE.'LISTENTI')THEN
  93.                     MOTERR(1:11)='NUMT       '
  94.                     MOTERR(12:20)='LISTENTI'
  95.                     CALL ERREUR(627)
  96.                     RETURN
  97.               ENDIF
  98.               MLENTI=IP5
  99.               SEGACT MLENTI
  100.               NYDIM=LECT(/1)
  101.       ENDIF
  102.       IP1=0
  103.       MTYPR='LISTREEL'
  104.       CHARR='        '
  105.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TMIMA',.TRUE.,
  106.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  107.       IF(IERR.NE.0)RETURN
  108.       MLREEL=IP1
  109.       SEGACT MLREEL
  110.       JG=PROG(/1)
  111.       NT=JG/NYDIM
  112.       NT4=NT*4
  113.       SEGINI LGKTMP
  114.       MTYPR='LISTREEL'
  115.       CHARR='        '
  116.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COEF',.TRUE.,
  117.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP2)
  118.       IF(IERR.NE.0)RETURN
  119.       MLREEL=IP2
  120.       SEGACT MLREEL
  121.       MTYPR='LISTREEL'
  122.       CHARR='        '
  123.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  124.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP3)
  125.       IF(IERR.NE.0)RETURN
  126.       MLREEL=IP3
  127.       SEGACT MLREEL
  128.       MTYPR='LISTENTI'
  129.       CHARR='        '
  130.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVT',.TRUE.,
  131.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP4)
  132.       IF(IERR.NE.0)RETURN
  133.       MLENTI=IP4
  134.       SEGACT MLENTI
  135.       SEGDES MTAB1
  136.       RETURN
  137.       END
  138.  
  139.  
  140.  
  141.  
  142.  

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