Télécharger recof2.eso

Retour à la liste

Numérotation des lignes :

  1. C RECOF2 SOURCE KICH 11/08/11 21:15:46 7079
  2. SUBROUTINE RECOF2(ipmodl,ipcha1,ichp1,ipout)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. CHARACTER*4 mocom1,motddl
  7. -INC CCOPTIO
  8. -INC SMCHPOI
  9. -INC SMELEME
  10. -INC SMMODEL
  11. -INC SMCHAML
  12. -INC SMCOORD
  13. -INC SMLMOTS
  14. segment icta
  15. integer icpt(ima)
  16. character*4 iccomp(ima)
  17. endsegment
  18. segment icpr(nbpts)
  19. segment modsta
  20. integer pimoda(nmoda),pistat(nstat)
  21. integer ivmoda(nmoda),ivstat(nstat)
  22. endsegment
  23. SEGMENT MSWMIL
  24. CHARACTER*(4) MOTDDL(IA)
  25. ENDSEGMENT
  26. *
  27. PARAMETER(NDEPL=10)
  28. CHARACTER*4 CMOT
  29. CHARACTER*8 CMATE
  30. CHARACTER*(NCONCH) CONM
  31. CHARACTER*4 MLDREE(ndepl),MLDIMA(ndepl)
  32. DATA MLDREE/'UX','UY','UZ','UR','UT','RX','RY','RZ','RT','P'/
  33. DATA MLDIMA/'IUX','IUY','IUZ','IUR','IUT','IRX','IRY','IRZ','IRT'
  34. &,'IP'/
  35.  
  36.  
  37. nstat = 100
  38. kstat = 0
  39. nmoda = 100
  40. kmoda = 0
  41. segini modsta
  42.  
  43. nbpts=xcoor(/1)/(idim+1)
  44. segini icpr
  45. ipout = 0
  46. impou = 0
  47. IA = 1
  48. segini mswmil
  49. motddl(1) = 'LX'
  50.  
  51. MMODEL = IPMODL
  52. SEGACT MMODEL
  53. NSOUS = KMODEL(/1)
  54.  
  55. MCHELM = IPCHA1
  56. segact mchelm
  57.  
  58. DO 50 ISOUS=1,NSOUS
  59. IMODEL=KMODEL(ISOUS)
  60. SEGACT IMODEL
  61. CMATE = cmatee
  62.  
  63. if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  64. do im = 1 , imache(/1)
  65. if (imache(im).eq.imamod) then
  66. if (conche(im).eq.conmod) then
  67. mchaml = ichaml(im)
  68. segact mchaml
  69. do iv = 1,ielval(/1)
  70. if (nomche(iv).eq.'DEFO') then
  71.  
  72. if (cmate.eq.'STATIQUE') then
  73. kstat = kstat + 1
  74. ivstat(kstat) = ielval(iv)
  75. pistat(kstat) = imamod
  76. meleme = imamod
  77. segact meleme
  78. if (itypel.ne.1) call erreur(5)
  79. if (num(/1).ne.1) call erreur(5)
  80. do ip =1, num(/2)
  81. icpr(num(1,ip))=kstat
  82. enddo
  83. if (kstat.eq.nstat) then
  84. nstat = nstat + 100
  85. segadj modsta
  86. endif
  87. endif
  88. if (cmate.eq.'MODAL') then
  89. kmoda = kmoda + 1
  90. ivmoda(kmoda) = ielval(iv)
  91. pimoda(kmoda) = imamod
  92. meleme = imamod
  93. segact meleme
  94. if (itypel.ne.1) then
  95. call erreur(26)
  96. goto 99
  97. endif
  98. if (num(/1).ne.1) then
  99. call erreur(26)
  100. goto 99
  101. endif
  102. do ip =1 ,num(/2)
  103. icpr(num(1,ip))=kmoda
  104. enddo
  105. if (kmoda.eq.nmoda) then
  106. nmoda = nmoda + 100
  107. segadj modsta
  108. endif
  109. endif
  110. melval = ielval(iv)
  111. segact melval
  112.  
  113. endif
  114. enddo
  115. segdes mchaml
  116. endif
  117. endif
  118. enddo
  119. endif
  120.  
  121. segdes imodel
  122. 50 CONTINUE
  123. nmoda = kmoda
  124. nstat = kstat
  125. segadj modsta
  126. if (nmoda.eq.0.and.nstat.eq.0) then
  127. call erreur(26)
  128. goto 99
  129. endif
  130.  
  131. mchpoi = ichp1
  132. segact mchpoi
  133. nsoupo = ipchp(/1)
  134. DO is = 1 ,nsoupo
  135. msoupo = ipchp(is)
  136. segact msoupo
  137. NC = NOCOMP(/2)
  138. ipt1 = igeoc
  139. mpoval = ipoval
  140. segact ipt1,mpoval
  141. N = vpocha(/1)
  142. DO ic = 1,NC
  143. mocom1 = nocomp(ic)
  144. DO 90 ipn = 1 , N
  145. ipts = ipt1.num(1,ipn)
  146. sca1 = vpocha(ipn,ic)
  147. if (mocom1.eq.'BETA'.or.mocom1.eq.'IBET') then
  148. kstat = icpr(ipts)
  149. if (kstat.eq.0) goto 90
  150. melval = ivstat(kstat)
  151. meleme = pistat(kstat)
  152. else if (mocom1.eq.'ALFA'.or.mocom1.eq.'IALF') then
  153. kmoda = icpr(ipts)
  154. if (kmoda.eq.0) goto 90
  155. melval = ivmoda(kmoda)
  156. meleme = pimoda(kmoda)
  157. else
  158. goto 90
  159. endif
  160.  
  161. if (mocom1.eq.'BETA'.or.mocom1.eq.'ALFA') then
  162. do ib = 1,num(/2)
  163. if (num(1,ib).eq.ipts) then
  164. ibmn = min(ib,ielche(/2))
  165. ichin = ielche(1,ibmn)
  166. if (ipout.gt.0) then
  167. ich1 = ipout
  168. call adchpo(ich1,ichin,ipout,1.d0,sca1)
  169. else
  170. call muchpo(ichin,sca1,ipout,1)
  171. endif
  172. endif
  173. enddo
  174. endif
  175.  
  176. if (mocom1.eq.'IBET'.or.mocom1.eq.'IALF') then
  177. do ib = 1,num(/2)
  178. if (num(1,ib).eq.ipts) then
  179. ibmn = min(ib,ielche(/2))
  180. ichin = ielche(1,ibmn)
  181. if (impou.gt.0) then
  182. ich1 = impou
  183. call adchpo(ich1,ichin,impou,1.d0,sca1)
  184. else
  185. call muchpo(ichin,sca1,impou,1)
  186. endif
  187. endif
  188. enddo
  189. endif
  190.  
  191. 90 CONTINUE
  192. ENDDO
  193.  
  194. segdes msoupo,ipt1,mpoval
  195. ENDDO
  196.  
  197. segdes mchpoi
  198.  
  199. do ik = 1,nmoda
  200. meleme = pimoda(ik)
  201. segdes meleme
  202. melval = ivmoda(ik)
  203. segdes melval
  204. enddo
  205. do ik = 1,nstat
  206. meleme = pistat(ik)
  207. segdes meleme
  208. melval = ivstat(ik)
  209. segdes melval
  210. enddo
  211.  
  212. if (ipout.eq.0) call erreur(26)
  213. ich1 = ipout
  214. MCHPOI=ich1
  215. SEGACT MCHPOI*MOD
  216. JATTRI(1)=1
  217. SEGDES MCHPOI
  218. CALL ENLEV5(ICH1,MSWMIL,ipout)
  219.  
  220. if (impou.gt.0) then
  221. CALL ENLEV5(impou,MSWMIL,ich2)
  222. JGN = 4
  223. JGM = ndepl
  224. segini mlmot1,mlmot2
  225. iplm1 = mlmot1
  226. iplm2 = mlmot2
  227. do im = 1,JGM
  228. mlmot1.mots(im) = mldree(im)
  229. mlmot2.mots(im) = mldima(im)
  230. enddo
  231. CALL NOMC2(ich2,IPLM1,IPLM2,impou)
  232. MCHPOI=impou
  233. SEGACT MCHPOI*MOD
  234. JATTRI(1)=1
  235. ipout = impou
  236. segdes mchpoi
  237. CALL FUCHPO(ICH1,impou,IPOUT)
  238. endif
  239. 99 segsup modsta,icpr
  240.  
  241.  
  242. RETURN
  243. END
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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