Télécharger recof2.eso

Retour à la liste

Numérotation des lignes :

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

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