Télécharger xtx3.eso

Retour à la liste

Numérotation des lignes :

  1. C XTX3 SOURCE CHAT 05/01/13 04:15:34 5004
  2. SUBROUTINE XTX3(ICH1,ICH2,FLO1,FLO2,XDRET,IRET)
  3. C=======================================================================
  4. C ENTREES
  5. C ICH1 POINTEUR SUR UN CHPOINT
  6. C ICH2 POINTEUR SUR UN CHPOINT
  7. C FLO1 FLOTTANT
  8. C FLO2 FLOTTANT
  9. C SORTIES
  10. C XDRET = XTX FLO1 * ICH1 + FLO2 * FLO2
  11. C IRET = 1 SI SUCCES 0 SINON
  12. C=======================================================================
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15. PARAMETER(XZER=0.D0)
  16. -INC CCOPTIO
  17. -INC SMCHPOI
  18. DIMENSION ITR(40)
  19. C
  20. XDRET=XZER
  21. IRET=1
  22. C
  23. MCHPO1=ICH1
  24. MCHPO2=ICH2
  25. C
  26. SEGACT MCHPO1,MCHPO2
  27. NS1=MCHPO1.IPCHP(/1)
  28. NS2=MCHPO2.IPCHP(/1)
  29. MOTERR(1:8)=MCHPO1.MTYPOI
  30. MOTERR(9:16)=MCHPO2.MTYPOI
  31. C
  32. C LES CHPOINTS SONT ILS COMPATIBLES ??
  33. C
  34. IF(MCHPO1.IFOPOI.NE.MCHPO2.IFOPOI) GOTO 166
  35. IF(NS1.NE.NS2) GOTO 166
  36. C
  37. GOTO 20
  38. C
  39. C GESTION DE L ERREUR
  40. C
  41. 166 CONTINUE
  42. IRET=0
  43. CALL ERREUR(347)
  44. GOTO 666
  45. 20 CONTINUE
  46. C
  47. C QUELLES CORESPONDANCE ENTRE LES SOUS PAQUETS DES CHPOINTS
  48. C
  49. DO 100 IA=1,NS1
  50. MSOUP1=MCHPO1.IPCHP(IA)
  51. SEGACT MSOUP1
  52. IGEO1=MSOUP1.IGEOC
  53. SEGDES MSOUP1
  54. DO 110 IB=1,NS2
  55. MSOUP2=MCHPO2.IPCHP(IB)
  56. SEGACT MSOUP2
  57. IGEO2=MSOUP2.IGEOC
  58. IBB =MSOUP2.IPOVAL
  59. SEGDES MSOUP2
  60. IF(IGEO1.EQ.IGEO2) GOTO 120
  61. 110 CONTINUE
  62. C
  63. C MESSAGE D ERREUR
  64. C
  65. IRET=0
  66. CALL ERREUR(348)
  67. GOTO 666
  68. 120 CONTINUE
  69. ITR(IA)=IBB
  70. 100 CONTINUE
  71. C
  72. C BOUCLE SUR LES SOUS PAQUETS EN COMMUN
  73. C
  74. DO 200 IA=1,NS1
  75. MSOUP1=MCHPO1.IPCHP(IA)
  76. SEGACT MSOUP1
  77. MPOVA1=MSOUP1.IPOVAL
  78. SEGDES MSOUP1
  79. IBB=ITR(IA)
  80. MPOVA2= IBB
  81. C
  82. SEGACT MPOVA1,MPOVA2
  83. N1 =MPOVA1.VPOCHA(/1)
  84. NC1 =MPOVA1.VPOCHA(/2)
  85. N2 =MPOVA2.VPOCHA(/1)
  86. NC2 =MPOVA2.VPOCHA(/2)
  87. C
  88. C VERIFICATION TAILLE DES CHPOINTS
  89. C
  90. IF(N1.NE.N2) GOTO 444
  91. IF(NC1.NE.NC2) GOTO 444
  92. GOTO 330
  93. C
  94. C ERREUR TAILLE CHPOINTS
  95. C
  96. 444 CONTINUE
  97. MOTERR(1:8)='XTX3'
  98. IRET=0
  99. CALL ERREUR(178)
  100. SEGDES MPOVA1,MPOVA2
  101. GOTO 666
  102. C
  103. 330 CONTINUE
  104. DO 300 IB=1,N1
  105. DO 400 IC=1,NC1
  106. XXT1=MPOVA1.VPOCHA(IB,IC)
  107. XXT2=MPOVA2.VPOCHA(IB,IC)
  108. XX = FLO1*XXT1+FLO2*FLO2
  109. XDRET = XDRET + XX*XX
  110. 400 CONTINUE
  111. 300 CONTINUE
  112. SEGDES MPOVA1,MPOVA2
  113. 200 CONTINUE
  114. C
  115. 666 CONTINUE
  116. SEGDES MCHPO1,MCHPO2
  117. RETURN
  118. END
  119.  
  120.  

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