Télécharger la plaquette Cast3M


fr en

Télécharger uo2xx2.eso

Retour à la liste

Numérotation des lignes : 

uo2xx2

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

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