Télécharger elpdy2.eso

Retour à la liste

Numérotation des lignes :

  1. C ELPDY2 SOURCE CB215821 16/04/15 21:15:19 8907
  2. SUBROUTINE ELPDY2
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-B,D-H,O-Z)
  5. IMPLICIT COMPLEX*16(C)
  6. ************************************************************************
  7. *
  8. *
  9. *
  10. * ELFE PLAQUE LAPLACE ...........
  11. * ---- ------ -------
  12. *
  13. *
  14. ************************************************************************
  15. -INC CCREEL
  16. -INC SMELEME
  17. -INC SMCHPOI
  18. -INC SMTABLE
  19. -INC SMLREEL
  20. *
  21. *
  22. POINTEUR MLRE10.MLREEL
  23. SEGMENT SBORD
  24. REAL*8 XBORD(15,NS)
  25. INTEGER IBORD (2 ,NS)
  26. ENDSEGMENT
  27. SEGMENT SCOIN
  28. REAL*8 XCOIN(14,NCOIN)
  29. INTEGER ICOIN(4 ,NCOIN)
  30. ENDSEGMENT
  31. SEGMENT SPOST
  32. REAL*8 PP0(2,NP0)
  33. COMPLEX*16 CRP (NP0)
  34. COMPLEX*16 CPOST(NS4)
  35. ENDSEGMENT
  36. SEGMENT SMAT
  37. COMPLEX*16 CMA1(NS4,NS4)
  38. COMPLEX*16 CSM (NS4)
  39. COMPLEX*16 CSOM2 (NS)
  40. COMPLEX*16 CRE (NS4)
  41. ENDSEGMENT
  42. SEGMENT SMAT2
  43. COMPLEX*16 CMA2(NS4,NS4)
  44. COMPLEX*16 CSM2(NS4)
  45. ENDSEGMENT
  46. SEGMENT SMAI
  47. INTEGER IAUX(NS4)
  48. INTEGER IPIVO(NS4)
  49. INTEGER JPIVO(NS4)
  50. ENDSEGMENT
  51. *
  52. *
  53. *
  54. CHARACTER * (1) cAR0
  55. CHARACTER * 1 cAr1
  56. CHARACTER * 40 CHA1
  57. CHARACTER * 40 CHA2
  58. CHARACTER * 40 CHA3
  59. LOGICAL LOG0
  60. LOGICAL LOG1
  61. DIMENSION PF0(2)
  62.  
  63. REE1=0.D0
  64. *
  65. *
  66. *--1. LECTURE
  67. *
  68. * ( on fixe ntrap ntrap2,isingu,iregu au lieu de les lire)
  69. * ( on garde les branchements car les choix de methode ne
  70. * sont pas definitifs)
  71. CALL LIROBJ('MAILLAGE',IPT1 ,1,IRET)
  72. IF (IRET.EQ.0) RETURN
  73.  
  74. CALL LIRREE(XE1,1,IRET)
  75. IF (IRET.EQ.0) RETURN
  76. CALL LIRREE(XH1,1,IRET)
  77. IF (IRET.EQ.0) RETURN
  78. CALL LIRREE(XNU1,1,IRET)
  79. IF (IRET.EQ.0) RETURN
  80. CALL LIRREE(XRO1,1,IRET)
  81. IF (IRET.EQ.0) RETURN
  82. CALL LIROBJ('LISTREEL',MLRE10,1,IRET)
  83. IF (IRET.EQ.0) RETURN
  84. NTRap=5
  85. NTRap2=5
  86. *- COINS
  87. CALL LIROBJ('MAILLAGE',IPT2 ,0,IRET1)
  88. IF ( IRET1 .EQ. 1) THEN
  89. SEGACT IPT2
  90. NBELEM = IPT2.NUM(/2)
  91. NCOIN = NBELEM
  92. NC1 = Ncoin
  93. else
  94. NCOIN = 0
  95. NC1 = 0
  96. IPT2 = 0
  97. ENDIF
  98.  
  99. *- C.L.
  100.  
  101. CALL LIROBJ('MCHAML',MCHELM ,1,IRET)
  102. IF (IRET.EQ.0) RETURN
  103.  
  104. *- FORCE PONCTUELLE
  105.  
  106. CALL LIROBJ('POINT',IPF0,1,IRET)
  107. IF (IRET.EQ.0) RETURN
  108. XF0 = 1.D0
  109. *- POSTRAITEMENT
  110.  
  111. CALL LIROBJ('POINT',IPP0,0,IRET1)
  112. CALL LIROBJ('MAILLAGE',IPT3,0,IRET2)
  113. IF ( IRET1 .EQ. 1) THEN
  114. NP0 = 1
  115. ENDIF
  116. IF ( IRET2 .EQ. 1) THEN
  117. SEGACT IPT3
  118. NP0 = IPT3.NUM(/2)
  119. ENDIF
  120.  
  121.  
  122.  
  123. *- PARAMETRE LAPLACE
  124.  
  125. CALL LIRREE(S0,1,IRET)
  126. IF (IRET.EQ.0) RETURN
  127. CALL LIROBJ('LISTREEL',MLREE1,1,IRET)
  128. IF (IRET.EQ.0) RETURN
  129.  
  130.  
  131. *- PARAMETREs methodes
  132.  
  133. isingu=1
  134. iregu=2
  135.  
  136. *
  137. *--2. DIMENSIONNEMENT
  138. *
  139. SEGACT IPT1
  140. NBELEM = IPT1.NUM(/2)
  141. NS = NBELEM
  142. NS4= 4 * NBELEM
  143. SEGINI SBORD
  144. SEGINI SCOIN
  145. SEGINI SMAT
  146. SEGINI SMAT2
  147. SEGINI SMAI
  148. SEGINI SPOST
  149. SEGACT MLREE1
  150. JG = MLREE1.PROG(/1)
  151. SEGACT MLRE10
  152. SEGINI SPOST
  153. IF (NP0 .EQ.1) THEN
  154. SEGINI MLREE2
  155. SEGINI MLREE3
  156. ENDIF
  157.  
  158. M=0
  159. SEGINI MTABLE
  160. iENT0 =0
  161. REE0 =0d0
  162. CAR0 =' '
  163. CAR1 = ' '
  164. LOG0 =.TRUE.
  165. LOG1 =.TRUE.
  166. IPoin0=0
  167.  
  168.  
  169.  
  170. *
  171. *--3. CARACTERISTIQUES GEOMETRIQUES
  172. *
  173. CI = (0.D0,1.D0)
  174. XD = XE1* (XH1**3) / (12 * (1 - XNU1**2))
  175. XNU = XNU1
  176.  
  177. CALL ELPGEO (SBORD,SCOIN,SPOST,IPT1,IPT2,IPF0,PF0,IPP0,IPT3)
  178. *
  179. *--4. REMPLISSAGE DES TERMES C.L.
  180. *
  181. CALL ELPDM2 (SBORD,SMAT,MCHELM)
  182. *
  183. *--5. on commence par un calcul statique bidon indispensable
  184. ISTAT = 1
  185. CALL ELPDM1 (XBORD,IBORD,NS
  186. & ,XCOIN,ICOIN,NCOIN,NC1
  187. & ,CMA1,CSM,CSOM2,NS4
  188. & ,XD,XNU,NTRAP,NTRAP2,PF0,XF0,CB,ISTAT
  189. & ,isingu,iregu)
  190. DO 100 K1= 1,NS4
  191. DO 200 K2= 1,NS4
  192. CMA2(K1,K2) = CMA1(K1,K2)
  193. 200 CONTINUE
  194. CSM2(K1)= CSM(K1)
  195. CRE (K1)= 0D0
  196. 100 CONTINUE
  197. *
  198. CALL ELPDR1 (CMA2,CSM2 , CRE , NS4 ,IPIVO,JPIVO, IAUX )
  199. *
  200. *--5. BOUCLE SUR LES FREQUENCES DEMANDEES PAR L' UTILISATEUR
  201. *
  202. DO 1000 I = 1,JG
  203. xcam = mlre10.prog(i)
  204. CS1 = S0 + CI*MLREE1.PROG(I)
  205. CB =( (CMPLX(-1)*(xcam*cs1 + XRO1*XH1*CS1*CS1))
  206. & /XD )**CMPLX(.25D0)
  207. IF (MLREE1.PROG(I) .LT . 1E-10) THEN
  208. ISTAT = 1
  209. ELSE
  210. ISTAT = 0
  211. ENDIF
  212. CALL ELPDM1 (XBORD,IBORD,NS
  213. & ,XCOIN,ICOIN,NCOIN,NC1
  214. & ,CMA1,CSM,CSOM2,NS4
  215. & ,XD,XNU,NTRAP,NTRAP2,PF0,XF0,CB,ISTAT
  216. & ,isingu,iregu)
  217. DO 1100 K1= 1,NS4
  218. DO 1200 K2= 1,NS4
  219. CMA2(K1,K2) = CMA1(K1,K2)
  220. 1200 CONTINUE
  221. CSM2(K1)= CSM(K1)
  222. CRE (K1)= 0D0
  223. 1100 CONTINUE
  224. *
  225. IF ( I .EQ. 1 ) THEN
  226. CALL ELPDR1 (CMA2,CSM2 , CRE , NS4 ,IPIVO,JPIVO, IAUX )
  227. ELSE
  228. CALL ELPDR2 (CMA2,CSM2 , CRE , NS4 ,IPIVO,JPIVO, IAUX )
  229. ENDIF
  230. C
  231. c post-traitement
  232. c
  233. CALL ELPD99 (XBORD,IBORD,NS
  234. & ,XCOIN,ICOIN,NCOIN,NC1
  235. & ,CRE,CPOST,CRP,NS4
  236. & ,XD,XNU,NTRAP,PF0,XF0,PP0,NP0,CB,ISTAT)
  237.  
  238. IF ( NP0 .EQ. 1) THEN
  239. CCP = CRP(1)
  240. XX = ABS (CCP)
  241. XR = CCP
  242. XI = -1*CI*(CCP - XR)
  243. XT = ATAN2(XI,XR)*180.D0/XPI
  244. MLREE2.PROG(I) = XX
  245. MLREE3.PROG(I) = XT
  246. ELSE
  247. N = NP0
  248. NC= 2
  249. NSOUPO = 1
  250. SEGINI MPOVAL
  251. SEGINI MSOUPO
  252. IPOVAL = MPOVAL
  253. IGEOC = IPT3
  254. NOCOMP(1) = 'MODU'
  255. NOCOMP(2) = 'PHAS'
  256. NOHARM(1) = 0
  257. NOHARM(2) = 0
  258. NAT=1
  259. SEGINI MCHPOI
  260. MTYPOI = ' CREE PAR ELFE '
  261. MOCHDE = ' ELFE '
  262. IPCHP (1) = MSOUPO
  263. * MODU et PHAS sont des chpo diffus
  264. JATTRI(1) = 1
  265. IFOPOI = 0
  266. DO 1110 IP =1,NP0
  267.  
  268. CCP = CRP(IP)
  269. XX = ABS (CCP)
  270. XR = CCP
  271. XI = -1*CI*(CCP - XR)
  272. XT = ATAN2(XI,XR)*180.D0/XPI
  273. VPOCHA (IP,1) = XX
  274. VPOCHA (IP,2) = XT
  275. 1110 CONTINUE
  276. CALL ECCTAB(MTABLE,'ENTIER ',I ,REE0,CAR0,LOG0,Ipoin0,
  277. & 'CHPOINT ',iENT0,REE1,CAR1,LOG1,MCHPOI)
  278. ENDIF
  279.  
  280.  
  281. 1000 CONTINUE
  282. *
  283. IF ( NP0 .EQ. 1) THEN
  284. CALL ECCTAB(MTABLE,'ENTIER ',1 ,REE0,CAR0,LOG0,IPOIN0,
  285. & 'LISTREEL',ient0,ree1,car1,log1,mlree2)
  286. CALL ECCTAB(MTABLE,'ENTIER ',2 ,REE0,CAR0,LOG0,IPOIN0,
  287. & 'LISTREEL',ient0,ree1,car1,log1,mlree3)
  288. ENDIF
  289. CALL ECROBJ('TABLE',MTABLE)
  290. *
  291. SEGDES MTABLE
  292. SEGDES MLREE1
  293.  
  294. *
  295. SEGSUP SBORD
  296. SEGSUP SCOIN
  297. SEGSUP SMAT
  298. SEGSUP SMAT2
  299. SEGSUP SMAI
  300. SEGSUP SPOST
  301. *
  302. RETURN
  303. END
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  

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