Télécharger calpec.eso

Retour à la liste

Numérotation des lignes :

calpec
  1. C CALPEC SOURCE CB215821 16/04/21 21:15:30 8920
  2. SUBROUTINE CALPEC(IFOU,STRN,SIGR,SIGM,S1,DEP,NSTRS,SEQC,
  3. 1 EBC,EPEQC,EPSR,STRNR,JFRIS,IPLA,EPEQ0,SEQ0,XE,NBNN,MELE,EQSTR1,
  4. 2 EPSEQ1,AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12)
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. DIMENSION STRNR(6),EPSR(6),SIGR(6),S(6)
  9. DIMENSION S1(NSTRS),DFSI(6),STRN(NSTRS),DGSI(6)
  10. DIMENSION DEP(NSTRS,NSTRS),D6(6,6),DP(6,6),S11(6)
  11. DIMENSION SIGM(NSTRS),V1(4),SS(100,6),CR(100,3)
  12. DIMENSION SI0(6),ST0(6),DST(6),DSI(6),XE(3,NBNN)
  13. C
  14. SEGMENT WRK12
  15. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  16. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  17. real*8 bbet18,bbet19,bbet20,sct,teta,DTR1,dtr2,bbet25
  18. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  19. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  20. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  21. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  22. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  23. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  24. ENDSEGMENT
  25.  
  26. * COMMON /CINSA/ POUI(20),SCT,TETA,DTR1,DTR2,POUJ(31),IPOU(16)
  27. C-------------------------------------------------------------------
  28. CALL ZERO(S1,NSTRS,1)
  29. CALL ZERO(DEP,NSTRS,NSTRS)
  30. C
  31. TU=RB
  32. PRB=1.D-5
  33. NIB=2
  34. ICHOI=1
  35. IPREM=0
  36. C-------------------------------------------------------------------
  37. SCT =0.D0
  38. DTR1=0.D0
  39. DTR2=0.D0
  40. TETA=0.D0
  41. C-------------------------------------------------------------------
  42. BETC=EBC/EX
  43. PAEC0=EBC/(1.D0-BETC)
  44. CALL CRIOTO(SIGR,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  45. IF(SEQ.LT.1.D-10) IPREM=1
  46. IF(SEQ.GT.TU) SEQ=TU
  47. C-------------------------------------------------------------------
  48. DO 10 I=1,NSTRS
  49. S11(I)=SIGR(I)+SIGM(I)
  50. IF(IPREM.EQ.0) THEN
  51. S1(I)=SIGR(I)
  52. ELSE
  53. S1(I)=S11(I)
  54. ENDIF
  55. 10 CONTINUE
  56. C-------------------------------------------------------------------
  57. IF(EPSEQ1.GE.EPO) THEN
  58. C -------------------------------------------------------------
  59. C * ON AVAIT DEJA DEPASSE LE PIC EN DEFORMATION EQUIVALENTE *
  60. C -------------------------------------------------------------
  61. CALL PRINC(SIGR,V1,NSTRS)
  62. IF(V1(1).GE.0.D0) THEN
  63. DTR1=V1(1)
  64. DTR2=FPT
  65. IF(DTR1.LT.0.D0) DTR1=0.D0
  66. IF(DTR1.GE.FPT) DTR1=FPT
  67. IF(DTR1.LT.1.D-8) DTR1=0.D0
  68. TETA=V1(4)
  69. DO 21 I=1,NSTRS
  70. SI0(I)=SIGR(I)
  71. ST0(I)=EPSR(I)
  72. DSI(I)=SIGM(I)
  73. DST(I)=STRN(I)
  74. 21 CONTINUE
  75. JFRIS=2
  76. IPLA=0
  77. CALL FISPLA(ST0,DST,STRNR,SI0,DSI,S1,NSTRS,IFOU,0,XE,
  78. 1 NBNN,MELE,wrk12)
  79. GOTO 200
  80. ENDIF
  81. ENDIF
  82. C-------------------------------------------------------------------
  83. IF(IPREM.EQ.1) THEN
  84. IF(NIB.EQ.1) NIB = 10
  85. CALL CRIOTO(S1,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  86. ENDIF
  87. C-------------------------------------------------------------------
  88. IF(IPREM.EQ.0.AND.SEQ.GT.TU) SEQ=TU
  89. SEQ0=SEQ
  90. IF(SEQ0.LT.1.D-8.AND.SEQC.LT.1.D-8) THEN
  91. CALL ZERO(S1,NSTRS,1)
  92. GOTO 200
  93. ENDIF
  94. IF(SEQ0.LT.1.D-8.AND.SEQC.GT.1.D-8) THEN
  95. SEQ=SEQC
  96. ENDIF
  97. C-------------------------------------------------------------------
  98. CALL ZERO(CR,100,3)
  99. CALL ZERO(SS,100,6)
  100. C-------------------------------------------------------------------
  101. DO 1 II=1,NIB
  102. C-------------------------------------------------------------------
  103. SEQ1=SEQ
  104. IF(SEQ1.GT.TU) SEQ1=TU
  105. IF(SEQ.LT.1.D-8) THEN
  106. IPLA=4
  107. GOTO 300
  108. ENDIF
  109. C-------------------------------------------------------------------
  110. C **************************************
  111. C * BOUCLE SUR LES ITERATIONS INTERNES *
  112. C **************************************
  113. C-------------------------------------------------------------------
  114. CALL DFSIG(S1,DFSI,DGSI,SEQ1,NSTRS,RB,AA,BB,DK1,DK2,ILOI)
  115. H2=0.D0
  116. DO 92 I=1,NSTRS
  117. H2=H2+DFSI(I)*DGSI(I)
  118. 92 CONTINUE
  119. PAEC=PAEC0*H2
  120. C-------------------------------------------------------------------
  121. CALL DEPO(S1,DEP,PAEC,SEQ1,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  122. & DK1,DK2,RB,ILOI)
  123. CALL BST(DEP,STRN,NSTRS,NSTRS,S)
  124. DO 45 I=1,NSTRS
  125. S1(I)=SIGR(I)+S(I)
  126. 45 CONTINUE
  127. CALL CRIOTO(S1,SEQ,FCRI,NSTRS,SEQ1,AA,BB,DK1,DK2)
  128. IF(SEQ.GT.SEQ0.AND.EPEQ0.GT.(1.1D0*EPO)) THEN
  129. IPLA=4
  130. GOTO 300
  131. ENDIF
  132. C---------------------------------------------------------------------
  133. IF(ABS(FCRI).LT.PRB) GOTO 7
  134. DO 4 J=1,NSTRS
  135. SS(II,J)=S1(J)
  136. 4 CONTINUE
  137. CR(II,1)=FCRI
  138. CR(II,2)=SEQ
  139. CR(II,3)=PAEC
  140. C-------------------------------------------------------------------
  141. C ************************************************
  142. C * FIN DE LA BOUCLE SUR LES ITERATIONS INTERNES *
  143. C ************************************************
  144. 1 CONTINUE
  145. c+mdj
  146. C GOTO 7
  147. c+mdj
  148. C--------------------------------------------------------------------------
  149. DMMN1=ABS(CR(1,1))
  150. NO=1
  151. DO 5 J=1,NIB
  152. ACR=ABS(CR(J,1))
  153. IF(DMMN1 .GE. ACR) THEN
  154. DMMN1=ABS(CR(J,1))
  155. NO=J
  156. ENDIF
  157. 5 CONTINUE
  158. DO 6 J=1,NSTRS
  159. S1(J)=SS(NO,J)
  160. 6 CONTINUE
  161. SEQ=CR(NO,2)
  162. PAEC=CR(NO,3)
  163. 7 CONTINUE
  164. C----------------------------------------------------------------------
  165. IF(SEQ.GT.TU) SEQ=TU
  166. CALL DEPO(S1,DEP,PAEC,SEQ,NSTRS,IFOU,D6,DP,EX,PXY,AA,BB,
  167. 1 DK1,DK2,RB,ILOI)
  168. C-------------------------------------------------------------------
  169. IF(SEQ.GT.EQSTR1) THEN
  170. C -------------------------------------
  171. DO I=1,NSTRS
  172. DSI(I)=S1(I)-SIGR(I)
  173. END DO
  174. CALL SCALT(DSI,SIGR,SI0,V1,SCT,NSTRS,DTAU,EQSTR1,AA,BB,DK1,
  175. & DK2,ALPHA,RB,DTR1,DTR2,TETA)
  176. C -------------------------------------
  177. IF(V1(1).GE.0.D0) THEN
  178. DTR1=V1(1)
  179. DTR2=FPT
  180. TETA=V1(4)
  181. IF(DTR1.LT.0.D0) DTR1=0.D0
  182. IF(DTR1.GE.FPT) DTR1=FPT
  183. IF(DTR1.LT.1.D-8) DTR1=0.D0
  184. JFRIS=2
  185. IPLA=0
  186. CALL FISPLA(EPSR,STRN,STRNR,SIGR,DSI,S1,NSTRS,IFOU,0,XE,
  187. 1 NBNN,MELE,wrk12)
  188. GOTO 200
  189. ENDIF
  190. C -------------------------------------
  191. DTR1=0.D0
  192. DTR1=0.D0
  193. DTR1=0.D0
  194. TETA=0.D0
  195. SCT =0.D0
  196. IPLA=4
  197. C -------------------------------------
  198. ENDIF
  199. C-------------------------------------------------------------------
  200. 300 CONTINUE
  201. IF(IPLA.EQ.4) THEN
  202. CALL ZERO(DEP,NSTRS,NSTRS)
  203. CALL ZERO(S1,NSTRS,1)
  204. EPSEQ1=EPEQC
  205. EQSTR1=0.D0
  206. ENDIF
  207. C-------------------------------------------------------------------
  208. 200 CONTINUE
  209. C---------------------------------------------------------------------
  210. 1991 FORMAT(18(1X,E12.5))
  211. RETURN
  212. END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  

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