Télécharger recof1.eso

Retour à la liste

Numérotation des lignes :

  1. C RECOF1 SOURCE BP208322 17/12/18 21:15:07 9667
  2. SUBROUTINE RECOF1(itbst,itbm,ichp1,ipout)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *
  6. ************************************************************************
  7. *
  8. * CREATION : Joel KICHENIN
  9. * MODIFS :
  10. * Benoit PRABEL, 1/08/2014 : ajout possibilite de n'avoir que itbm
  11. * BP, 11/12/2017 : corrections pour parallelisme
  12. *
  13. ************************************************************************
  14.  
  15. -INC CCOPTIO
  16. -INC SMCHPOI
  17. -INC SMELEME
  18. -INC SMTABLE
  19. -INC SMCOORD
  20. ************************************************************************
  21. * -INC TMYTAB
  22. *
  23. * SEGMENT POUR "DEBOBINER" UN OBJET DE TYPE 'TABLE'
  24. * D'UN SOUSTYPE PARTICULIER PRECISE PAR ITYTAB
  25. * Le but est de faciliter la programmation esope notamment en //
  26. *
  27. * ITYTAB = | BASE_MODALE
  28. * | LIAISONS_STATIQUES
  29. * | ... a completer
  30. *
  31. * KPTREP(i) = POINT_REPERE du ieme mode/solution statique
  32. * KDEFO(i) = DEFORMEE_MODALE / DEFORMEE
  33. * KICPR(#noeud POINT_REPERE) = i^eme mode
  34. * DDLLIA(i) = composante de la liaison statique
  35. * KPTLIA(i) = point en jeu dans la liaison statique
  36. *
  37.  
  38. SEGMENT MYTAB
  39. CHARACTER*24 ITYTAB
  40. INTEGER KPTREP(NMY),KDEFO(NMY)
  41. INTEGER KICPR(NMY2)
  42. CHARACTER*4 DDLLIA(NMY3)
  43. INTEGER KPTLIA(NMY3)
  44. ENDSEGMENT
  45. POINTEUR MYTAB1.MYTAB,MYTAB2.MYTAB,MYTAB3.MYTAB
  46.  
  47. ************************************************************************
  48.  
  49. c icpr(ip)=nombre de fois ou l'on a vu le noeud POINT_LIAISON ip
  50. segment icpr(nbpts)
  51. c ITACH=liste des chpoints, ITAFL.TAFL=liste des coefficients
  52. SEGMENT ITACH(0)
  53. SEGMENT/ITAFL/(TAFL(0)*D)
  54.  
  55. CHARACTER*4 mocom1
  56.  
  57.  
  58. ipout =0
  59. it1=0
  60. it2=0
  61. MYTAB1=0
  62. MYTAB2=0
  63.  
  64.  
  65. ************************************************************************
  66. * ACTIVATION DES TABLES si elles existent
  67. ************************************************************************
  68.  
  69. c segact,ipiloc
  70.  
  71. c recup des solutions statiques si la table existe
  72. if (itbst.gt.0) then
  73. mtable = itbst
  74. segact mtable
  75. nbpts=xcoor(/1)/(idim+1)
  76. segini icpr
  77. iicpr=icpr
  78. c DEBOBINAGE DE LA TABLE itbst VERS MYTAB1
  79. CALL TAB2MY(itbst,2,iicpr,it1)
  80. MYTAB1=it1
  81. endif
  82.  
  83. c recup des modes si la table existe
  84. itbm2=0
  85. if (itbm.gt.0) then
  86. CALL ACCTAB(itbm,'MOT',0,0.0D0,'MODES',.TRUE.,0,
  87. & 'TABLE',0,0.0D0,' ',.TRUE.,itbm2)
  88. if (ierr.ne.0) return
  89. mtable = itbm2
  90. segact mtable
  91. c DEBOBINAGE DE LA TABLE itbm2 VERS MYTAB2
  92. CALL TAB2MY(itbm2,1,0,it2)
  93. MYTAB2=it2
  94. endif
  95.  
  96. c segdes,ipiloc
  97. c if (nbesc.ne.0) segdes,ipiloc
  98.  
  99.  
  100. ************************************************************************
  101. * RECOMBINAISON
  102. ************************************************************************
  103.  
  104. c creation des segments pour la combinaison lineaire
  105. segini,ITACH,ITAFL
  106. NA=0
  107.  
  108. c recup du chpoint d'entree (de composante ALFA BETA)
  109. mchpoi = ichp1
  110. segact mchpoi
  111. nsoupo = ipchp(/1)
  112.  
  113. c - boucle sur les zones du chpoint d'entree
  114. DO 10 is = 1 ,nsoupo
  115.  
  116. msoupo = ipchp(is)
  117. segact msoupo
  118. NC = NOCOMP(/2)
  119. meleme = igeoc
  120. mpoval = ipoval
  121. segact meleme,mpoval
  122. N = vpocha(/1)
  123.  
  124. c - boucle sur les composantes
  125. DO 20 ic = 1,NC
  126.  
  127. mocom1 = nocomp(ic)
  128. if (mocom1.eq.'BETA') then
  129. if(itbst.le.0) goto 20
  130. MYTAB=MYTAB1
  131. elseif (mocom1.eq.'ALFA') then
  132. if(itbm2.le.0) goto 20
  133. MYTAB=MYTAB2
  134. elseif (mocom1.eq.'LX') then
  135. write(ioimp,*) 'LX a recopier tel quel... ',
  136. & 'mais pas encore fait !'
  137. goto 20
  138. else
  139. write(ioimp,*) 'RECO : le chpoint doit avoir les composantes',
  140. & ' ALFA ou BETA !'
  141. MOTERR(1:4)=mocom1
  142. call erreur(197)
  143. return
  144. endif
  145.  
  146. c - boucle sur les noeuds du chpoint d'entree
  147. DO 90 ipn = 1,N
  148. ipts = num(1,ipn)
  149. sca1 = vpocha(ipn,ic)
  150.  
  151. c on a deja enregistré tous les modes
  152. im=KICPR(ipts)
  153. if (im.le.0) then
  154. INTERR(1)=ipts
  155. CALL ERREUR(1072)
  156. endif
  157. ichin=KDEFO(im)
  158.  
  159. c combinaison lineaire
  160. c if (ipout.gt.0) then
  161. c ich1 = ipout
  162. c call adchpo(ich1,ichin,ipout,1.d0,sca1)
  163. c else
  164. c call muchpo(ichin,sca1,ipout,1)
  165. c endif
  166. c mutualisation des sources : appel a COMBIL
  167. ITACH(**)=ichin
  168. TAFL(**)=sca1
  169. NA=NA+1
  170.  
  171. 90 CONTINUE
  172.  
  173. 20 CONTINUE
  174.  
  175. segdes msoupo,meleme,mpoval
  176. 10 CONTINUE
  177. segdes mchpoi
  178.  
  179. c combinaison lineaire effective optimisee
  180. CALL COMBIL(ITACH,ITAFL,NA,ipout)
  181.  
  182. if (itbst.le.0) goto 999
  183.  
  184.  
  185. ************************************************************************
  186. * CORRECTION DU CHPOINT AUX POINTS DE LIAISON
  187. ************************************************************************
  188. c
  189. c de maniere a ne pas compter plusieurs fois un noeud en commun
  190. c a plusieurs deformees statiques (ex. du noeud x ci dessous).
  191. c |---------------x x-----------------|
  192. c \psi_1 \psi2
  193. c
  194.  
  195. MYTAB=MYTAB1
  196. c ima = icpt(/1)
  197. ima = KPTLIA(/1)
  198. mchpoi = ipout
  199. segact mchpoi
  200. nsoupo = ipchp(/1)
  201.  
  202. DO is = 1 ,nsoupo
  203. msoupo = ipchp(is)
  204. segact msoupo
  205. NC = NOCOMP(/2)
  206. meleme = igeoc
  207. mpoval = ipoval
  208.  
  209. segact meleme,mpoval*mod
  210. N = vpocha(/1)
  211.  
  212. DO ic = 1,NC
  213. mocom1 = nocomp(ic)
  214.  
  215. DO 180 ipn = 1 , N
  216. ipts = num(1,ipn)
  217. kpt = 0
  218. if (icpr(ipts).eq.0) goto 180
  219. c on a repere un point de liaison
  220. do 170 im = 1,ima
  221. if (KPTLIA(im).ne.ipts) goto 170
  222. if (DDLLIA(im).ne.mocom1) goto 170
  223. kpt = kpt + 1
  224. 170 continue
  225. c kpt=nombre de fois ou apparait point_liaison + ddl_liaison
  226. if (kpt.gt.1) vpocha(ipn,ic) = vpocha(ipn,ic)/kpt
  227.  
  228. 180 CONTINUE
  229.  
  230. ENDDO
  231. segdes meleme,mpoval,msoupo
  232.  
  233. ENDDO
  234. segdes mchpoi
  235. segsup icpr
  236.  
  237.  
  238. ************************************************************************
  239. * FIN DU PROGRAMME
  240. ************************************************************************
  241. 999 CONTINUE
  242.  
  243. SEGSUP,ITACH,ITAFL
  244. IF(MYTAB1.ne.0) SEGSUP MYTAB1
  245. IF(MYTAB2.ne.0) SEGSUP MYTAB2
  246. c on ne desactive pas les 2 tables d'entrees (//isation)
  247.  
  248. RETURN
  249. END
  250.  
  251.  
  252.  
  253.  
  254.  

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