Télécharger chmsrt.eso

Retour à la liste

chmsrt
C CHMSRT    SOURCE    CB215821  20/11/25    13:19:34     10792          
c modfi PhM: on arajoute le chpoint des erreur
      SUBROUTINE CHMSRT(MCHAQU,MCHFIX,MCHSOL,MCHSUR,MCHTY3,MCHTY4,
     * MCHTY5,MCHTY6,MCHFIO,MCHPRE,MCHPOL,MCHGKS,MCHLGC,MCHERR)
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
C------------------------------------------------------------------
C
C       CHARGEMENT DE LA TABLE RESULTAT DE CHI2
C
C------------------------------------------------------------------
c modif PhM 12/00 : on rajoute le chpoint des erreur
c
-INC SMTABLE
-INC SMCHPOI
 
-INC PPARAM
-INC CCOPTIO
      CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
C
      CALL CRTABL(MTAB1)
      CALL ECCTAB(MTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,'MOT',
     *  0,0.D0,'CHIMI2',.TRUE.,0)
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      MTYPI='MOT     '
      IRETR=MCHAQU
      MTYPR='CHPOINT '
      CHARR='        '
      CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'AQUE',.TRUE.,
     *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
      MCHPOI=MCHAQU
      MSOUPO=IPCHP(1)
      MPOVAL=IPOVAL
      SEGDES MCHPOI,MSOUPO,MPOVAL
      IRETR=MCHFIX
      MTYPR='CHPOINT '
      CHARR='        '
      CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIXE',.TRUE.,
     *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
      MCHPOI=MCHFIX
      MSOUPO=IPCHP(1)
      MPOVAL=IPOVAL
      SEGDES MCHPOI,MSOUPO,MPOVAL
      IRETR=MCHLGC
      MTYPR='CHPOINT '
      CHARR='        '
      CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE.,
     *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
      MCHPOI=MCHLGC
      MSOUPO=IPCHP(1)
      MPOVAL=IPOVAL
      SEGDES MCHPOI,MSOUPO,MPOVAL
 
 
 
      IRETR=MCHERR
      MTYPR='CHPOINT '
      CHARR='        '
      CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'ERR',.TRUE.,
     *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
      MCHPOI=MCHERR
      MSOUPO=IPCHP(1)
      MPOVAL=IPOVAL
      SEGDES MCHPOI,MSOUPO,MPOVAL
 
      IF(MCHSOL.NE.0)THEN
            IRETR=MCHSOL
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHSOL
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHSUR.NE.0)THEN
            IRETR=MCHSUR
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SURF',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHSUR
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHTY3.NE.0)THEN
            IRETR=MCHTY3
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHTY3
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHTY4.NE.0)THEN
            IRETR=MCHTY4
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHTY4
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHTY5.NE.0)THEN
            IRETR=MCHTY5
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP5',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHTY5
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHTY6.NE.0)THEN
            IRETR=MCHTY6
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHTY6
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHPOL.NE.0)THEN
            IRETR=MCHPOL
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'POLE',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHPOL
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHGKS.NE.0)THEN
*     write(6,*)'chmsrt mchgks',mchgks
            IRETR=MCHGKS
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHGKS
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHFIO.NE.0)THEN
            IRETR=MCHFIO
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FION',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHFIO
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      IF(MCHPRE.NE.0)THEN
            IRETR=MCHPRE
            MTYPR='CHPOINT '
            CHARR='        '
            CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PREC',.TRUE.,
     *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
            MCHPOI=MCHPRE
            MSOUPO=IPCHP(1)
            MPOVAL=IPOVAL
            SEGDES MCHPOI,MSOUPO,MPOVAL
      ENDIF
      CALL ECROBJ('TABLE',MTAB1)
      SEGDES MTAB1
      RETURN
      END
 
 
 
 
 
 
 

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