Télécharger rcosig.eso

Retour à la liste

Numérotation des lignes :

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

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