Télécharger proiet.eso

Retour à la liste

Numérotation des lignes :

  1. C PROIET SOURCE GF238795 13/11/05 21:15:02 7824
  2.  
  3. SUBROUTINE PROIET
  4.  
  5. C--------------------------------------------------------------------
  6. C
  7. C OPERATEUR PROIET
  8. C--------------------------------------------------------------------
  9. C
  10. C
  11. C PROJECTION D'UN CHAMELEM AUX NOEUDS DUN MAILLAGE
  12. C PROJECTION ET VALEUR D'UN CHAMELEM AUX NOEUDS OU AUX
  13. C POINTS D INTEGRATION D UN MODELE POUVANT COMPORTER DES COQUES
  14. C INTEGREES (LA COMPOSANTE T SI PRESENTE SERA DECOMPOSEE
  15. C EN T TINF TSUP SI NECESSAIRE SUIVANT LA FORMULATION DE LA COQUE
  16. C PROJECTION D'UN CHAMELEM PAR MINIMISATION DE L INTEGRALE
  17. C
  18. C INT (U1i - U2i)**2 SUR LES ELEMENT RECEPTEURS
  19. C
  20. C
  21. C
  22. C - 'POLY' :
  23. C PROJECTION SUR GEO2 DES COMPOSANTES D'UN CHPOINT CHP1
  24. C DEFINI SUR GEO1 PAR UNE METHODE DE LISSAGE ( adaptee
  25. C pour des champs magnetostatique)
  26. C
  27. C SYNTAXE :
  28. C
  29. C CHPO1 = PROIET MAIL2 CHEL1
  30. C
  31. C MCHEL1 = PROIET MOD1 (CARA ) CHEL1 (MOD2)
  32. C
  33. C MCHEL1 = PROIET MOD1 CHEL1 (MOD2) (MINI (NB ))
  34. C
  35. C OBJ1 = "POLY" GEO1 GEO2 CHP1 ENT1 MOT1 ("POIDS" X1 X2)
  36. C
  37. C
  38. C ENTREE :
  39. C SANS OPTION :
  40. C MAIL2 = OBJET DE TYPE MAILLAGE.
  41. C
  42. C CHEL1 = OBJET DE TYPE MCHAML.
  43. C
  44. C MOD1 = MODELE
  45. C CARA = CARACTERISTIQUE DE LA COQUE (MCHAML) si il y a des
  46. C des sous zones coques dans le modele
  47. C
  48. C POLY :
  49. C GEO1 = OBJET DE TYPE MAILLAGE
  50. C GEO2 = OBJET DE TYPE MAILLAGE
  51. C CHP1 = OBJET DE TYPE MCHAML
  52. C ENT1 = ENTIER (PRECISE LE TYPE DE SYMETRIE)
  53. C MOT1 = MOT 'PLAN' OU 'AXIS'
  54. C POIDS = MOT FACULTATIF
  55. C
  56. C SORTIE :
  57. C
  58. C
  59. C
  60. C NORA DAVIDOVICH- 15/2/89
  61. C NOUVEAUX CHAMELEMS P DOWLATYARI OCT. 91
  62. C MODIFICATION FLEURET 01/96 - OPTION 'ARMA'
  63. C MODIFICATION VIGAN 03/97 - OPTION 'COQU'
  64. C--------------------------------------------------------------------
  65. IMPLICIT INTEGER(I-N)
  66. IMPLICIT REAL*8(A-H,O-Z)
  67. -INC CCOPTIO
  68. -INC SMCHAML
  69. -INC SMMODEL
  70. ** pile modeles elementaires
  71. segment limode(0)
  72.  
  73. PARAMETER (NCLE = 7)
  74. CHARACTER*4 MOTCLE(NCLE)
  75.  
  76. DATA MOTCLE /'POLY','NOEU','GRAV','RIGI','MASS','STRE','MINI'/
  77.  
  78. C-----LECTURE DE L'OPTION
  79. IVAL = 0
  80. CALL LIRMOT(MOTCLE,NCLE,IVAL,0)
  81. C
  82. C-----OPTION POLY
  83. IF (IVAL.EQ.1) THEN
  84. CALL LISSAG
  85. RETURN
  86. ENDIF
  87.  
  88. C- Par defaut, le support est aux noeuds
  89. IF (IVAL.EQ.0) IVAL = 2
  90.  
  91. IPGEA = 0
  92. CALL LIROBJ('MAILLAGE',IPGEA,0,iretou)
  93. IF (IERR.NE.0) RETURN
  94.  
  95. C- Projection d'un champ par element defini aux noeuds sur un maillage
  96. IF (IPGEA.GT.0) THEN
  97.  
  98. CALL LIROBJ('MCHAML',IPCHEL,1,iretou)
  99. IF (IERR.NE.0) RETURN
  100. C Verification du support aux noeuds
  101. CALL QUESUP(0,IPCHEL,0,1,iretou,iret2)
  102. IF (iretou.GT.1) THEN
  103. CALL ERREUR(903)
  104. RETURN
  105. ENDIF
  106.  
  107. CALL PRO2(IPGEA,IPCHEL,1, IPOUT,-1)
  108.  
  109. IF (IERR.EQ.0) CALL ECROBJ('CHPOINT',IPOUT)
  110.  
  111. RETURN
  112.  
  113. C- Projection d'un champ par element aux noeuds sur le support d'un modele
  114. c* ELSE IF (IPGEA.EQ.0) THEN
  115. ELSE
  116. CALL LIROBJ('MMODEL',ipmod1,1,iretou)
  117. IF (IERR.NE.0) RETURN
  118. CALL LIROBJ('MCHAML',IPCHE1,1,iretou)
  119. IF (IERR.NE.0) RETURN
  120. CALL LIROBJ('MCHAML',IPCHE2,0,iretou)
  121. IF (IERR.NE.0) RETURN
  122.  
  123. IF (IPCHE2.NE.0) THEN
  124. IPCHEL = IPCHE2
  125. IPCARA = IPCHE1
  126. ELSE
  127. IPCHEL = IPCHE1
  128. IPCARA = 0
  129. ENDIF
  130. C Cas particulier de la presence d'un champ de CARACTERISTIQUES
  131. C On permute eventuellement l'ordre mais normalement il faut respecter
  132. C l'ordre de la notice "IPCARA IPCHEL"
  133. IF (IPCARA.NE.0) THEN
  134. mchelm = IPCARA
  135. SEGACT,mchelm
  136. IF (titche(1:16).NE.'CARACTERISTIQUES') THEN
  137. c le champ de caracteristiques a peut etre ete donne en deuxieme, on
  138. c teste en inversant les deux champs par elements fournis
  139. SEGDES,mchelm
  140. IPCHEL = IPCHE1
  141. IPCARA = IPCHE2
  142.  
  143. mchelm = IPCARA
  144. SEGACT,mchelm
  145. IF (titche(1:16).NE.'CARACTERISTIQUES') THEN
  146. SEGDES,mchelm
  147. MOTERR(1:16) = 'CARACTERISTIQUES'
  148. CALL ERREUR(565)
  149. ENDIF
  150. ENDIF
  151. SEGDES,mchelm
  152. IF (IERR.NE.0) RETURN
  153. ENDIF
  154. C Verification du support aux noeuds
  155. CALL QUESUP(0,IPCHEL,0,1,iretou,iret2)
  156. IF (iretou.GT.1) THEN
  157. CALL ERREUR(903)
  158. RETURN
  159. ENDIF
  160.  
  161. * kich : pour MELANGE on deroule les modeles
  162. mmodel = ipmod1
  163. SEGACT,mmodel*nomod
  164. NSOUS = kmodel(/1)
  165. IF (NSOUS.LE.0) THEN
  166. SEGDES,mmodel
  167. CALL ERREUR(5)
  168. RETURN
  169. ENDIF
  170. *
  171. limode=0
  172. SEGINI,limode
  173. DO im1 = 1, NSOUS
  174. imodel = kmodel(im1)
  175. SEGACT,imodel
  176. limode(**) = imodel
  177. IF (formod(1).EQ.'MELANGE') THEN
  178. IF (matmod(1).NE.'SERIE') THEN
  179. IF (ivamod(/1).GE.1) then
  180. DO im2 = 1, ivamod(/1)
  181. IF (tymode(im2).eq.'IMODEL') then
  182. limode(**) = ivamod(im2)
  183. imodel = ivamod(im2)
  184. SEGACT,imodel
  185. ENDIF
  186. ENDDO
  187. ENDIF
  188. ENDIF
  189. ENDIF
  190. ENDDO
  191. SEGDES,mmodel
  192. *
  193. NSOUS = limode(/1)
  194. * test non redondance
  195. N1 = 1
  196. DO 10 im1 = NSOUS, 2, -1
  197. imode1 = limode(im1)
  198. DO im2 = (im1 - 1), 1, -1
  199. imode2 = limode(im2)
  200. IF (imode1.EQ.imode2) THEN
  201. limode(im1) = 0
  202. GOTO 10
  203. ELSE IF (imode1.imamod.EQ.imode2.imamod .AND.
  204. & imode1.conmod.EQ.imode2.conmod) THEN
  205. limode(im1) = 0
  206. SEGDES,imode1
  207. GOTO 10
  208. ENDIF
  209. ENDDO
  210. N1 = N1 + 1
  211. 10 CONTINUE
  212. SEGINI,mmodel
  213. im1 = 0
  214. DO im2 = 1, NSOUS
  215. imode2 = limode(im2)
  216. IF (imode2.GT.0) THEN
  217. im1 = im1 + 1
  218. kmodel(im1) = imode2
  219. ENDIF
  220. ENDDO
  221. ipmod1 = mmodel
  222. SEGSUP,limode
  223. C
  224. ISUP = 1
  225. C- Option 'MINI'
  226. IF (IVAL.EQ.7) THEN
  227. CALL PROM(ipmod1,IPCARA,IPCHEL,ISUP, IPOUT)
  228. C- Projection sur support ISUP
  229. ELSE
  230. IF (IVAL.GT.1.AND.IVAL.LT.7) ISUP = IVAL-1
  231. CALL PRON(ipmod1,IPCARA,IPCHEL,ISUP, IPOUT)
  232. ENDIF
  233.  
  234. IF (IERR.EQ.0) CALL ECROBJ('MCHAML',IPOUT)
  235.  
  236. ENDIF
  237.  
  238. RETURN
  239. END
  240.  
  241.  
  242.  
  243.  

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