Télécharger ellp11.eso

Retour à la liste

Numérotation des lignes :

  1. C ELLP11 SOURCE KK2000 14/04/09 21:15:19 8027
  2. SUBROUTINE ELLP11(COOR, CORRES, GAMA, CARACT, XCL, FLAG,
  3. * NUMERO, ZA1,ZSM, ZXX, ZSOL, ITERA, MASS, RMAS, NMAS,
  4. * SA, SB, SU, SR, SQ, SDELTA, SDELT1, SP, SP1, SCH, SCH1,
  5. * IPIVO, JPIVO, IAUX, XFRQ, NNPOI, ICHAR, NP, NP24, NP48, NNT,
  6. * NNT12, NFRQ, S0, XPI, METH, IMP)
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Y)
  10. IMPLICIT COMPLEX*16 (Z)
  11. C
  12. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13. C
  14. C OPERATEUR ELFE LAPLACE POUTRE
  15. C
  16. C PROGRAMME PRINCIPAL DE FORTRAN EN SORTIE DE L'INTERFACE ESOPE
  17. C
  18. C L'ALGORITHME EST LE SUIVANT :
  19. C
  20. C
  21. C - ACQUISITION DES DONNEES PAR ARGUMENTS DE ELLP11
  22. C
  23. C - REMPLISSAGE DE LA 2EME PARTIE DE ZA1 (INDEPENDANT DE W)
  24. C + 2EME PARTIE DU SECOND MEMBRE (CALL ELLP12)
  25. C
  26. C - BOUCLE SUR W
  27. C |
  28. C | S = S0 + I W
  29. C |
  30. C | - BOUCLE SUR CHAQUE POUTRE
  31. C | |
  32. C | | - CALCUL DE CHAQUE MATRICE CI (CALL ELLP21)
  33. C | |
  34. C | | - ASSEMBLAGE DES MATRICES
  35. C | |
  36. C | | - CALCUL DU SECOND MEMBRE
  37. C | |
  38. C | - RESOLUTION (CALL ELLP51)
  39. C |
  40. C - RETURN
  41. C
  42. C
  43. C PARAMETRES :
  44. C
  45. C COOR : TABLEAU DES COORDONNEES DES 2*NP NOEUDS FICTIFS
  46. C CORRES : TABLEAU D'ENTIER DES NUMEROS DES NOEUDS REELS
  47. C POUR CHAQUE NOEUD FICTIF
  48. C GAMA : TABLEAU DES VECTEUR DONNANT LE PLAN OXY POUR CHAQUE POUTRE
  49. C CARACT : TABLEAU DES CARACTERISTIQUE DES POUTRES (11 ,NP)
  50. C XCL : TABLEAU DES VALEURS DES CONDITIONS AUX LIMITES
  51. C FLAG : TABLEAU DE POINTEURS SUR XCL
  52. C NUMERO : TABLEAU DE NUMEROTATION GLOBALE <--> LOCALE
  53. C XFRQ : TABLEAU DES POINTS DE CALCUL EN FREQUENCE
  54. C
  55. C NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
  56. C NP : NOMBRE DE POUTRES
  57. C NNT : NOMBRE DE NOEUDS REELS
  58. C
  59. C SORTIES :
  60. C
  61. C ZA1 : TABLEAU COMPLEXE REPRESENTANT LA MATRICE DE "RIGIDITE"
  62. C ZSM : VECTEUR COMPLEXE SECOND MEMBRE
  63. C ZXX : VECTEUR COMPLEXE SOLUTION
  64. C
  65. C
  66. C AUTEUR : SAINT-DIZIER
  67. C DATE : 22 DECEMBRE 1989 (VERSION DU 03 AVRIL 1990)
  68. C
  69. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  70. C
  71. COMPLEX*16 ZA1(NP24,*),ZSM(*),ZXX(*),ZC1(12,24)
  72. COMPLEX*16 ZSOL(NNT12,*)
  73. REAL*8 COOR(3,*),GAMA(3,*),CARACT(12,*),XCL(12,*),XFRQ(*)
  74. REAL*8 SA(NP48,*),SB(*),SU(*),SR(*),SQ(*)
  75. REAL*8 SDELTA(*),SDELT1(*),SP(*),SP1(*)
  76. REAL*8 SCH(*),SCH1(*)
  77. INTEGER FLAG(*),CORRES(*),NUMERO(*),ITERA(*)
  78. INTEGER MASS(NNT,4)
  79. REAL*8 RMAS(NNT,4)
  80. INTEGER IPIVO(*),JPIVO(*),IAUX(*)
  81. C
  82. C **********************************************************************
  83. C INITIALISATION
  84. C **********************************************************************
  85. C
  86. ZI = (0.D0 , 1.D0)
  87. C
  88. C --------------------------------- COEFFICIENT DE NORMALISATION
  89. C (CF ELLP52)
  90. C **********************************************************************
  91. C BOUCLE SUR LES FREQUENCES
  92. C **********************************************************************
  93. C
  94. DO 30 IFRQ = 1 , NFRQ
  95. C
  96. C **********************************************************************
  97. C REMISE A ZERO DES MATRICE POUR CHAQUE FREQUENCE
  98. C **********************************************************************
  99. C
  100. C
  101. DO 58 I = 1 , 24*NP
  102. DO 59 J = 1 , 24*NP
  103. ZA1(I,J) = (0.D0,0.D0)
  104. 59 CONTINUE
  105. ZSM(I) = (0.D0,0.D0)
  106. 58 CONTINUE
  107. C
  108. C
  109. C **********************************************************************
  110. C REMPLISSAGE DE LA 2EME PARTIE DE ZA1 (INDEPENDANT DE W)
  111. C + 2EME PARTIE DU SECOND MEMBRE
  112. C **********************************************************************
  113. C
  114. CALL ELLP12(CORRES,XCL,FLAG,NUMERO,MASS,NMAS,NP,NP24,NNT,ZA1,ZSM)
  115. C
  116. C
  117. ZS = S0 + ZI * CMPLX(2.D0) * XPI * XFRQ(IFRQ)
  118. C
  119. C **********************************************************************
  120. C BOUCLE SUR LES POUTRES
  121. C **********************************************************************
  122. C
  123. DO 40 INP = 1 , NP
  124. C
  125. C ------------------------------ CALCUL DE ZC1 MATRICE ELEMENTAIRE
  126. C
  127. CALL ELLP21 (CARACT,INP,ZS,COOR,GAMA,CORRES,ZC1)
  128. C
  129. C ------------------------------------- ASSEMBLAGE DE ZC1 DANS ZA1
  130. C
  131. DO 41 J = 1 , 24
  132. DO 42 I = 1 , 12
  133. ZA1(12*(INP-1)+I,24*(INP-1)+J) = ZC1(I,J)
  134. 42 CONTINUE
  135. 41 CONTINUE
  136. C
  137. 40 CONTINUE
  138. C
  139. C
  140. C
  141. C -------------------------- PRISE EN COMPTE DES MASSES PONCTUELLES
  142. C
  143. CALL ELLP22 (CORRES,FLAG,COOR,GAMA,ZA1,MASS,RMAS,
  144. * ZS,NP,NP24,NMAS,NNT)
  145. C
  146. C **********************************************************************
  147. C IMPRESSION DE LA MATRICE ZA1
  148. C **********************************************************************
  149. C
  150. C
  151. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  152. C
  153. IF ((IMP.NE.0).AND.(IFRQ.EQ.1)) THEN
  154. C
  155. EPS = 1.D-12
  156. C
  157. WRITE(IMP,*)'IMPRESSION DE LA MATRICE ZA1 :'
  158. DO 10 I = 1 , 24*NP
  159. DO 11 J = 1 , 24 * NP
  160. IF (ABS(ZA1(I,J)).GT.EPS) THEN
  161. WRITE(IMP,1001) I,J,ZA1(I,J)
  162. END IF
  163. 11 CONTINUE
  164. 10 CONTINUE
  165. C
  166. C
  167. WRITE(IMP,*) 'IMPRESSION DU SECOND MEMBRE ZSM :'
  168. DO 22 I = 1 , 24*NP
  169. WRITE(IMP,*) 'ZSM(',I,')',ZSM(I)
  170. 22 CONTINUE
  171. C
  172. END IF
  173. C
  174. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  175. C
  176. C ----------------------------------------------------------------------
  177. C RESOLUTION DU SYSTEME ZA1 * ZXX = ZSM
  178. C ----------------------------------------------------------------------
  179. C
  180. IF (IFRQ.EQ.1) THEN
  181. CALL ELLP51(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
  182. NP2 = NP24 / 12
  183. C
  184. C ---------------------------------------------------------------
  185. C CALCUL DES ORDRES DE GRANDEURS DES DEPLACEMENTS ET
  186. C DES EFFORTS, POUVANT ETRE UTILES POUR UNIFORMISER
  187. C LA MATRICE DE RESOLUTION POUR LES METHODES ITERATIVES
  188. C ---------------------------------------------------------------
  189. C
  190. XUR = 0.
  191. XFM = 0.
  192. DO 111 IN = 1 , NP2
  193. DO 112 JN = 1 , 6
  194. XX = ABS(ZXX((IN-1)*12+JN))
  195. IF (XX.GT.XUR) THEN
  196. XUR = XX
  197. END IF
  198. 112 CONTINUE
  199. DO 113 JN = 7 , 12
  200. XX = ABS(ZXX((IN-1)*12+JN))
  201. IF (XX.GT.XFM) THEN
  202. XFM = XX
  203. END IF
  204. 113 CONTINUE
  205. 111 CONTINUE
  206. C
  207. C XUR ET XFM DONNE DES ORDRES DE GRANDEUR SUR LE DEPLACEMENT
  208. C ET SUR LES EFFORTS ; CE RESULTAT PEUT ETRE UTILE POUR LA
  209. C METHODE DE RESOLUTION ITERATIVE
  210. C
  211. ELSE IF (METH.EQ.1) THEN
  212. C
  213. CALL ELLP51(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
  214. ELSE IF (METH.EQ.2) THEN
  215. C
  216. CALL ELLP53(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
  217. ELSE IF (METH.EQ.3) THEN
  218. C
  219. CALL ELLP54(ZA1,ZSM,ZXX,NP24,NP48,NNPOI,ICHAR,
  220. * XUR,XFM,NIT,SA,SB,SU,SR,SDELTA,SP,SCH,SCH1,EPSY)
  221. ELSE IF (METH.EQ.4) THEN
  222. C
  223. CALL ELLP58(ZA1,ZSM,ZXX,NP24,NP48,NNPOI,ICHAR
  224. * ,NIT,SA,SB,SU,SR,SDELTA,SP,SCH,SCH1,EPSY)
  225. END IF
  226. C
  227. ITERA(IFRQ) = NIT
  228. C
  229. DO 51 I = 1 , 2*NP
  230. KK = CORRES ( I )
  231. C
  232. DO 52 II = 1 , NNT
  233. IF (NUMERO(II).EQ.KK) THEN
  234. K = II
  235. END IF
  236. 52 CONTINUE
  237. C
  238. DO 53 J = 1 , 12
  239. ZSOL((K-1)*12+J,IFRQ) = ZXX((I-1)*12 + J)
  240. 53 CONTINUE
  241. C
  242. 51 CONTINUE
  243. C
  244. 30 CONTINUE
  245. C
  246. 1001 FORMAT('ZA1(',I3,',',I3,') =',2F12.3)
  247. C
  248. END
  249.  
  250.  
  251.  
  252.  

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