Télécharger rcodp1.eso

Retour à la liste

Numérotation des lignes :

rcodp1
  1. C RCODP1 SOURCE CB215821 20/11/25 13:38:37 10792
  2. SUBROUTINE RCODP1(ICHP1,KDEPL,KMEL1,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C APPELE PAR L OPERATEUR RECO:
  7. C RECOMBINE LES DEPLACEMENTS RANGES DANS LE MSOLEN KDEPL
  8. C LE RESULTAT EST MIS DANS IRET ------------
  9. C
  10. C PROGRAMME PAR FARVACQUE
  11. C APPELE PAR RECOMB
  12. C APPELLE :ECCHPO ERREUR(169-170)
  13. C=======================================================================
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMSOLUT
  18. -INC SMCHPOI
  19. -INC SMELEME
  20. -INC SMCOORD
  21. SEGMENT ICPR(nbpts)
  22. SEGMENT TRAV(NPOIN)*D
  23. IRET=0
  24. MSOLEN=KDEPL
  25. C
  26. C **** ON MET LES CONTRIBUTIONS MODALES ICHP1 DANS ICPR ET TRAV
  27. C
  28. MCHPOI=ICHP1
  29. IF(MCHPOI.NE.0) GO TO 11
  30. C LE CHPOINT DES CONTRIBUTIONS MODALES EST NUL
  31. MOTERR(1:8)='RCODP1'
  32. CALL ERREUR(170)
  33. GO TO 5000
  34. 11 CONTINUE
  35. SEGINI ICPR
  36. SEGACT MCHPOI
  37. NSOU=IPCHP(/1)
  38. IKI=0
  39. DO 1 ISOU=1,NSOU
  40. MSOUPO=IPCHP(ISOU)
  41. SEGACT MSOUPO
  42. MELEME=IGEOC
  43. SEGACT MELEME
  44. N2=NUM(/2)
  45. DO 2 I=1,N2
  46. IKI=IKI+1
  47. ICPR(NUM(1,I))=IKI
  48. 2 CONTINUE
  49. SEGDES MELEME,MSOUPO
  50. 1 CONTINUE
  51. NPOIN=IKI
  52. SEGINI TRAV
  53. IKI=0
  54. DO 3 ISOU=1,NSOU
  55. MSOUPO=IPCHP(ISOU)
  56. SEGACT MSOUPO
  57. MPOVAL=IPOVAL
  58. SEGACT MPOVAL
  59. N2=VPOCHA(/1)
  60. DO 4 I=1,N2
  61. IKI=IKI+1
  62. TRAV(IKI)=VPOCHA(I,1)
  63. 4 CONTINUE
  64. SEGDES MPOVAL,MSOUPO
  65. 3 CONTINUE
  66. SEGDES MCHPOI
  67. C
  68. C **** INITIALISATION DE MCHPOI: ON PREND LA STRUCTURE DU 1ER CHPOINT
  69. C **** DU MSOLEN KDEPL
  70. C
  71. SEGACT MSOLEN
  72. MCHPO1=ISOLEN(1)
  73. SEGACT MCHPO1
  74. NSOUPO=MCHPO1.IPCHP(/1)
  75. NAT=MCHPO1.JATTRI(/1)
  76. SEGINI MCHPOI
  77. DO 6 ISOU=1,NSOUPO
  78. MSOUP1=MCHPO1.IPCHP(ISOU)
  79. SEGACT MSOUP1
  80. NC=MSOUP1.NOCOMP(/2)
  81. SEGINI MSOUPO
  82. DO 7 IC=1,NC
  83. NOCOMP(IC)=MSOUP1.NOCOMP(IC)
  84. 7 CONTINUE
  85. IGEOC=MSOUP1.IGEOC
  86. MELEME=IGEOC
  87. SEGACT MELEME
  88. N=NUM(/2)
  89. SEGDES MELEME,MSOUP1
  90. SEGINI MPOVAL
  91. SEGDES MPOVAL
  92. IPOVAL=MPOVAL
  93. SEGDES MSOUPO
  94. IPCHP(ISOU)=MSOUPO
  95. 6 CONTINUE
  96. SEGDES MCHPO1
  97. C
  98. C **** BOUCLE SUR LES DEPLACEMENTS DE DEPL
  99. C
  100. MELEME=KMEL1
  101. SEGACT MELEME
  102. LDEPL=ISOLEN(/1)
  103. DO 20 I=1,LDEPL
  104. IJ=NUM(1,I)
  105. J=ICPR(IJ)
  106. IF(J.NE.0) GO TO 21
  107. C ON NE TROUVE PAS LA CONTRIBUTION MODALE CORRESPONDANT A L INDICE
  108. MOTERR(1:8)='RCODP1'
  109. INTERR(1)=IJ
  110. CALL ERREUR(169)
  111. GO TO 5000
  112. 21 CONTINUE
  113. XVAL=TRAV(J)
  114. MCHPO1=ISOLEN(I)
  115. SEGACT MCHPO1
  116. DO 25 ISOU=1,NSOUPO
  117. MSOUP1=MCHPO1.IPCHP(ISOU)
  118. MSOUPO=IPCHP(ISOU)
  119. SEGACT MSOUP1,MSOUPO
  120. MPOVA1=MSOUP1.IPOVAL
  121. MPOVAL=IPOVAL
  122. SEGDES MSOUP1
  123. SEGACT MPOVA1
  124. SEGACT MPOVAL*MOD
  125. N=MPOVA1.VPOCHA(/1)
  126. NC=MPOVA1.VPOCHA(/2)
  127. DO 27 IC=1,NC
  128. DO 27 I2=1,N
  129. VPOCHA(I2,IC)=VPOCHA(I2,IC)+XVAL*MPOVA1.VPOCHA(I2,IC)
  130. 27 CONTINUE
  131. SEGDES MPOVA1,MPOVAL
  132. SEGDES MSOUPO
  133. 25 CONTINUE
  134. SEGDES MCHPO1
  135. 20 CONTINUE
  136. SEGDES MSOLEN,MELEME
  137. SEGSUP TRAV
  138. SEGSUP ICPR
  139. SEGDES MCHPOI
  140. IRET=MCHPOI
  141. IF(IIMPI.EQ.3)CALL ECCHPO(IRET,0)
  142. 5000 CONTINUE
  143. RETURN
  144. END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  

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