Télécharger rcosig.eso

Retour à la liste

Numérotation des lignes :

  1. C RCOSIG SOURCE PV 20/03/30 21:23:36 10567
  2. SUBROUTINE RCOSIG(ICHP1,KCON,KMEL1,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. *_______________________________________________________________________
  6. *
  7. * APPELE PAR L OPERATEUR RECO:
  8. * RECOMBINE LES CONTRAINTES RANGEES DANS LE MSOLEN KCON
  9. * LE RESULTAT EST MIS DANS IRET ------------
  10. *
  11. * PROGRAMME PAR BROCHARD
  12. * APPELE PAR RECOMB
  13. * APPELLE :PRCHEL ERREUR(169-170)
  14. *
  15. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 01/91
  16. *_______________________________________________________________________
  17. *
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMSOLUT
  22. -INC SMCHPOI
  23. -INC SMELEME
  24. -INC SMCOORD
  25. -INC SMCHAML
  26. SEGMENT ICPR(nbpts)
  27. SEGMENT ITRA1(NSOUS,4)
  28. SEGMENT TRAV(NPOIN)*D
  29. IRET=0
  30. MSOLEN=KCON
  31. *
  32. * ON MET LES CONTRIBUTIONS MODALES ICHP1 DANS ICPR ET TRAV
  33. *
  34. MCHPOI=ICHP1
  35. IF(MCHPOI.NE.0) GO TO 11
  36. *
  37. * LE CHPOINT DES CONTRIBUTIONS MODALES EST NUL
  38. *
  39. MOTERR(1:8)='RCODP1'
  40. CALL ERREUR(170)
  41. GO TO 5000
  42. *
  43. 11 CONTINUE
  44. SEGINI ICPR
  45. SEGACT MCHPOI
  46. NSOU=IPCHP(/1)
  47. IKI=0
  48. DO 1 ISOU=1,NSOU
  49. MSOUPO=IPCHP(ISOU)
  50. SEGACT MSOUPO
  51. MELEME=IGEOC
  52. SEGACT MELEME
  53. N2=NUM(/2)
  54. DO 2 I=1,N2
  55. IKI=IKI+1
  56. ICPR(NUM(1,I))=IKI
  57. 2 CONTINUE
  58. SEGDES MELEME,MSOUPO
  59. 1 CONTINUE
  60. *
  61. NPOIN=IKI
  62. SEGINI TRAV
  63. IKI=0
  64. DO 3 ISOU=1,NSOU
  65. MSOUPO=IPCHP(ISOU)
  66. SEGACT MSOUPO
  67. MPOVAL=IPOVAL
  68. SEGACT MPOVAL
  69. N2=VPOCHA(/1)
  70. DO 4 I=1,N2
  71. IKI=IKI+1
  72. TRAV(IKI)=VPOCHA(I,1)
  73. 4 CONTINUE
  74. SEGDES MPOVAL,MSOUPO
  75. 3 CONTINUE
  76. SEGDES MCHPOI
  77. *
  78. * INITIALISATION DU CHAMELEM
  79. *
  80. SEGACT MSOLEN
  81. NBCHAM=ISOLEN(/1)
  82. IPCHE1=ISOLEN(1)
  83. *
  84. MCHEL1=IPCHE1
  85. SEGINI,MCHELM=MCHEL1
  86. NSOUS=ICHAML(/1)
  87. SEGINI ITRA1
  88. DO 120 ISOUS=1,NSOUS
  89. ITRA1(ISOUS,1)=IMACHE(ISOUS)
  90. MCHAM1=ICHAML(ISOUS)
  91. SEGINI,MCHAML=MCHAM1
  92. ICHAML(ISOUS)=MCHAML
  93. ITRA1(ISOUS,2)=MCHAML
  94. 120 CONTINUE
  95. *
  96. DO 200 ICHAM=1,NBCHAM
  97. IPCHE1=ISOLEN(ICHAM)
  98. *
  99. MCHEL1=IPCHE1
  100. SEGACT MCHEL1
  101. DO 210 ISOUS=1,NSOUS
  102. IPMAIL=ITRA1(ISOUS,1)
  103. IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN
  104. SEGDES MCHEL1
  105. CALL ERREUR(21)
  106. GOTO 9990
  107. ENDIF
  108. MCHAM1=MCHEL1.ICHAML(ISOUS)
  109. SEGACT MCHAM1
  110. MCHAML=ITRA1(ISOUS,2)
  111. NCOMP=IELVAL(/1)
  112. DO 199 ICOMP=1,NCOMP
  113. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  114. & NOMCHE(ICOMP))
  115. IF (IPLAC.EQ.0) THEN
  116. SEGDES MCHAM1
  117. SEGDES MCHEL1
  118. CALL ERREUR(21)
  119. GOTO 9990
  120. ENDIF
  121. MELVA1=MCHAM1.IELVAL(IPLAC)
  122. SEGACT MELVA1
  123. N1PTEL=MELVA1.VELCHE(/1)
  124. N1EL =MELVA1.VELCHE(/2)
  125. ITRA1(ISOUS,3)=MAX(ITRA1(ISOUS,3),N1PTEL)
  126. ITRA1(ISOUS,4)=MAX(ITRA1(ISOUS,4),N1EL )
  127. SEGDES MELVA1
  128. 199 CONTINUE
  129. SEGDES MCHAM1
  130. 210 CONTINUE
  131. SEGDES MCHEL1
  132. 200 CONTINUE
  133. C
  134. DO 220 ISOUS=1,NSOUS
  135. MCHAML=ITRA1(ISOUS,2)
  136. NCOMP=IELVAL(/1)
  137. N1PTEL=ITRA1(ISOUS,3)
  138. N1EL =ITRA1(ISOUS,4)
  139. N2PTEL=0
  140. N2EL=0
  141. DO 221 ICOMP=1,NCOMP
  142. SEGINI MELVAL
  143. IELVAL(ICOMP)=MELVAL
  144. 221 CONTINUE
  145. 220 CONTINUE
  146. *
  147. IRET=MCHELM
  148. *
  149. * BOUCLES SUR LES CONTRAINTES MODALES
  150. *
  151. MELEME=KMEL1
  152. SEGACT MELEME
  153. LCON=ISOLEN(/1)
  154. DO 300 I=1,LCON
  155. IJ=NUM(1,I)
  156. J=ICPR(IJ)
  157. IF(J.NE.0) GOTO 310
  158. *
  159. * ON NE TROUVE PAS LA CONTRIBUTION MODALE
  160. *
  161. MOTERR(1:8)='RCODP1'
  162. INTERR(1)=IJ
  163. CALL ERREUR(169)
  164. CALL DTCHAM(IRET)
  165. GOTO 5000
  166. *
  167. 310 CONTINUE
  168. XVAL=TRAV(J)
  169. IPCHE1=ISOLEN(I)
  170. *
  171. MCHEL1=IPCHE1
  172. SEGACT MCHEL1
  173. DO 320 ISOUS=1,NSOUS
  174. MCHAML=ITRA1(ISOUS,2)
  175. MCHAM1=MCHEL1.ICHAML(ISOUS)
  176. SEGACT MCHAM1
  177. NCOMP=IELVAL(/1)
  178. DO 301 ICOMP=1,NCOMP
  179. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  180. & NOMCHE(ICOMP))
  181. MELVAL=IELVAL(ICOMP)
  182. MELVA1=MCHAM1.IELVAL(IPLAC)
  183. SEGACT MELVA1
  184. DO 400 IGAU=1,VELCHE(/1)
  185. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  186. DO 400 IB=1,VELCHE(/2)
  187. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  188. VELCHE(IGAU,IB)=VELCHE(IGAU,IB)+
  189. & XVAL*MELVA1.VELCHE(IGMN,IBMN)
  190. 400 CONTINUE
  191. SEGDES MELVA1
  192. 301 CONTINUE
  193. SEGDES MCHAM1
  194. 320 CONTINUE
  195. SEGDES MCHEL1
  196. 300 CONTINUE
  197. SEGDES MELEME,MSOLEN
  198. SEGSUP TRAV,ICPR
  199. DO 500 ISOUS=1,NSOUS
  200. MCHAML=ITRA1(ISOUS,2)
  201. NCOMP=IELVAL(/1)
  202. DO 501 ICOMP=1,NCOMP
  203. MELVAL=IELVAL(ICOMP)
  204. SEGDES MELVAL
  205. 501 CONTINUE
  206. SEGDES MCHAML
  207. 500 CONTINUE
  208. SEGSUP ITRA1
  209. SEGDES MCHELM
  210. IRET=MCHELM
  211. *
  212. IF(IIMPI.EQ.3) CALL ZPCHEL(IRET,0)
  213. *
  214. 5000 CONTINUE
  215. RETURN
  216. *
  217. 9990 CONTINUE
  218. DO 600 ISOUS=1,NSOUS
  219. MCHAML=ITRA1(ISOUS,2)
  220. SEGSUP MCHAML
  221. 600 CONTINUE
  222. SEGSUP MCHELM
  223. SEGSUP ITRA1
  224. RETURN
  225.  
  226. END
  227.  
  228.  
  229.  
  230.  

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