Télécharger rcosig.eso

Retour à la liste

Numérotation des lignes :

  1. C RCOSIG SOURCE CB215821 20/11/25 13:38:38 10792
  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. NCCHE=MCHAM1.NOMCHE(/2)
  113. DO 199 ICOMP=1,NCOMP
  114. CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  115. & NOMCHE(ICOMP))
  116. IF (IPLAC.EQ.0) THEN
  117. SEGDES MCHAM1
  118. SEGDES MCHEL1
  119. CALL ERREUR(21)
  120. GOTO 9990
  121. ENDIF
  122. MELVA1=MCHAM1.IELVAL(IPLAC)
  123. SEGACT MELVA1
  124. N1PTEL=MELVA1.VELCHE(/1)
  125. N1EL =MELVA1.VELCHE(/2)
  126. ITRA1(ISOUS,3)=MAX(ITRA1(ISOUS,3),N1PTEL)
  127. ITRA1(ISOUS,4)=MAX(ITRA1(ISOUS,4),N1EL )
  128. SEGDES MELVA1
  129. 199 CONTINUE
  130. SEGDES MCHAM1
  131. 210 CONTINUE
  132. SEGDES MCHEL1
  133. 200 CONTINUE
  134. C
  135. DO 220 ISOUS=1,NSOUS
  136. MCHAML=ITRA1(ISOUS,2)
  137. NCOMP=IELVAL(/1)
  138. N1PTEL=ITRA1(ISOUS,3)
  139. N1EL =ITRA1(ISOUS,4)
  140. N2PTEL=0
  141. N2EL=0
  142. DO 221 ICOMP=1,NCOMP
  143. SEGINI MELVAL
  144. IELVAL(ICOMP)=MELVAL
  145. 221 CONTINUE
  146. 220 CONTINUE
  147. *
  148. IRET=MCHELM
  149. *
  150. * BOUCLES SUR LES CONTRAINTES MODALES
  151. *
  152. MELEME=KMEL1
  153. SEGACT MELEME
  154. LCON=ISOLEN(/1)
  155. DO 300 I=1,LCON
  156. IJ=NUM(1,I)
  157. J=ICPR(IJ)
  158. IF(J.NE.0) GOTO 310
  159. *
  160. * ON NE TROUVE PAS LA CONTRIBUTION MODALE
  161. *
  162. MOTERR(1:8)='RCODP1'
  163. INTERR(1)=IJ
  164. CALL ERREUR(169)
  165. CALL DTCHAM(IRET)
  166. GOTO 5000
  167. *
  168. 310 CONTINUE
  169. XVAL=TRAV(J)
  170. IPCHE1=ISOLEN(I)
  171. *
  172. MCHEL1=IPCHE1
  173. SEGACT MCHEL1
  174. DO 320 ISOUS=1,NSOUS
  175. MCHAML=ITRA1(ISOUS,2)
  176. MCHAM1=MCHEL1.ICHAML(ISOUS)
  177. SEGACT MCHAM1
  178. NCOMP=IELVAL(/1)
  179. NCCHE=MCHAM1.NOMCHE(/2)
  180. DO 301 ICOMP=1,NCOMP
  181. CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  182. & NOMCHE(ICOMP))
  183. MELVAL=IELVAL(ICOMP)
  184. MELVA1=MCHAM1.IELVAL(IPLAC)
  185. SEGACT MELVA1
  186. DO 400 IGAU=1,VELCHE(/1)
  187. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  188. DO 400 IB=1,VELCHE(/2)
  189. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  190. VELCHE(IGAU,IB)=VELCHE(IGAU,IB)+
  191. & XVAL*MELVA1.VELCHE(IGMN,IBMN)
  192. 400 CONTINUE
  193. SEGDES MELVA1
  194. 301 CONTINUE
  195. SEGDES MCHAM1
  196. 320 CONTINUE
  197. SEGDES MCHEL1
  198. 300 CONTINUE
  199. SEGDES MELEME,MSOLEN
  200. SEGSUP TRAV,ICPR
  201. DO 500 ISOUS=1,NSOUS
  202. MCHAML=ITRA1(ISOUS,2)
  203. NCOMP=IELVAL(/1)
  204. DO 501 ICOMP=1,NCOMP
  205. MELVAL=IELVAL(ICOMP)
  206. SEGDES MELVAL
  207. 501 CONTINUE
  208. SEGDES MCHAML
  209. 500 CONTINUE
  210. SEGSUP ITRA1
  211. SEGDES MCHELM
  212. IRET=MCHELM
  213. *
  214. IF(IIMPI.EQ.3) CALL ZPCHEL(IRET,0)
  215. *
  216. 5000 CONTINUE
  217. RETURN
  218. *
  219. 9990 CONTINUE
  220. DO 600 ISOUS=1,NSOUS
  221. MCHAML=ITRA1(ISOUS,2)
  222. SEGSUP MCHAML
  223. 600 CONTINUE
  224. SEGSUP MCHELM
  225. SEGSUP ITRA1
  226. RETURN
  227.  
  228. END
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  

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