Télécharger elfgr2.eso

Retour à la liste

Numérotation des lignes :

  1. C ELFGR2 SOURCE CHAT 05/01/12 23:32:01 5004
  2. SUBROUTINE ELFGR2(KGREEN,DELTAT,M,NPAS,MAXBLO,KNREFE,KANBN,KDNCN)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C =====================================================================
  7. C APPELE PAR ELFE
  8. C INITIALISATION DES BLOCS ANBN ET DNCN
  9. C REMPLISSAGE DES ANBN AVEC LES FONCTIONS DE GREEN ( KGREEN )
  10. C
  11. C CREATION : 22/09/87
  12. C PROGRAMMEUR : GUILBAUD
  13. C =====================================================================
  14. -INC CCOPTIO
  15. -INC CCREEL
  16. -INC SMEVOLL
  17. -INC SMLREEL
  18. C
  19. SEGMENT MANBN
  20. POINTEUR KAB(NSGA).ANBN
  21. ENDSEGMENT
  22. C
  23. C NSGA : NOMBRE DE BLOCS ANBN
  24. C
  25. SEGMENT ANBN
  26. REAL*8 AB(NTANBN,LANBN)
  27. ENDSEGMENT
  28. C
  29. C AB(I,K) : TERME I DE LA MATRICE A OU B D'UN ELEMENT AU TEMPS K
  30. C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B DE TOUS LES ELEMENTS
  31. C LANBN : NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC ANBN
  32. C
  33. SEGMENT MDNCN
  34. POINTEUR KDC(NSGD).DNCN
  35. ENDSEGMENT
  36. C
  37. C NSGD : NOMBRE DE BLOCS DNCN
  38. C
  39. SEGMENT DNCN
  40. REAL*8 DC(NIDNCN,LDNCN)
  41. ENDSEGMENT
  42. C
  43. C DC(I,K) : DDL I AU TEMPS (K-1)*DELTAT
  44. C NIDNCN : NOMBRE TOTAL D'INCONNUES
  45. C LDNCN : 1 + NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC DNCN
  46. C
  47. SEGMENT MNREFE
  48. INTEGER NREFE(8,NSTR)
  49. INTEGER NTANBN
  50. INTEGER NIDNCN
  51. INTEGER NTVN
  52. POINTEUR NREPA.MPASS
  53. POINTEUR NRECA.MCARA
  54. POINTEUR NRENO.MNORM
  55. POINTEUR NRECPR.ICPR
  56. POINTEUR NREMEL.MELEME
  57. POINTEUR NREDEN.MDEN
  58. ENDSEGMENT
  59. C
  60. C NSTR : NOMBRE D'ELEMENTS
  61. C NREFE(1,I) : MELEME
  62. C NREFE(2,I) : MSOSTU
  63. C NREFE(3,I) : TYPE DE L'ELEMENT
  64. C NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  65. C NREFE(5,I) : NOMBRE DE DDL PAR POINT
  66. C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  67. C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  68. C NREFE(8,I)=1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
  69. C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  70. C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  71. C NTVN : LONGUEUR DU TABLEAU VN
  72. C
  73. SEGMENT MCARA
  74. REAL*8 CARA(LCAR*NSTR)
  75. ENDSEGMENT
  76. C
  77. C LCAR : NOMBRE DE CARACTERISTIQUES DE L'ELEMENT
  78. C
  79. SEGMENT MDEN
  80. INTEGER IDEN(INS)
  81. ENDSEGMENT
  82. C
  83. C IL Y A INS STRUCTURES AYANT DES CARACTERISTIQUES DIFFERENTES
  84. C IDEN CONTIENT LEUR NUMERO D'ORDRE DANS MNREFE
  85. C
  86. SEGMENT ITRAV(INS)
  87. CHARACTER *72 ITEX
  88. LOGICAL TRACTI,TORSIO
  89. C
  90. EPS=1.D-3
  91. IF (IIMPI.EQ.1) THEN
  92. WRITE(IOIMP,*) ' DEBUT DE ELFGR2 '
  93. END IF
  94. MNREFE=KNREFE
  95. MDEN=NREDEN
  96. NSTR=NREFE(/2)
  97. MCARA=NRECA
  98. LCAR=CARA(/1)/NSTR
  99. IF(M.EQ.0) M=NPAS
  100. TMAX=M*DELTAT
  101. C
  102. C RECHERCHE DES FONCTIONS DE GREEN
  103. C
  104. MEVOLL=KGREEN
  105. SEGACT MEVOLL
  106. NBEL=IEVOLL(/1)
  107. IF(MOD(NBEL,28).NE.0) THEN
  108. C *** IL MANQUE DES FONCTIONS DE GREEN
  109. CALL ERREUR(388)
  110. SEGDES MEVOLL
  111. RETURN
  112. ENDIF
  113. INS=IDEN(/1)
  114. SEGINI ITRAV
  115. DO 20 NB=1,NBEL
  116. KEVOLL=IEVOLL((NB-1)*28+1)
  117. SEGACT KEVOLL
  118. MLREEL=IPROGX
  119. SEGACT MLREEL
  120. DT=PROG(2)-PROG(1)
  121. IL=PROG(/1)
  122. TT=PROG(IL)
  123. SEGDES MLREEL
  124. DT2=DT*0.999999999
  125. IF (DELTAT.LT.DT2 .OR. (INT(DELTAT/DT)*DT).LT.DT2) THEN
  126. CALL ERREUR(389)
  127. SEGDES KEVOLL
  128. SEGDES MEVOLL
  129. RETURN
  130. END IF
  131. IF(TMAX .GT. TT) THEN
  132. C *** LA DUREE DU CALCUL EST TROP GRANDE POUR LES FONCTIONS DE GREEN
  133. CALL ERREUR(390)
  134. SEGDES KEVOLL
  135. SEGDES MEVOLL
  136. RETURN
  137. ENDIF
  138. ITEX=KEVTEX
  139. READ (ITEX(6:17),FMT='(1PE12.5)') DLL
  140. READ (ITEX(24:35),FMT='(1PE12.5)') CTC
  141. READ (ITEX(43:54),FMT='(1PE12.5)') RTC
  142. SEGDES KEVOLL
  143. KEVOLL=IEVOLL((NB-1)*28+3)
  144. SEGACT KEVOLL
  145. ITEX=KEVTEX
  146. READ (ITEX(24:35),FMT='(1PE12.5)') CTO
  147. READ (ITEX(43:54),FMT='(1PE12.5)') RTO
  148. SEGDES KEVOLL
  149. KEVOLL=IEVOLL((NB-1)*28+5)
  150. SEGACT KEVOLL
  151. ITEX=KEVTEX
  152. READ (ITEX(43:54),FMT='(1PE12.5)') RFZ
  153. SEGDES KEVOLL
  154. KEVOLL=IEVOLL((NB-1)*28+10)
  155. SEGACT KEVOLL
  156. ITEX=KEVTEX
  157. READ (ITEX(43:54),FMT='(1PE12.5)') RFY
  158. SEGDES KEVOLL
  159. C
  160. C BOUCLE SUR LES ELEMENTS------------------------------
  161. C
  162. DO 10 IN=1,INS
  163. IF(ITRAV(IN).EQ.0) THEN
  164. NS=IDEN(IN)
  165. NCA=LCAR*(NS-1)
  166. DIF=ABS(1.D0-DLL/CARA(NCA+1))
  167. IF(DIF.GT.EPS) GOTO 10
  168. C DIF=ABS(1.D0-CTC/CARA(NCA+6))
  169. C IF(DIF.GT.EPS) GOTO 10
  170. DIF=ABS(1.D0-RTC/CARA(NCA+2))
  171. IF(DIF.GT.EPS) GOTO 10
  172. C DIF=ABS(1.D0-CTO/CARA(NCA+7))
  173. C IF(DIF.GT.EPS) GOTO 10
  174. DIF=ABS(1.D0-RTO/CARA(NCA+3))
  175. IF(DIF.GT.EPS) GOTO 10
  176. DIF=ABS(1.D0-RFY/CARA(NCA+4))
  177. IF(DIF.GT.EPS) GOTO 10
  178. DIF=ABS(1.D0-RFZ/CARA(NCA+5))
  179. IF(DIF.GT.EPS) GOTO 10
  180. ITRAV(IN)=NB
  181. GOTO 20
  182. ENDIF
  183. 10 CONTINUE
  184. 20 CONTINUE
  185. DO 30 IN=1,INS
  186. IF(ITRAV(IN).EQ.0) THEN
  187. C *** IL MANQUE LES FONCTIONS DE GREEN DE LA SOUS-STRUCTURE
  188. NS=IDEN(IN)
  189. INTERR(1)=NREFE(2,NS)
  190. CALL ERREUR(391)
  191. ENDIF
  192. 30 CONTINUE
  193. IF(IERR.EQ.2) THEN
  194. SEGSUP ITRAV
  195. SEGDES MEVOLL
  196. RETURN
  197. ENDIF
  198. C
  199. C CREATION DES BLOCS ANBN
  200. C
  201. IF(NTANBN.GT.MAXBLO) THEN
  202. C *** TAILLE DU CALCUL TROP IMPORTANTE
  203. CALL ERREUR(382)
  204. RETURN
  205. ENDIF
  206. LANBN=MAXBLO/NTANBN
  207. LANBND=LANBN
  208. NSGA=(M-1)/LANBN+1
  209. SEGINI MANBN
  210. KANBN=MANBN
  211. DO 40 K=1,NSGA
  212. IF(K.EQ.NSGA) LANBN=M-(NSGA-1)*LANBN
  213. SEGINI ANBN
  214. SEGDES ANBN
  215. KAB(K)=ANBN
  216. 40 CONTINUE
  217. LANBN=LANBND
  218. C
  219. C CREATION DES BLOCS DNCN
  220. C
  221. IF(NIDNCN.GT.MAXBLO) THEN
  222. C *** TAILLE DU CALCUL TROP IMPORTANTE
  223. CALL ERREUR(382)
  224. RETURN
  225. ENDIF
  226. LDNCN=MAXBLO/NIDNCN
  227. MPAS=NPAS
  228. IF(M.NE.NPAS) THEN
  229. C TRONCATURE DU PRODUIT DE CONVOLUTION ( MEMOIRE GLISSANT PAR BLOC )
  230. MMPAS=M+LDNCN
  231. IF(NPAS.GT.MMPAS) MPAS=MMPAS
  232. ENDIF
  233. NSGD=MPAS/LDNCN+1
  234. SEGINI MDNCN
  235. KDNCN=MDNCN
  236. DO 50 K=1,NSGD
  237. SEGINI DNCN
  238. CALL ZERO(DC,NIDNCN,LDNCN)
  239. SEGDES DNCN
  240. KDC(K)=DNCN
  241. 50 CONTINUE
  242. IF (IIMPI .EQ. 1801) THEN
  243. WRITE(IOIMP,*) 'NIDNC= ',NIDNCN
  244. WRITE(IOIMP,*) 'MAXBLO= ',MAXBLO
  245. WRITE(IOIMP,*) 'NB DE BLOCS ',NSGD
  246. END IF
  247. C
  248. C BOUCLE SUR LES BLOCS
  249. C
  250. LDEC=0
  251. DO 100 K=1,NSGA
  252. ANBN=KAB(K)
  253. SEGACT ANBN
  254. LANBN=AB(/2)
  255. C
  256. C--------BOUCLE SUR LES ELEMENTS------------------------------
  257. C
  258. DO 90 IN=1,INS
  259. NB=ITRAV(IN)
  260. NS=IDEN(IN)
  261. NRG=NREFE(7,NS)-1
  262. *
  263. DO 80 J=1,28
  264. KEVOLL=IEVOLL((NB-1)*28+J)
  265. SEGACT KEVOLL
  266. MLREEL=IPROGX
  267. SEGACT MLREEL
  268. DT=PROG(2)-PROG(1)
  269. DIF=ABS(1.D0-DT/DELTAT)
  270. SEGDES MLREEL
  271. MLREEL=IPROGY
  272. SEGACT MLREEL
  273. IF (DIF.LT.EPS) THEN
  274. DO 60 L=1,LANBN
  275. AB(NRG+J,L)=PROG(L+LDEC)
  276. 60 CONTINUE
  277. ELSE
  278. DO 70 L=1,LANBN
  279. T=DELTAT*DBLE(L+LDEC)
  280. N=IDINT(T/DT)
  281. ALPHA=(T-DBLE(N)*DT)/DT
  282. N1=N+1
  283. N2=N+2
  284. AB(NRG+J,L)=(PROG(N2)-PROG(N1))*ALPHA+PROG(N1)
  285. 70 CONTINUE
  286. END IF
  287. SEGDES MLREEL
  288. SEGDES KEVOLL
  289. 80 CONTINUE
  290. *
  291. IF(IIMPI.EQ.1801)THEN
  292. WRITE(IOIMP,*) ' STRUCTURE ',NS
  293. WRITE(IOIMP,1000) K
  294. 1000 FORMAT(1X,//I5,'IEME BLOC DES TERMES DES MATRICES ANBN'/)
  295. DO 120 J=1,28
  296. WRITE(IOIMP,1001) (J,AB(NRG+J,LL2),LL2=1,LANBN)
  297. 1001 FORMAT(1X,5(I5,1X,1PE12.5))
  298. 120 CONTINUE
  299. ENDIF
  300. 90 CONTINUE
  301. SEGDES ANBN
  302. LDEC=LDEC+LANBN
  303. 100 CONTINUE
  304. C
  305. C BOUCLE SUR LES ELEMENTS POUR DETERMINER CEUX QUI SONT RIGIDES
  306. C
  307. DO 110 NS=1,NSTR
  308. NCA=LCAR*(NS-1)
  309. DLL=CARA(NCA+1)
  310. CTC=CARA(NCA+6)
  311. WRITE(IOIMP,*)' CTC= ',CTC
  312. DTL=DLL/CTC
  313. IF(DELTAT.GT.DTL) THEN
  314. NREFE(8,NS)=1
  315. GOTO 110
  316. ENDIF
  317. CTO=CARA(NCA+7)
  318. DTL=DLL/CTO
  319. IF(DELTAT.GT.DTL) THEN
  320. NREFE(8,NS)=1
  321. GOTO 110
  322. ENDIF
  323. RFY=CARA(NCA+4)
  324. DTL=DLL*DLL/(3.D0*CTC*RFY*XPI)
  325. IF(DELTAT.GT.DTL) THEN
  326. NREFE(8,NS)=1
  327. GOTO 110
  328. ENDIF
  329. RFZ=CARA(NCA+5)
  330. DTL=DLL*DLL/(3.D0*CTC*RFZ*XPI)
  331. IF(DELTAT.GT.DTL) THEN
  332. NREFE(8,NS)=1
  333. GOTO 110
  334. ENDIF
  335. 110 CONTINUE
  336. WRITE(IOIMP,*) ' NREFE ',(NREFE(8,NS),NS=1,NSTR)
  337. SEGSUP ITRAV
  338. SEGDES MEVOLL
  339. IF (IIMPI.EQ.1) THEN
  340. WRITE(IOIMP,*)' FIN DE ELFGR2 '
  341. END IF
  342. RETURN
  343. END
  344.  
  345.  
  346.  
  347.  

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