Télécharger prjdru.eso

Retour à la liste

Numérotation des lignes :

  1. C PRJDRU SOURCE CHAT 05/01/13 02:28:02 5004
  2. SUBROUTINE PRJDRU(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,
  3. . EPSTAR,ITER,SN,DHOOK,AM,A,BM,XMAT,YUNG,XNU,LAPOIN,KERRE,
  4. & ecou,necou)
  5. *
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL *8(A-H,O-Z)
  8. DIMENSION AM(*),A(*),BM(*),XMAT(*),DHOOK(*)
  9. -INC CCOPTIO
  10. *
  11. SEGMENT ECOU
  12. *** COMMON/ECOU/TEST,ALFAH,
  13. REAL*8 TEST, ALFAH,
  14. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  15. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  16. 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  17. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  18. ENDSEGMENT
  19. C COMMON/ECOU/TEST,ALFAH,
  20. C . HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  21. C . CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  22. C . DALPHA(6),EPSPLA(6),E(12),XINV(3),
  23. C . SIPLAD(6),DSIGP0(6),TET,TETI
  24. *
  25. SEGMENT NECOU
  26. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  27. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  28. . ITYP,JFOUR,IFLUAG,
  29. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  30. . JFLUAG,LEGAUS,LFLUAG,
  31. . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
  32. ENDSEGMENT
  33. C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  34. C . ITYP,JFOUR,IFLUAG,
  35. C . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  36. C . JFLUAG,LEGAUS,LFLUAG,
  37. C . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
  38. *
  39. DATA COEPT/1.D-3/
  40. DATA ITMAX/25/
  41. *
  42. * QUELQUES INITIALISATIONS
  43. *
  44. IIMPI0=IIMPI
  45. JEBOUC=0
  46. 2020 JEBOUC=JEBOUC+1
  47. KERRE=0
  48. LESN0 =0
  49. LAPOIN=0
  50. CALL ZDANUL(AM,36)
  51. CALL ZDANUL(W2,6)
  52. CALL ZDANUL(EPSPLA,6)
  53. XMATE =XMAT(1)
  54. XMATM =XMAT(2)
  55. XMATKL=XMAT(3)
  56. XMATC =XMAT(4)
  57. XMATD =XMAT(5)
  58. PEPSI =SQRT(2.D0*XMATC*XMATC+XMATD*XMATD)
  59. PENTE =XMAT(9)*PEPSI
  60. PENTF=PENTE
  61. *
  62. IF(IIMPI.EQ.15) THEN
  63. WRITE(IOIMP,77991) YUNG,XNU,ITYP,IMAPLA,PEPSI
  64. 77991 FORMAT('0 PRJDRU YUNG=',1PE12.5,2X,'XNU=',1PE12.5/
  65. . 2X,'ITYP=',I4,2X,'IMAPLA=',I4,2X,'PEPSI=',1PE12.5/)
  66. WRITE(IOIMP,77992) (XMAT(IJ),IJ=1,9)
  67. 77992 FORMAT('0 PRJDRU XMAT ' /(3(1X,1PE12.5)))
  68. WRITE(IOIMP,77995) SSTAR,SELAS,EPSTAR
  69. 77995 FORMAT('0 PRJDRU SSTAR=',1PE12.5,2X,'SELAS=',1PE12.5,2X,
  70. . 'EPSTAR=',1PE12.5/)
  71. ENDIF
  72. *
  73. * CALCUL DE LA MATRICE DE HOOKE ( ISOTROPE ONLY | )
  74. *
  75. CALL HOOINC(DHOOK,YUNG,XNU,ITYP)
  76. *
  77. GO TO (101,102,103,104,105,106,107,108,109),ITYP
  78. 101 CONTINUE
  79. DO 1010 IA=1,3
  80. AM((IA-1)*6+IA) =1.D0
  81. AM((IA-1)*6+21+IA)=3.0D0
  82. W2(IA)=1.D0
  83. 1010 CONTINUE
  84. AM(2)=-0.5D0
  85. AM(3)=-0.5D0
  86. AM(7)=-0.5D0
  87. AM(9)=-0.5D0
  88. AM(13)=-0.5D0
  89. AM(14)=-0.5D0
  90. GO TO 200
  91. 102 CONTINUE
  92. * ON SAUVE D COMPACTE SUR 10 VALEURS DANS CVNMSD
  93. CALL SHIFTD(DHOOK,CVNMSD,10)
  94. CALL ZDANUL(DHOOK,36)
  95. DHOOK(1)=CVNMSD(1)
  96. DHOOK(2)=CVNMSD(2)
  97. DHOOK(7)=CVNMSD(3)
  98. DHOOK(8)=CVNMSD(4)
  99. DHOOK(15)=CVNMSD(5)
  100. DHOOK(22)=CVNMSD(6)
  101. DHOOK(23)=CVNMSD(7)
  102. DHOOK(28)=CVNMSD(8)
  103. DHOOK(29)=CVNMSD(9)
  104. DHOOK(36)=CVNMSD(10)
  105. DO 1020 IA=1,2
  106. AM(6*(IA-1)+IA)=ALFAH
  107. AM(6*(IA-1)+21+IA)=1.D0
  108. W2(3+IA)=1.D0
  109. 1020 CONTINUE
  110. AM(2)=-0.5D0*ALFAH
  111. AM(7)=-0.5D0*ALFAH
  112. AM(15)=3.0D0*ALFAH
  113. AM(23)=-0.5D0
  114. AM(28)=-0.5D0
  115. AM(36)=3.0D0
  116. GO TO 200
  117. 103 CONTINUE
  118. CALL SHIFTD(DHOOK,CVNMSD,10)
  119. CALL ZDANUL(DHOOK,36)
  120. DHOOK(1)=CVNMSD(1)
  121. DHOOK(2)=CVNMSD(2)
  122. DHOOK(7)=CVNMSD(3)
  123. DHOOK(8)=CVNMSD(4)
  124. DHOOK(15)=CVNMSD(5)
  125. DHOOK(22)=CVNMSD(6)
  126. DHOOK(23)=CVNMSD(7)
  127. DHOOK(28)=CVNMSD(8)
  128. DHOOK(29)=CVNMSD(9)
  129. DHOOK(36)=CVNMSD(10)
  130. AM(1)= 1.D0
  131. AM(2)=-0.5D0
  132. AM(7)=-0.5D0
  133. AM(8)= 1.D0
  134. AM(15)=3.0D0
  135. W2(1)= 1.D0
  136. W2(2)= 1.D0
  137. GO TO 200
  138. 104 CONTINUE
  139. AM(15)=1.D0
  140. W2(3)=1.D0
  141. GO TO 200
  142. 105 CONTINUE
  143. AM(1)=0.5D0*(COVNMS(2)+COVNMS(3))
  144. AM(8)=0.5D0*(COVNMS(1)+COVNMS(3))
  145. AM(15)=0.5D0*(COVNMS(2)+COVNMS(1))
  146. AM(2)=-0.5D0*COVNMS(3)
  147. AM(3)=-0.5D0*COVNMS(2)
  148. AM(7)=-0.5D0*COVNMS(3)
  149. AM(9)=-0.5D0*COVNMS(1)
  150. AM(13)=-0.5D0*COVNMS(2)
  151. AM(14)=-0.5D0*COVNMS(1)
  152. AM(22)=-0.5D0*COVNMS(4)
  153. AM(29)=-0.5D0*COVNMS(5)
  154. AM(36)=-0.5D0*COVNMS(6)
  155. DO 10005 IB=1,3
  156. 10005 W2(IB)=1.D0
  157. GO TO 200
  158. 106 CONTINUE
  159. AM(1) =1.D0
  160. AM(8) =1.D0
  161. AM(15)=1.D0
  162. AM(2)=-0.5D0
  163. AM(3)=-0.5D0
  164. AM(7)=-0.5D0
  165. AM(9)=-0.5D0
  166. AM(13)=-0.5D0
  167. AM(14)=-0.5D0
  168. AM(22)=3.0D0
  169. W2(1)=1.D0
  170. W2(2)=1.D0
  171. W2(3)=1.D0
  172. GO TO 200
  173. 107 CONTINUE
  174. AM(1)=ALFAH
  175. AM(22)=1.D0
  176. W2(4)=1.D0
  177. GO TO 200
  178. 108 CONTINUE
  179. AM(1)=1.D0
  180. W2(1)=1.D0
  181. GO TO 200
  182. 109 CONTINUE
  183. *
  184. 200 CONTINUE
  185. TST=TEST*0.3333333333D0*(DHOOK(1)+DHOOK(8)+DHOOK(15))*COEPT
  186. TST10=TST*1.D1
  187. IF(IIMPI.EQ.15) WRITE(IOIMP,77883) TST,DHOOK(1),DHOOK(8),
  188. . DHOOK(15),TEST,COEPT
  189. 77883 FORMAT('0 PRJDRU - TST=',1PE12.5/2X,
  190. . 'DHOOK(1)=',1PE12.5,2X,'DHOOK(8)=',1PE12.5,2X,
  191. . 'DHOOK(15)=',1PE12.5/'0 TEST=',1PE12.5,2X,
  192. . 'COEPT=',1PE12.5/)
  193. *
  194. * INITIALISATIONS AVANT ITERATIONS
  195. *
  196. ITER =0
  197. EPSTA0 = EPSTAR/PEPSI
  198. EPST = EPSTA0
  199. SN = XMATKL+PENTE*EPSTA0
  200. * AM 24/5/93 TEST SUR SN
  201. IF(SN.LT.0.D0) THEN
  202. LESN0=1
  203. SN = 0.D0
  204. PENTF=0.D0
  205. ENDIF
  206. DEPS =0.D0
  207. DEPSI=0.D0
  208. CALL SHIFTD(STOT,SIGEL,6)
  209. CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI)
  210. SJ1=XINV(1)
  211. SJ2=XINV(2)
  212. IF(IIMPI.EQ.15) THEN
  213. WRITE(IOIMP,77993) (SIGEL(IJ),IJ=1,IBOU)
  214. 77993 FORMAT('0 PRJDRU SIGEL ' /(6(1X,1PE12.5)))
  215. WRITE(IOIMP,77994) SN,SI,SJ1,SJ2
  216. 77994 FORMAT('0 PRJDRU SN=',1PE12.5,2X,'SI=',1PE12.5,2X,
  217. . 'SJ1=',1PE12.5,2X,'SJ2=',1PE12.5)
  218. ENDIF
  219. *
  220. * -------------------------------
  221. * | LES ITERATIONS INTERNES |
  222. * -------------------------------
  223. 555 CONTINUE
  224. ITER=ITER+1
  225. IF(IIMPI.EQ.15) WRITE(IOIMP,77886) ITER
  226. 77886 FORMAT('0 >>>>>>>>>>> PRJDRU - ITER =',I4/)
  227. *
  228. * AM 24/5/93 TEST SUR SJ2
  229. IF(IIMPI.EQ.15) WRITE(IOIMP,71886) SJ2,TST10
  230. 71886 FORMAT('0 SJ2=',1PE12.5,2X,'TST10=',1PE12.5/)
  231. IF(SJ2.LT.TST10) GO TO 6
  232. *
  233. 1108 CONTINUE
  234. DO 1013 IM=1,IBOU
  235. 1013 DALPHA(IM) = SIGEL(IM)
  236. CALL MULMAT(W1,AM,SIGEL,6,1,6)
  237. IF(IIMPI.EQ.15) WRITE(IOIMP,72677) (W1(IJ),IJ=1,6)
  238. 72677 FORMAT(1X,' W1 '/(6(1X,1PE12.5)))
  239. ELTB=XMATD/SJ2
  240. ELT =XMATM/SJ2
  241. CALL AEQBPC(SIPLAD,W1,W2,ELTB,XMATC,6)
  242. IF(IIMPI.EQ.15) WRITE(IOIMP,73677) (SIPLAD(IJ),IJ=1,6)
  243. 73677 FORMAT(1X,' SIPLAD '/(6(1X,1PE12.5)))
  244. CALL AEQBPC(W1,W1,W2,ELT,XMATE,6)
  245. IF(IIMPI.EQ.15) WRITE(IOIMP,73674) (W1(IJ),IJ=1,6)
  246. 73674 FORMAT(1X,' W1 '/(6(1X,1PE12.5)))
  247. CALL MULMAT(DSIGP0,DHOOK,SIPLAD,6,1,6)
  248. IF(IIMPI.EQ.15) WRITE(IOIMP,73675) (DSIGP0(IJ),IJ=1,6)
  249. 73675 FORMAT(1X,' DSIGP0 '/(6(1X,1PE12.5)))
  250. ELT1=SDOT(IBOU,W1,1,DSIGP0,1)
  251. DEPSI=(SI-SN)/(ELT1+PENTF+1.E-20)
  252. DEPS = DEPS+DEPSI
  253. IF(IIMPI.EQ.15) WRITE(IOIMP,77888) DEPSI,DEPS
  254. 77888 FORMAT('0 PRJDRU - DEPSI=',1PE12.5,2X,'DEPS=',1PE12.5/)
  255. IF(DEPS.LT.0.D0) GO TO 5
  256. EPST = EPSTA0+DEPS
  257. IF(LESN0.EQ.0) SN=XMATKL+PENTE*EPST
  258. IF(IIMPI.EQ.15) WRITE(IOIMP,77812) XMATKL,PENTE,EPST,SN
  259. 77812 FORMAT('0 PRJDRU - XMATKL',1PE12.5,2X,'PENTE=',1PE12.5,
  260. . 2X,'EPST=',1PE12.5,2X,'SN=',1PE12.5/)
  261. *
  262. * AM 24/5/93 TEST SUR SN
  263. IF(SN.LT.0.D0) THEN
  264. SN=0.D0
  265. PENTF=0.D0
  266. LESN0=1
  267. * AM 12/8/93 ON REMBOBINE
  268. DEPS = DEPS-DEPSI
  269. ITER=ITER-1
  270. IF(IIMPI.EQ.15) WRITE(IOIMP,71108)
  271. 71108 FORMAT('0 ****** PRJDRU - ON REMBOBINE '/)
  272. GO TO 1108
  273. ENDIF
  274. DO 867 I=1,IBOU
  275. 867 EPSPLA(I)=EPSPLA(I)+SIPLAD(I)*DEPSI
  276. CALL AEQBPC(SIGEL,SIGEL,DSIGP0,1.D0,-DEPSI,6)
  277. *
  278. * PETITE MODIF 19/8/92
  279. *
  280. IF(MOD(ITER,5).EQ.0) THEN
  281. DO 1014 IM=1,IBOU
  282. 1014 SIGEL(IM)=(SIGEL(IM)+DALPHA(IM))*0.5D0
  283. ENDIF
  284. CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI)
  285. SJ1=XINV(1)
  286. SJ2=XINV(2)
  287. * AM 24/5/93
  288. * SI XMATE=0 PAS DE PB DE SOMMET
  289. * SINON, SI ON DEPASSE LE SOMMET, ON PROJETTE DESSUS
  290. *
  291. IF(XMATE.EQ.0.D0) GO TO 210
  292. XI1LIM=SN/XMATE
  293. IF(IIMPI.EQ.15) WRITE(IOIMP,77811) SJ1,SN,XI1LIM,SJ2
  294. 77811 FORMAT('0 PRJDRU - SJ1=',1PE12.5,2X,' SN =',1PE12.5,
  295. . 2X,'XI1LIM=',1PE12.5,2X,'SJ2=',1PE12.5/)
  296. IF(SJ1.GT.XI1LIM) GO TO 6
  297. 210 CONTINUE
  298. STST=ABS(SI-SN)
  299. *
  300. IF(IIMPI.EQ.15) THEN
  301. WRITE(IOIMP,77887) SI,SN,STST,TST,EPST
  302. 77887 FORMAT('0 PRJDRU - SI=',1PE12.5,2X,'SN=',1PE12.5,2X,
  303. . 'STST=',1PE12.5,2X,'TST=',1PE12.5/2X,'EPST=',1PE12.5)
  304. WRITE(IOIMP,77677) (SIGEL(IJ),IJ=1,IBOU)
  305. 77677 FORMAT(1X,'NOUVELLE SOLUTION'/(6(1X,1PE12.5)))
  306. WRITE(IOIMP,71677) (EPSPLA(IJ),IJ=1,IBOU)
  307. 71677 FORMAT(1X,'NOUVELLE DEF PLA'/(6(1X,1PE12.5)))
  308. ENDIF
  309. *
  310. IF(STST.LE.TST) GO TO 3
  311. IF(ITER.GT.ITMAX) GO TO 4
  312. GO TO 555
  313. *
  314. * PROJECTION AU SOMMET
  315. *
  316. 6 CONTINUE
  317. IF(IIMPI.EQ.15) WRITE(IOIMP,77387)
  318. 77387 FORMAT('0 PRJDRU - ON VA PROJETTER AU SOMMET ')
  319. CALL SOMDRU(IBOU,SI,DEPS,EPST,EPSTAR,SN,XMAT,YUNG,
  320. . XNU,PENTF,KERRE,ecou,necou)
  321. LAPOIN=1
  322. GO TO 33
  323. *
  324. 5 CONTINUE
  325. KERRE=1
  326. GO TO 34
  327. 4 CONTINUE
  328. KERRE=2
  329. 34 CONTINUE
  330. IF (JEBOUC.EQ.1) THEN
  331. IIMPI=15
  332. GO TO 2020
  333. ELSE
  334. IIMPI=IIMPI0
  335. ENDIF
  336. 3 CONTINUE
  337. IF(IIMPI.EQ.15) WRITE(IOIMP,66554) (EPSPLA(IB),IB=1,IBOU)
  338. 66554 FORMAT('0 SORTIE DE PRJDRU - EPSPLA ' /1X,6(1X,1PE12.5)/)
  339. IF(IIMPI.EQ.15) WRITE(IOIMP,61554) DEPS,EPST
  340. 61554 FORMAT('0 SORTIE DE PRJDRU - DEPS = ',1PE12.5,2X,'EPST=',
  341. . 1PE12.5)
  342. DEPS=DEPS*PEPSI
  343. EPST=EPST*PEPSI
  344. 33 CONTINUE
  345. IF(ITYP.EQ.2.OR.ITYP.EQ.3) CALL ZDANUL(DHOOK,36)
  346. IF(ITYP.EQ.2.OR.ITYP.EQ.3) CALL SHIFTD(CVNMSD,DHOOK,10)
  347. RETURN
  348. END
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  

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