1 : C CHMSRT SOURCE CHAT 05/01/12 22:00:19 5004 2 : c modfi PhM: on arajoute le chpoint des erreur 3 : SUBROUTINE CHMSRT(MCHAQU,MCHFIX,MCHSOL,MCHSUR,MCHTY3,MCHTY4, 4 : * MCHTY5,MCHTY6,MCHFIO,MCHPRE,MCHPOL,MCHGKS,MCHLGC,MCHERR) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C------------------------------------------------------------------ 8 : C 9 : C CHARGEMENT DE LA TABLE RESULTAT DE CHI2 10 : C 11 : C------------------------------------------------------------------ 12 : c modif PhM 12/00 : on rajoute le chpoint des erreur 13 : c 14 : -INC SMTABLE 15 : -INC SMCHPOI 16 : -INC CCOPTIO 17 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 18 : C 18 : CALL CRTABL(MTAB1) 18 : CALL ECCTAB(MTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,'MOT', 19 : * 0,0.D0,'CHIMI2',.TRUE.,0) 20 : IVALI=0 21 : XVALI=0.D0 22 : IRETI=0 23 : IVALR=0 24 : XVALR=0.D0 25 : MTYPI='MOT ' 26 : IRETR=MCHAQU 27 : MTYPR='CHPOINT ' 28 : CHARR=' ' 28 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'AQUE',.TRUE., 29 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 30 : MCHPOI=MCHAQU 31 : MSOUPO=IPCHP(1) 32 : MPOVAL=IPOVAL 33 : SEGDES MCHPOI,MSOUPO,MPOVAL 34 : IRETR=MCHFIX 35 : MTYPR='CHPOINT ' 36 : CHARR=' ' 36 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIXE',.TRUE., 37 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 38 : MCHPOI=MCHFIX 39 : MSOUPO=IPCHP(1) 40 : MPOVAL=IPOVAL 41 : SEGDES MCHPOI,MSOUPO,MPOVAL 42 : IRETR=MCHLGC 43 : MTYPR='CHPOINT ' 44 : CHARR=' ' 44 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE., 45 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 46 : MCHPOI=MCHLGC 47 : MSOUPO=IPCHP(1) 48 : MPOVAL=IPOVAL 49 : SEGDES MCHPOI,MSOUPO,MPOVAL 50 : 51 : 52 : 53 : IRETR=MCHERR 54 : MTYPR='CHPOINT ' 55 : CHARR=' ' 55 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'ERR',.TRUE., 56 : *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 57 : MCHPOI=MCHERR 58 : MSOUPO=IPCHP(1) 59 : MPOVAL=IPOVAL 60 : SEGDES MCHPOI,MSOUPO,MPOVAL 61 : 62 : IF(MCHSOL.NE.0)THEN 63 : IRETR=MCHSOL 64 : MTYPR='CHPOINT ' 65 : CHARR=' ' 65 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOLU',.TRUE., 66 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 67 : MCHPOI=MCHSOL 68 : MSOUPO=IPCHP(1) 69 : MPOVAL=IPOVAL 70 : SEGDES MCHPOI,MSOUPO,MPOVAL 71 : ENDIF 72 : IF(MCHSUR.NE.0)THEN 73 : IRETR=MCHSUR 74 : MTYPR='CHPOINT ' 75 : CHARR=' ' 75 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SURF',.TRUE., 76 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 77 : MCHPOI=MCHSUR 78 : MSOUPO=IPCHP(1) 79 : MPOVAL=IPOVAL 80 : SEGDES MCHPOI,MSOUPO,MPOVAL 81 : ENDIF 82 : IF(MCHTY3.NE.0)THEN 83 : IRETR=MCHTY3 84 : MTYPR='CHPOINT ' 85 : CHARR=' ' 85 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE., 86 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 87 : MCHPOI=MCHTY3 88 : MSOUPO=IPCHP(1) 89 : MPOVAL=IPOVAL 90 : SEGDES MCHPOI,MSOUPO,MPOVAL 91 : ENDIF 92 : IF(MCHTY4.NE.0)THEN 93 : IRETR=MCHTY4 94 : MTYPR='CHPOINT ' 95 : CHARR=' ' 95 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE., 96 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 97 : MCHPOI=MCHTY4 98 : MSOUPO=IPCHP(1) 99 : MPOVAL=IPOVAL 100 : SEGDES MCHPOI,MSOUPO,MPOVAL 101 : ENDIF 102 : IF(MCHTY5.NE.0)THEN 103 : IRETR=MCHTY5 104 : MTYPR='CHPOINT ' 105 : CHARR=' ' 105 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP5',.TRUE., 106 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 107 : MCHPOI=MCHTY5 108 : MSOUPO=IPCHP(1) 109 : MPOVAL=IPOVAL 110 : SEGDES MCHPOI,MSOUPO,MPOVAL 111 : ENDIF 112 : IF(MCHTY6.NE.0)THEN 113 : IRETR=MCHTY6 114 : MTYPR='CHPOINT ' 115 : CHARR=' ' 115 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE., 116 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 117 : MCHPOI=MCHTY6 118 : MSOUPO=IPCHP(1) 119 : MPOVAL=IPOVAL 120 : SEGDES MCHPOI,MSOUPO,MPOVAL 121 : ENDIF 122 : IF(MCHPOL.NE.0)THEN 123 : IRETR=MCHPOL 124 : MTYPR='CHPOINT ' 125 : CHARR=' ' 125 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'POLE',.TRUE., 126 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 127 : MCHPOI=MCHPOL 128 : MSOUPO=IPCHP(1) 129 : MPOVAL=IPOVAL 130 : SEGDES MCHPOI,MSOUPO,MPOVAL 131 : ENDIF 132 : IF(MCHGKS.NE.0)THEN 133 : * write(6,*)'chmsrt mchgks',mchgks 134 : IRETR=MCHGKS 135 : MTYPR='CHPOINT ' 136 : CHARR=' ' 136 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE., 137 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 138 : MCHPOI=MCHGKS 139 : MSOUPO=IPCHP(1) 140 : MPOVAL=IPOVAL 141 : SEGDES MCHPOI,MSOUPO,MPOVAL 142 : ENDIF 143 : IF(MCHFIO.NE.0)THEN 144 : IRETR=MCHFIO 145 : MTYPR='CHPOINT ' 146 : CHARR=' ' 146 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FION',.TRUE., 147 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 148 : MCHPOI=MCHFIO 149 : MSOUPO=IPCHP(1) 150 : MPOVAL=IPOVAL 151 : SEGDES MCHPOI,MSOUPO,MPOVAL 152 : ENDIF 153 : IF(MCHPRE.NE.0)THEN 154 : IRETR=MCHPRE 155 : MTYPR='CHPOINT ' 156 : CHARR=' ' 156 : CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PREC',.TRUE., 157 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 158 : MCHPOI=MCHPRE 159 : MSOUPO=IPCHP(1) 160 : MPOVAL=IPOVAL 161 : SEGDES MCHPOI,MSOUPO,MPOVAL 162 : ENDIF 162 : CALL ECROBJ('TABLE',MTAB1) 163 : SEGDES MTAB1 164 : RETURN 165 : END 166 : 167 : 168 : 169 : 170 :
© Cast3M 2003 - All rights reserved.
Disclaimer