Télécharger la plaquette Cast3M


fr en

Télécharger uo2xx.eso

Retour à la liste

Numérotation des lignes : 

uo2xx

  1. C UO2XX     SOURCE    STRU      07/07/12    21:15:06     5789
  2.       SUBROUTINE UO2XX(T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ,
  3.      &            XMAT,NCOMAT,NSIMP,AAD,GS,WRUPT,LEBIL,XINVL,PENTE,BTR,
  4.      &            YOUN,EPSPT,SIG0,EPSV0,VAR0,W,WMAX0,WREOU0,DX0,
  5.      &            SMAX,XLTR,NFISSU,NVF,VF,MC,MM,FC0,NGAT,NC1,NCA,NDIM,
  6.      &            NN,TAU,STOT,EPSVF,VARF,WF,DXF,WMAXF,WREOUF,
  7.      &            TF,FIF,MCA,XXMIN,JCRIT,NCRIT,LERED,KERRE)
  8. C----------------------------------------------------------------------
  9. C            ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE)
  10. C----------------------------------------------------------------------
  11. C
  12. C  ENTREES
  13. C  -------
  14. C T0/FI0       = TEMPERATURE/DENSITE DE FISSION AU DEB. DU SS PAS
  15. C TPOINT       = VITESSE DE TEMPERATURE SUR LE PAS D INTEGRATION
  16. C FPOINT       = VITESSE DE DENSITE DE FISSION SUR LE PAS D INTEGRATION
  17. C PRECIS       = PRECISION POUR LA CONVERGENCE DU SCHEMA NUMERIQUE
  18. C PRECIZ       = PRECISION POUR TESTS SUR CONTRAINTES
  19. C XMAT(NCOMAT) = CARACTERISTIQUES THERMOMECANIQUES DU MATERIAU
  20. C NSIMP        = POINTE SUR LA CARACTERISTIQUE FACULTATIVE 'SIMP' DE XMAT
  21. C AAD          = COEFFICIENT INTERVENANT DANS LE CALCUL DE L INCREMENT
  22. C                DE LA DEFORMATION DE DENSIFICATION
  23. C GS(3)        = RESISTANCES AU CISAILLEMENT
  24. C WRUPT(3)     = OUVERTURES CONDITIONNANT LA RUPTURE
  25. C LEBIL(NC)    = COMPRESSION/TRACTION
  26. C XINVL(3)     = PARAMETRES DE TAILLE
  27. C PENTE(NC)    = PENTES DES CRITERES
  28. C BTR/YOUN     = PARAMETRE DE FERMETURE/MODULE D YOUNG
  29. C EPSPT(6)     = VITESSE DES DEFORM. TOTALES SUR LE PAS D INTEGRATION
  30. C SIG0(6)      = CONTRAINTES         AU DEBUT DU SOUS PAS D INTEGRATION
  31. C EPSV0(6)     = DEFORM. VISCOPLAST. AU DEBUT DU SOUS PAS D'INTEGRATION
  32. C VAR0(NGAT)   = VAR. INT. SCAL. DE GATT_MONERIE    AU DEB. DU SS PAS
  33. C W(3)/WMAX0(3)= OUVERTURES/ MAXIMALES DES FISSURES AU DEB. DU SS PAS
  34. C WREOU0(3)    = LIMITES DE FERMETURE AU DEBUT DU SOUS PAS D'INTEGRATION
  35. C DX0(NC)      = DEF. DE FISSURATION (OUV.) AU DEB. DU SS PAS
  36. C SMAX(3)      = CONTR. CORRESPONDANT A WMAX0
  37. C XLTR(3)      = LIMITES EN TRACTION POUR LA FISSURATION
  38. C NFISSU       = NOMBRE DE FISSURES
  39. C NVF          = NBR DE DIRECTIONS IMPOSEES POUVANT DEVENIR
  40. C                DES DIRECTIONS DE FISSURATION
  41. C MM(20)/MC    = TYPES/NBR DE CRIT DE FISS SUSCEPTIBLES D ETRE ATTEINTS
  42. C FC0(20)      = CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS
  43. C NC1          = NC+1 AVEC NC(=3) NBR. TOTAL DE DIRECTIONS DE FISS.
  44. C NDIM         = NCA+1 SI CP, NCA SINON
  45. C NN(NC)       = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
  46. C TAU          = UN NOUVEAU CRIT EST-IL VIOLE POUR LES RESULTATS A TAU
  47. C STOT(6)      = CONTRAINTES A LA FIN DU SOUS PAS D INTEGRATION
  48. C EPSVF(6)     = DEFORM. VISCOPLAST. A LA FIN DU SOUS PAS D'INTEGRATION
  49. C VARF(NGAT)   = VAR. INT. SCAL. DE GATT_MONERIE     A LA FIN DU SS PAS
  50. C WF(3)/WMAXF(3)= OUVERTURES/ MAXIMALES DES FISSURES A LA FIN DU SS PAS
  51. C
  52. C  SORTIES
  53. C  -------
  54. C VF(3,3)      = VECTEURS DES DIRECTIONS DE FISSURATION
  55. C STOT(6)      = CONTRAINTES A LA FIN DU NOUVEAU SOUS PAS D INTEGRATION
  56. C                (LE CAS ECHEANT)/ UN DES NOUVEAUX CRITERES SOIT NUL
  57. C EPSVF(6)     = DEFORM. VISCOPLAST.        A LA FIN DU NOUVEAU SS PAS
  58. C VARF(NGAT)   = VAR. INT. SCAL.            A LA FIN DU NOUVEAU SS PAS
  59. C WF(3)/WMAXF(3)= OUV./ MAXIMALES DES FISS. A LA FIN DU NOUVEAU SS PAS
  60. C TF/FIF       = TEMPER./DENSITE DE FISSION A LA FIN DU NOUVEAU SS PAS
  61. C MCA          = NBR. DE CRIT. VIOLES AVEC STOT EN ENTREE PARMI LES
  62. C                NOUVEAUX CRITERES SUSCEPTIBLES D ETRE ATTEINTS
  63. C XXMIN        = UN DES NOUVEAUX CRIT. EST ATTEINT POUR XXMIN*TAU
  64. C JCRIT(20)    = TYPE DES NOUVELLES NON LINEARITES RENCONTREES
  65. C                POUR LA FISSURATION
  66. C NCRIT        = NOMBRE DE NOUVELLES NON LINEARITES (FISSURATION)
  67. C LERED        = 1 NOUVEAUX CRIT. INCOMPATIBLES POUR SIG0 ET STOT INITIAL
  68. C                0 OK
  69. C KERRE        = GESTION DES ERREURS
  70. C----------------------------------------------------------------------
  71. C
  72.       IMPLICIT INTEGER(I-N)
  73.       IMPLICIT REAL*8(A-H,O-Z)
  74.  
  75. -INC PPARAM
  76. -INC CCOPTIO
  77. C
  78.       DIMENSION EPSPT(*),SIG0(*),EPSV0(*),VAR0(*),DX0(*)
  79.       DIMENSION W(*),WMAX0(*),WREOU0(*),SMAX(*),XLTR(*)
  80.       DIMENSION MM(*),NN(*)
  81.       DIMENSION FC0(*)
  82.       DIMENSION STOT(*),VF(3,*),EPSVF(*),VARF(*),DXF(*)
  83.       DIMENSION WF(*),WMAXF(*),WREOUF(*),JCRIT(*)
  84.       DIMENSION XMAT(*),GS(*),WRUPT(*)
  85.       DIMENSION LEBIL(*),XINVL(*),PENTE(*)
  86. C
  87.       DIMENSION DSIGT(6),DXVV(3),XXF(3)
  88.       DIMENSION JFIS(3),JFIS2(3)
  89.       DIMENSION JCDUM(1)
  90.       DIMENSION FC2(20),FCT(20),MMA(20)
  91. C
  92.       DATA ITMAX/350/
  93. C
  94. C     INITIALISATIONS
  95. C
  96.       KERRE=0
  97.       LERED=0
  98.       XXFIS=1.D4
  99.       XXMIN=1.D0
  100.       NCRIT=0
  101.       IFLAG0=0
  102.       CALL IANUL(JCRIT,20)
  103. C
  104.       CALL ZDANUL(DXVV,3)
  105.       IF (NCA.NE.0) THEN
  106.         DO IJ=1,NCA
  107.            JJ=NN(IJ)
  108.            DXVV(JJ)=DXF(JJ)-DX0(JJ)
  109.         ENDDO
  110.       ENDIF
  111. C
  112.       DO I=1,6
  113.         DSIGT(I)= STOT(I)-SIG0(I)
  114.       ENDDO
  115. C
  116. C
  117. C  Viole-t-on un nouveau crit. avec contr. a la fin du ss. pas ?
  118. C
  119.       CALL UO2CE(MC,MM,STOT,DXVV,W,WMAXF,SMAX,WRUPT,XLTR,XINVL,
  120.      &       BTR,NFISSU,NVF,FCT,VF,YOUN,PRECIZ,JFIS,KERRE)
  121.       IF(KERRE.NE.0) RETURN
  122. C
  123. C
  124.       MCA=0
  125.       DO IC=1,MC
  126.          JC=MM(IC)
  127. C
  128.          IF(IIMPI.EQ.42) THEN
  129.            WRITE(IOIMP,30446) IC,JC,FCT(JC)
  130. 30446      FORMAT(/2X,' UO2XX - IC=',I4,2X,' JC=',I4,2X,
  131.      &                ' FCT(JC)=',1PE12.5/)
  132.          ENDIF
  133. C
  134.          IF(FCT(JC).GT.0.D0)THEN
  135.            MCA=MCA+1
  136.            MMA(MCA)=JC
  137.          ELSE IF(ABS(FCT(JC)).LE.PRECIZ)THEN
  138.            MCA=MCA+1
  139.            MMA(MCA)=JC
  140.            IF(FCT(JC).LT.0.D0) FCT(JC)=0.D0
  141.          ENDIF
  142.       ENDDO
  143. C
  144. C
  145.       IF(IIMPI.EQ.42) THEN
  146.           WRITE(IOIMP,50446) MCA
  147. 50446     FORMAT(/2X,' DANS UO2XX - MCA =',I4/)
  148.           WRITE(IOIMP,40446) (MMA(I),I=1,MCA)
  149. 40446     FORMAT(/2X,' UO2XX - MMA =',5I4/)
  150.       ENDIF
  151. C
  152. C
  153.       IF(MCA.NE.0) THEN
  154. C
  155. C     FAUT-IL APPELER OTTOXF ?
  156. C
  157.          LAPPEL=0
  158.          DO IC=1,MCA
  159.             JC=MMA(IC)
  160. C
  161.             IF(JC.GE.1.AND.JC.LE.3) THEN
  162. C
  163.               IF(FC0(JC).GT.0.D0.AND.FC0(JC).LT.PRECIZ) THEN
  164.                  XXMIN=0.D0
  165.                  JCRIT(1)=JC
  166.                  NCRIT=1
  167.                  GO TO 300
  168.               ENDIF
  169.               IF(JFIS(JC).GT.1) LAPPEL=1
  170. C
  171.             ENDIF
  172.          ENDDO
  173. C
  174. C
  175.          DO IC=1,MCA
  176.             JC=MMA(IC)
  177.             IF(FC0(JC)*FCT(JC).GT.0.D0) THEN
  178.               IF(IIMPI.EQ.42) THEN
  179.                 PRINT *,'##### UO2XX CRITERES INCOMPATIBLES JC = ',JC
  180.                 PRINT *,' FC0 = ',FC0(JC), ' FCT = ', FCT(JC)
  181.               ENDIF
  182.               LERED=1
  183.               RETURN
  184.             ENDIF
  185.          ENDDO
  186. C
  187. C    APPEL A OTTOXF
  188. C
  189.          IF(LAPPEL.EQ.1) THEN
  190.             CALL OTTOXF(SIG0,DSIGT,XINVL,XLTR,
  191.      &                  NFISSU,NVF,XXF,PRECIZ,KERRE)
  192.             IF(KERRE.NE.0) RETURN
  193. C
  194.             IF(IIMPI.EQ.42) THEN
  195.                WRITE(IOIMP,44556) (XXF(I),I=1,3)
  196. 44556          FORMAT(/2X,' APRES OTTOXF : XXF ',3(1X,1PE12.5)/)
  197.             ENDIF
  198. C
  199. C
  200.             IF(XXF(2).EQ.1.D4.AND.XXF(3).EQ.1.D4) THEN
  201.               LAPPEL=0
  202.               GO TO 50
  203.             ENDIF
  204. C
  205. C
  206.             IF(JFIS(2).GT.1) THEN
  207.               I1=1
  208.               IF(JFIS(2).EQ.2) I1=2
  209.               DO I=I1,3
  210.                 IF(XXF(I).GT.0.D0) THEN
  211.                    XXFIS=XXF(I)
  212.                    GO TO 50
  213.                 ENDIF
  214.               ENDDO
  215.               IF(IIMPI.EQ.42) THEN
  216.                 WRITE(IOIMP,77453)
  217. 77453           FORMAT(2X,'####  UO2XX - PAS DE RACINE POSITIVE  ####'/)
  218.               ENDIF
  219. C****             KERRE=70
  220. C****             RETURN
  221. C  ON SE DONNE UNE DERNIERE CHANCE
  222. C
  223.               LAPPEL=0
  224.             ENDIF
  225. C
  226.   50        CONTINUE
  227.          ENDIF
  228. C
  229. C
  230.          DO IC=1,MCA
  231.             JC=MMA(IC)
  232.             F1=FC0(JC)
  233.             F2=FCT(JC)
  234.             IF(IIMPI.EQ.42) THEN
  235.                PRINT *,' IC=',IC
  236.                PRINT *,' JC=',JC
  237.                PRINT *,' FC0=',FC0(JC)
  238.                PRINT *,' FCT=',FCT(JC)
  239.             ENDIF
  240. C
  241.             XXDEP=0.D0
  242. C
  243.             XX1=XXDEP
  244.             XX2=1.D0
  245.             XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  246. C
  247.             IF(IIMPI.EQ.42) THEN
  248.                PRINT *,' UO2XX - ESTIMATION SECANTE  XX = ',XX
  249.                PRINT *,'JC=',JC,'  JFIS(JC)=',JFIS(JC)
  250.             ENDIF
  251. C
  252. C
  253.             IF(JC.GE.1.AND.JC.LE.3.AND.LAPPEL.EQ.1) THEN
  254.                IF(JFIS(JC).GE.2) THEN
  255. C
  256.                  IF(IIMPI.EQ.42) THEN
  257.                     PRINT *,'VALEUR CALCULEE XX = ',XXFIS
  258.                  ENDIF
  259. C
  260. C
  261.                  IF(XX.LE.1.D0.AND.XXFIS.LE.1.D0) THEN
  262.                     XX=XXFIS
  263.                     GO TO 75
  264.                  ELSE
  265.                     LAPPEL=0
  266.                  ENDIF
  267. C
  268.                ENDIF
  269.             ENDIF
  270. C
  271. C
  272.             IF(IIMPI.EQ.42) THEN
  273.                PRINT *,'PREMIERE ESTIMATION XX  = ',XX
  274.             ENDIF
  275. C
  276. C
  277. C       ITERATIONS
  278. C
  279.   75        CONTINUE
  280.             ITER=0
  281. C
  282.   100       CONTINUE
  283.             ITER=ITER+1
  284. C
  285.             IF(ITER.GT.ITMAX) THEN
  286.               PRINT *,' UO2XX - NBR D ITERATIONS ',ITMAX
  287.               KERRE=1
  288.               RETURN
  289.             ENDIF
  290. C
  291.             TAUESS=XX*TAU
  292. C
  293.             CALL UO2DCN(IFLAG0,T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ,XMAT,
  294.      &                  NCOMAT,NSIMP,AAD,BTR,GS,WRUPT,LEBIL,XINVL,PENTE,
  295.      &                  EPSPT,SIG0,EPSV0,VAR0,W,WMAX0,WREOU0,DX0,
  296.      &                  NGAT,NC1,NCA,NDIM,NN,TAUESS,TAUNEX,STOT,EPSVF,
  297.      &                  VARF,WF,DXF,WMAXF,WREOUF,TF,FIF,KERRE)
  298. C
  299.             CALL ZDANUL(DXVV,3)
  300.             IF (NCA.NE.0) THEN
  301.               DO IJ=1,NCA
  302.                  JJ=NN(IJ)
  303.                  DXVV(JJ)=DXF(JJ)-DX0(JJ)
  304.               ENDDO
  305.             ENDIF
  306. C
  307. C
  308.             JCDUM(1)=JC
  309.             CALL UO2CE(1,JCDUM,STOT,DXVV,W,WMAXF,SMAX,WRUPT,XLTR,XINVL,
  310.      &                 BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,JFIS2,KERRE)
  311.             IF(KERRE.NE.0) RETURN
  312. C
  313.             FF=FC2(JC)
  314.             IF(ABS(FF).LT.PRECIZ) GO TO 200
  315. C
  316.             IF(IIMPI.EQ.42) THEN
  317.                ZOB1 = F1
  318.                ZOB2 = F2
  319.             ENDIF
  320. C
  321.             IF(FF*F2.GE.0.D0) THEN
  322.                XX2=XX
  323.                F2=FF
  324.             ELSE
  325.                XX1=XX
  326.                F1=FF
  327.             ENDIF
  328. C
  329.             XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  330. C
  331.             IF(IIMPI.EQ.42) THEN
  332.               WRITE(IOIMP,75461) ITER,ZOB1,ZOB2,XX
  333. 75461         FORMAT( 2X, 'I=',I3,2X,'F1=',1PE12.5,2X,
  334.      &              'F2=',1PE12.5,2X,'XX=',1PE12.5)
  335.             ENDIF
  336. C
  337.             GO TO 100
  338. C
  339.   200       CONTINUE
  340. C
  341.             IF(XX.LT.XXMIN) THEN
  342.               XXMIN=XX
  343.             ENDIF
  344. C
  345.          ENDDO
  346. C
  347. C
  348. C
  349.       IF(IIMPI.EQ.42) THEN
  350.          WRITE(IOIMP,73361) XXMIN
  351. 73361    FORMAT( 2X, ' UO2XX APRES BOUCLE - XXMIN= ',1PE12.5/)
  352.       ENDIF
  353. C
  354. C
  355. C  Maj et recherche des directions / on est pile sur un nouveau crit.
  356. C
  357.          TAUESS=XXMIN*TAU
  358. C
  359.          CALL UO2DCN(IFLAG0,T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ,XMAT,
  360.      &               NCOMAT,NSIMP,AAD,BTR,GS,WRUPT,LEBIL,XINVL,PENTE,
  361.      &               EPSPT,SIG0,EPSV0,VAR0,W,WMAX0,WREOU0,DX0,
  362.      &               NGAT,NC1,NCA,NDIM,NN,TAUESS,TAUNEX,STOT,EPSVF,
  363.      &               VARF,WF,DXF,WMAXF,WREOUF,TF,FIF,KERRE)
  364. C
  365.          CALL ZDANUL(DXVV,3)
  366.          IF (NCA.NE.0) THEN
  367.            DO IJ=1,NCA
  368.               JJ=NN(IJ)
  369.              DXVV(JJ)=DXF(JJ)-DX0(JJ)
  370.            ENDDO
  371.          ENDIF
  372. C
  373.          CALL UO2CE(MCA,MMA,STOT,DXVV,W,WMAXF,SMAX,WRUPT,XLTR,XINVL,
  374.      &              BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,JFIS2,KERRE)
  375.          IF(KERRE.NE.0) RETURN
  376. C
  377. C
  378.          DO IC=1,MCA
  379.             JC=MMA(IC)
  380. C
  381. C           Test supplementaire
  382. C
  383.             IF(FC2(JC).GT.PRECIZ) THEN
  384.               PRINT *,'######### UO2XX CRITERE INCOHERENT JC = ',JC
  385.               PRINT *,' FC2 = ',FC2(JC), ' PRECIZ=',PRECIZ
  386.               KERRE=2
  387.               RETURN
  388.             ENDIF
  389. C
  390.             IF(ABS(FC2(JC)).LT.PRECIZ) THEN
  391.               NCRIT=NCRIT+1
  392.               JCRIT(NCRIT)=JC
  393.             ENDIF
  394.          ENDDO
  395. C
  396.   300    CONTINUE
  397. C
  398.       ENDIF
  399. C
  400. C
  401.       IF(IIMPI.EQ.42) THEN
  402.          WRITE(IOIMP,77000) NCRIT,(JCRIT(I),I=1,NCRIT)
  403. 77000    FORMAT( 2X, ' UO2XX - NCRIT =',I3,4X,'JCRIT = ',15I3/)
  404.          WRITE(IOIMP,77001) XXMIN
  405. 77001    FORMAT( 2X, ' UO2XX - XXMIN= ',1PE12.5/)
  406.       ENDIF
  407. C
  408.       RETURN
  409.       END
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  

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