C OTTOVE SOURCE CHAT 05/01/13 02:07:58 5004 SUBROUTINE OTTOVE(NCRIT,JCRIT,SIGMA,W,WMAX,WRUPT,SMAX, & BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA, & NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING, & XCOMP,XLAMC,KERRE) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO C PARAMETER (XZER=0.D0) PARAMETER (UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0) C DIMENSION SIGMA(*),W(*),WMAX(*),BILIN(*), & WRUPT(*),XLTR(*),XINVL(*),SBILI(*) DIMENSION PENTE(*),PENTE2(*),XCOMP(*) DIMENSION FC(*),FC2(*),NN(*),LEBIL(*),SMAX(*) DIMENSION DEFPLA(*),ISING(*) DIMENSION JCRIT(*) DIMENSION ZOB(3) * KERRE=0 * * DO I=1,3 IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN IF(W(I).EQ.WMAX(I)) THEN W(I)=WRUPT(I) ENDIF WMAX(I)=WRUPT(I) SMAX(I)=0.D0 ENDIF ENDDO * * PURGE * DO I=1,6 IF(ABS(DEFPLA(I)).LT.PRECIE*1.D-2) DEFPLA(I)=0.D0 ENDDO * * DO IC=1,NCRIT JC=JCRIT(IC) * * CAS DE REOUVERTURE * IF(JC.GE.10.AND.JC.LE.12) THEN KC=JC-9 SIGMA(KC)=0.D0 W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC)) * * CAS DE REFERMETURE * ELSE IF(JC.GE.13.AND.JC.LE.15) THEN KC=JC-12 SIGMA(KC)=0.D0 W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC)) * * CAS DE RUPTURE * ELSE IF(JC.GE.7.AND.JC.LE.9) THEN KC=JC-6 SIGMA(KC)=0.D0 W(KC)=WRUPT(KC) WMAX(KC)=WRUPT(KC) SMAX(KC)=0.D0 * * CAS DE FISSURATION * ELSE IF(JC.GE.1.AND.JC.LE.3) THEN IF(ISING(JC).EQ.2) THEN SIGMA(JC)=SMAX(JC) W(JC)=WMAX(JC) ENDIF * * CAS DE POURSUITE DE LA FISSURATION * ELSE IF(JC.GE.4.AND.JC.LE.6) THEN KC=JC-3 SIGMA(KC)=SMAX(KC) W(KC)=WMAX(KC) ENDIF ENDDO * * DO IC=1,NCA JC=NN(IC) * * FISSURATION AVEC ISING=2 * IF((JC.GE.1.AND.JC.LE.3).AND.ISING(JC).EQ.2) THEN SIGMA(JC)=SMAX(JC) W(JC)=WMAX(JC) ENDIF ENDDO * * DO IC=1,NC NN(IC)=IC ENDDO * CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, & XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING, & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) IF(KERRE.NE.0) THEN PRINT *, ' OTTOVE - APRES OTTOEC KERRE=',KERRE RETURN ENDIF * DO IC=1,NC IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN PRINT *,'CRITERE DEPASSE NUMERO ',IC PRINT *,'CRITERE FC = ',FC(IC) PRINT *,'CRITERE FC2 = ',FC2(IC) KERRE=2 RETURN ENDIF ENDDO * IF(IIMPI.EQ.42) THEN WRITE(IOIMP,78000) (FC(IC),IC=1,NC) 78000 FORMAT( 2X, ' OTTOVE - FC '/(4(1X,1PE12.5)/)/) ENDIF * RETURN END