Télécharger chmsrt.eso

Retour à la liste

Numérotation des lignes :

  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
  19. CALL CRTABL(MTAB1)
  20. CALL ECCTAB(MTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,'MOT',
  21. * 0,0.D0,'CHIMI2',.TRUE.,0)
  22. IVALI=0
  23. XVALI=0.D0
  24. IRETI=0
  25. IVALR=0
  26. XVALR=0.D0
  27. MTYPI='MOT '
  28. IRETR=MCHAQU
  29. MTYPR='CHPOINT '
  30. CHARR=' '
  31. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'AQUE',.TRUE.,
  32. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  33. MCHPOI=MCHAQU
  34. MSOUPO=IPCHP(1)
  35. MPOVAL=IPOVAL
  36. SEGDES MCHPOI,MSOUPO,MPOVAL
  37. IRETR=MCHFIX
  38. MTYPR='CHPOINT '
  39. CHARR=' '
  40. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIXE',.TRUE.,
  41. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  42. MCHPOI=MCHFIX
  43. MSOUPO=IPCHP(1)
  44. MPOVAL=IPOVAL
  45. SEGDES MCHPOI,MSOUPO,MPOVAL
  46. IRETR=MCHLGC
  47. MTYPR='CHPOINT '
  48. CHARR=' '
  49. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE.,
  50. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  51. MCHPOI=MCHLGC
  52. MSOUPO=IPCHP(1)
  53. MPOVAL=IPOVAL
  54. SEGDES MCHPOI,MSOUPO,MPOVAL
  55.  
  56.  
  57.  
  58. IRETR=MCHERR
  59. MTYPR='CHPOINT '
  60. CHARR=' '
  61. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'ERR',.TRUE.,
  62. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  63. MCHPOI=MCHERR
  64. MSOUPO=IPCHP(1)
  65. MPOVAL=IPOVAL
  66. SEGDES MCHPOI,MSOUPO,MPOVAL
  67.  
  68. IF(MCHSOL.NE.0)THEN
  69. IRETR=MCHSOL
  70. MTYPR='CHPOINT '
  71. CHARR=' '
  72. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,
  73. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  74. MCHPOI=MCHSOL
  75. MSOUPO=IPCHP(1)
  76. MPOVAL=IPOVAL
  77. SEGDES MCHPOI,MSOUPO,MPOVAL
  78. ENDIF
  79. IF(MCHSUR.NE.0)THEN
  80. IRETR=MCHSUR
  81. MTYPR='CHPOINT '
  82. CHARR=' '
  83. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SURF',.TRUE.,
  84. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  85. MCHPOI=MCHSUR
  86. MSOUPO=IPCHP(1)
  87. MPOVAL=IPOVAL
  88. SEGDES MCHPOI,MSOUPO,MPOVAL
  89. ENDIF
  90. IF(MCHTY3.NE.0)THEN
  91. IRETR=MCHTY3
  92. MTYPR='CHPOINT '
  93. CHARR=' '
  94. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,
  95. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  96. MCHPOI=MCHTY3
  97. MSOUPO=IPCHP(1)
  98. MPOVAL=IPOVAL
  99. SEGDES MCHPOI,MSOUPO,MPOVAL
  100. ENDIF
  101. IF(MCHTY4.NE.0)THEN
  102. IRETR=MCHTY4
  103. MTYPR='CHPOINT '
  104. CHARR=' '
  105. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,
  106. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  107. MCHPOI=MCHTY4
  108. MSOUPO=IPCHP(1)
  109. MPOVAL=IPOVAL
  110. SEGDES MCHPOI,MSOUPO,MPOVAL
  111. ENDIF
  112. IF(MCHTY5.NE.0)THEN
  113. IRETR=MCHTY5
  114. MTYPR='CHPOINT '
  115. CHARR=' '
  116. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP5',.TRUE.,
  117. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  118. MCHPOI=MCHTY5
  119. MSOUPO=IPCHP(1)
  120. MPOVAL=IPOVAL
  121. SEGDES MCHPOI,MSOUPO,MPOVAL
  122. ENDIF
  123. IF(MCHTY6.NE.0)THEN
  124. IRETR=MCHTY6
  125. MTYPR='CHPOINT '
  126. CHARR=' '
  127. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,
  128. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  129. MCHPOI=MCHTY6
  130. MSOUPO=IPCHP(1)
  131. MPOVAL=IPOVAL
  132. SEGDES MCHPOI,MSOUPO,MPOVAL
  133. ENDIF
  134. IF(MCHPOL.NE.0)THEN
  135. IRETR=MCHPOL
  136. MTYPR='CHPOINT '
  137. CHARR=' '
  138. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'POLE',.TRUE.,
  139. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  140. MCHPOI=MCHPOL
  141. MSOUPO=IPCHP(1)
  142. MPOVAL=IPOVAL
  143. SEGDES MCHPOI,MSOUPO,MPOVAL
  144. ENDIF
  145. IF(MCHGKS.NE.0)THEN
  146. * write(6,*)'chmsrt mchgks',mchgks
  147. IRETR=MCHGKS
  148. MTYPR='CHPOINT '
  149. CHARR=' '
  150. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  151. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  152. MCHPOI=MCHGKS
  153. MSOUPO=IPCHP(1)
  154. MPOVAL=IPOVAL
  155. SEGDES MCHPOI,MSOUPO,MPOVAL
  156. ENDIF
  157. IF(MCHFIO.NE.0)THEN
  158. IRETR=MCHFIO
  159. MTYPR='CHPOINT '
  160. CHARR=' '
  161. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'FION',.TRUE.,
  162. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  163. MCHPOI=MCHFIO
  164. MSOUPO=IPCHP(1)
  165. MPOVAL=IPOVAL
  166. SEGDES MCHPOI,MSOUPO,MPOVAL
  167. ENDIF
  168. IF(MCHPRE.NE.0)THEN
  169. IRETR=MCHPRE
  170. MTYPR='CHPOINT '
  171. CHARR=' '
  172. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PREC',.TRUE.,
  173. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  174. MCHPOI=MCHPRE
  175. MSOUPO=IPCHP(1)
  176. MPOVAL=IPOVAL
  177. SEGDES MCHPOI,MSOUPO,MPOVAL
  178. ENDIF
  179. CALL ECROBJ('TABLE',MTAB1)
  180. SEGDES MTAB1
  181. RETURN
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  

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