Télécharger force.eso

Retour à la liste

Numérotation des lignes :

  1. C FORCE SOURCE KICH 08/07/30 21:15:11 6140
  2.  
  3. C=======================================================================
  4. C= OPERATEUR FORCE OU MOMENT
  5. C
  6. C= SYNTAXE CHP1=FORCE I VECTEUR I OBJET ;
  7. C= I NOMFORC VAL ... I
  8. C
  9. C= CHP2=MOMEN I VECTEUR I OBJET ;
  10. C= I NOMMOME VAL ... I
  11. C
  12. C= VECTEUR EST LE VECTEUR FORCE TOTAL APPLIQUE
  13. C= A L OBJET QUI PEUT ETRE UNE LISTE
  14. C= DE POINTS OU D ELEMENTS
  15. C=======================================================================
  16.  
  17. SUBROUTINE FORCE(LTYP)
  18.  
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22. -INC CCOPTIO
  23. -INC SMELEME
  24. -INC SMCHPOI
  25. -INC SMCOORD
  26.  
  27. SEGMENT MSWMOT
  28. CHARACTER*4 MOTFOR(0)
  29. ENDSEGMENT
  30. SEGMENT MSWVAL
  31. REAL*8 VALFOR(0)
  32. ENDSEGMENT
  33.  
  34. DIMENSION VEC(3)
  35. CHARACTER*4 MOTYPO(10),charm,charre,typret
  36. CHARACTER*4 MOFOR1(2),MOFOR2(2),MOFOR3(3),MOFOR4(3),MOFOR5(2)
  37. CHARACTER*4 MOMOM1(1),MOMOM2(1),MOMOM3(2),MOMOM4(3)
  38. REAL*8 XXA,vval,X0,X1
  39.  
  40.  
  41. DATA MOTYPO / 'FX ','FY ','FZ ','FR ','FZ ','FT ',
  42. . 'MX ','MY ','MZ ','MT ' /
  43. DATA MOFOR1 / 'FX ','FY ' /
  44. DATA MOFOR2 / 'FR ','FZ ' /
  45. DATA MOFOR3 / 'FR ','FZ ','FT ' /
  46. DATA MOFOR4 / 'FX ','FY ','FZ ' /
  47. DATA MOFOR5 / 'FX ','FZ ' /
  48. DATA MOMOM1 / 'MZ ' /
  49. DATA MOMOM2 / 'MT ' /
  50. DATA MOMOM3 / 'MT ','MZ ' /
  51. DATA MOMOM4 / 'MX ','MY ','MZ ' /
  52.  
  53.  
  54. call lirtab('LIAISONS_STATIQUES',ipt,0,iret1)
  55. if (iret1.ne.0) goto 200
  56.  
  57. CCCCCCCCCC ON LIT SOIT UN VECTEUR , SOIT UN OU PLUSIEURS NOMS DE
  58. C COMPOSANTES ACCOMPAGNES D'UN FLOTTANT
  59.  
  60. CALL LIROBJ('POINT ',NOEUD,0,IRET1)
  61. IF (IRET1.EQ.0) THEN
  62. SEGINI,MSWMOT,MSWVAL
  63. IF (LTYP.EQ.1) THEN
  64. IF (IFOMOD.EQ.-1) THEN
  65. C ON INTRODUIT LES FORCES EN DEFO PLANE GENE (FX,FY,FZ)
  66. 11 IF (IFOUR.EQ.-3) THEN
  67. CALL LIRMOT(MOFOR4,3,IMLU,0)
  68. IF (IMLU.EQ.0) GOTO 999
  69. CALL LIRREE(VAL,1,IRETOU)
  70. IF (IERR.NE.0) RETURN
  71. MOTFOR(**)=MOFOR4(IMLU)
  72. VALFOR(**)=VAL
  73. ELSE
  74. CALL LIRMOT(MOFOR1,2,IMLU,0)
  75. IF (IMLU.EQ.0) GOTO 999
  76. CALL LIRREE(VAL,1,IRETOU)
  77. IF (IERR.NE.0) RETURN
  78. MOTFOR(**)=MOFOR1(IMLU)
  79. VALFOR(**)=VAL
  80. ENDIF
  81. GOTO 11
  82. ELSE IF(IFOMOD.EQ.0) THEN
  83. 12 CALL LIRMOT(MOFOR2,2,IMLU,0)
  84. IF (IMLU.EQ.0) GOTO 999
  85. CALL LIRREE(VAL,1,IRETOU)
  86. IF (IERR.NE.0) RETURN
  87. MOTFOR(**)=MOFOR2(IMLU)
  88. VALFOR(**)=VAL
  89. GOTO 12
  90. ELSE IF (IFOMOD.EQ.1) THEN
  91. 13 CALL LIRMOT(MOFOR3,3,IMLU,0)
  92. IF (IMLU.EQ.0) GOTO 999
  93. CALL LIRREE(VAL,1,IRETOU)
  94. IF (IERR.NE.0) RETURN
  95. MOTFOR(**)=MOFOR3(IMLU)
  96. VALFOR(**)=VAL
  97. GOTO 13
  98. ELSE IF (IFOMOD.EQ.2) THEN
  99. 14 CALL LIRMOT(MOFOR4,3,IMLU,0)
  100. IF (IMLU.EQ.0) GOTO 999
  101. CALL LIRREE(VAL,1,IRETOU)
  102. IF (IERR.NE.0) RETURN
  103. MOTFOR(**)=MOFOR4(IMLU)
  104. VALFOR(**)=VAL
  105. GOTO 14
  106. ELSE IF (IFOMOD.EQ.3) THEN
  107. IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) THEN
  108. 151 CALL LIRMOT(MOFOR5,2,IMLU,0)
  109. IF (IMLU.EQ.0) GOTO 999
  110. CALL LIRREE(VAL,1,IRETOU)
  111. IF (IERR.NE.0) RETURN
  112. MOTFOR(**)=MOFOR5(IMLU)
  113. VALFOR(**)=VAL
  114. GOTO 151
  115. ELSE
  116. NC=1
  117. IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) NC=2
  118. IF (IFOUR.EQ.11) NC=3
  119. 152 CALL LIRMOT(MOFOR4,3,IMLU,0)
  120. IF (IMLU.EQ.0) GOTO 999
  121. CALL LIRREE(VAL,1,IRETOU)
  122. IF (IERR.NE.0) RETURN
  123. MOTFOR(**)=MOFOR4(IMLU)
  124. VALFOR(**)=VAL
  125. GOTO 152
  126. ENDIF
  127. ELSE IF (IFOMOD.EQ.4) THEN
  128. NC=1
  129. IF (IFOUR.EQ.14) NC=2
  130. 16 CALL LIRMOT(MOFOR2,2,IMLU,0)
  131. IF (IMLU.EQ.0) GOTO 999
  132. CALL LIRREE(VAL,1,IRETOU)
  133. IF (IERR.NE.0) RETURN
  134. MOTFOR(**)=MOFOR2(IMLU)
  135. VALFOR(**)=VAL
  136. GOTO 16
  137. ELSE IF (IFOMOD.EQ.5) THEN
  138. 17 CALL LIRMOT(MOFOR2,1,IMLU,0)
  139. IF (IMLU.EQ.0) GOTO 999
  140. CALL LIRREE(VAL,1,IRETOU)
  141. IF (IERR.NE.0) RETURN
  142. MOTFOR(**)=MOFOR2(IMLU)
  143. VALFOR(**)=VAL
  144. GOTO 17
  145. ENDIF
  146. ELSE IF (LTYP.EQ.2) THEN
  147. IF (IFOMOD.EQ.-1) THEN
  148. C ON INTRODUIT LES MOMENTS EN DEFO PLANE GENE (MX,MY,MZ)
  149. 21 IF (IFOUR.EQ.-3) THEN
  150. CALL LIRMOT(MOMOM4,3,IMLU,0)
  151. IF (IMLU.EQ.0) GOTO 999
  152. CALL LIRREE(VAL,1,IRETOU)
  153. IF (IERR.NE.0) RETURN
  154. MOTFOR(**)=MOMOM4(IMLU)
  155. VALFOR(**)=VAL
  156. ELSE
  157. CALL LIRMOT(MOMOM1,1,IMLU,0)
  158. IF (IMLU.EQ.0) GOTO 999
  159. CALL LIRREE(VAL,1,IRETOU)
  160. IF (IERR.NE.0) RETURN
  161. MOTFOR(**)=MOMOM1(IMLU)
  162. VALFOR(**)=VAL
  163. ENDIF
  164. GOTO 21
  165. ELSE IF (IFOMOD.EQ.0) THEN
  166. 22 CALL LIRMOT(MOMOM2,1,IMLU,0)
  167. IF (IMLU.EQ.0) GOTO 999
  168. CALL LIRREE(VAL,1,IRETOU)
  169. IF (IERR.NE.0) RETURN
  170. MOTFOR(**)=MOMOM2(IMLU)
  171. VALFOR(**)=VAL
  172. GOTO 22
  173. ELSE IF (IFOMOD.EQ.1) THEN
  174. 23 CALL LIRMOT(MOMOM3,2,IMLU,0)
  175. IF (IMLU.EQ.0) GOTO 999
  176. CALL LIRREE(VAL,1,IRETOU)
  177. IF (IERR.NE.0) RETURN
  178. MOTFOR(**)=MOMOM3(IMLU)
  179. VALFOR(**)=VAL
  180. GOTO 23
  181. ELSE IF (IFOMOD.EQ.2) THEN
  182. 24 CALL LIRMOT(MOMOM4,3,IMLU,0)
  183. IF (IMLU.EQ.0) GOTO 999
  184. CALL LIRREE(VAL,1,IRETOU)
  185. IF (IERR.NE.0) RETURN
  186. MOTFOR(**)=MOMOM4(IMLU)
  187. VALFOR(**)=VAL
  188. GOTO 24
  189. C*OF Pas de MOMENT en 1D (IFOMOD=3,4,5)
  190. ENDIF
  191. ENDIF
  192. 999 IF (MOTFOR(/2).EQ.0) THEN
  193. CALL ERREUR(533)
  194. RETURN
  195. ENDIF
  196. ENDIF
  197.  
  198. CALL LIROBJ('POINT ',IPT1,0,IRETOU)
  199. C ON A BIEN LU UN POINT (application du chargement)
  200. IF (IRETOU.NE.0) THEN
  201. CALL CRELEM(IPT1)
  202. C A T ON UN OBJET DE TYPE ELEMENT SI OUI ON LE TRAN EN POINT
  203. ELSE
  204. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  205. IF (IERR.NE.0) RETURN
  206. CALL CHANGE(IPT1,1)
  207. ENDIF
  208.  
  209. CCCCCCCCCCCCC ON N A PAS D ERREUR ON RECUPERE LES COORDONNEES DU
  210. C VECTEUR ET LE NUMERO DU POINT
  211. IF (IRET1.EQ.1) THEN
  212. SEGACT,MCOORD
  213. iNoe=(NOEUD-1)*(IDIM+1)
  214. DO i=1,IDIM
  215. VEC(i)=XCOOR(iNoe+i)
  216. ENDDO
  217. CCCCCCCCCCCCCC ON RECUPERE LE NUMERO DU POINT
  218. CCCCCCCCCCCCCC ON COMPTE LE NOMBRE DE COMPOSANTE ET L ADRESSE
  219. CCCCCCCCCCCCCC DANS LE TABLEAU DU TYPE DES DDL SUIVANT L OPTION
  220. JDIM=IDIM
  221. IF (LTYP.EQ.2) THEN
  222. IF (IFOMOD.LE.1) THEN
  223. JDEC=9
  224. JDIM=1
  225. ELSE IF (IFOMOD.EQ.2) THEN
  226. JDEC=6
  227. ELSE
  228. CALL ERREUR(533)
  229. RETURN
  230. ENDIF
  231. ELSE IF (LTYP.EQ.1) THEN
  232. JDEC=0
  233. IF (IFOMOD.EQ.1) THEN
  234. JDEC=3
  235. JDIM=3
  236. ELSE IF (IFOMOD.EQ.0) THEN
  237. JDEC=3
  238. ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  239. JDEC=3
  240. ENDIF
  241. ELSE
  242. MOTERR(1:4)=LOCERR
  243. CALL ERREUR(5)
  244. RETURN
  245. ENDIF
  246. NC=JDIM
  247. ELSE
  248. NC=MOTFOR(/2)
  249. ENDIF
  250.  
  251. CCCCCCCCCCC CREATION DU SEGMENT GEOMETRIE
  252. NSOUPO=1
  253. NAT=1
  254. SEGINI,MCHPOI
  255. MTYPOI='FORCES'
  256. MOCHDE=' CHPOINT CREE PAR FORCE '
  257. C* IFOPOI=IFOMOD
  258. IFOPOI=IFOUR
  259. JATTRI(1)=2
  260. SEGINI,MSOUPO
  261. IPCHP(1)=MSOUPO
  262. IGEOC=IPT1
  263. IF (IRET1.EQ.1) THEN
  264. DO i=1,NC
  265. NOHARM(i)=NIFOUR
  266. NOCOMP(i)=MOTYPO(JDEC+i)
  267. ENDDO
  268. ELSE
  269. DO i=1,NC
  270. NOHARM(i)=NIFOUR
  271. NOCOMP(i)=MOTFOR(i)
  272. ENDDO
  273. ENDIF
  274. MELEME=IPT1
  275. SEGACT,MELEME
  276. N=NUM(/2)
  277. SEGINI,MPOVAL
  278. IPOVAL=MPOVAL
  279. IF (IRET1.EQ.1) THEN
  280. DO i=1,NC
  281. zz=VEC(i)/N
  282. DO j=1,N
  283. VPOCHA(j,i)=zz
  284. ENDDO
  285. ENDDO
  286. ELSE
  287. DO i=1,NC
  288. zz=VALFOR(i)/N
  289. DO j=1,N
  290. VPOCHA(j,i)=zz
  291. ENDDO
  292. ENDDO
  293. ENDIF
  294. SEGDES,MELEME,MPOVAL,MSOUPO,MCHPOI
  295.  
  296. IP2=MCHPOI
  297. CALL ECROBJ('CHPOINT',IP2)
  298. IF (IRET1.EQ.0) SEGSUP,MSWMOT,MSWVAL
  299.  
  300. RETURN
  301.  
  302. 200 continue
  303. call force2(ipt)
  304. END
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  

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