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

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