Télécharger rcodp1.eso

Retour à la liste

Numérotation des lignes :

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

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