Télécharger la plaquette Cast3M


fr en

Télécharger fatig.eso

Retour à la liste

Numérotation des lignes : 

fatig

  1. C FATIG     SOURCE    JK148537  24/10/29    21:15:06     12056          
  2.       SUBROUTINE FATIG
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C==================================
  6. C CHE3 = 'FATI' MO1 CHAR1 |
  7. C                         |CHE2 (REEL1 REEL2 MOT4 'SEUIL' |MOT5 );
  8. C                         |                               |REEL3
  9. C      = 'FATI' MO1 MO2 CHE4  |
  10. C===================================
  11.       PARAMETER (NCLE=7,NOPT=2)
  12.  
  13. -INC PPARAM
  14. -INC CCREEL
  15. -INC CCOPTIO
  16. -INC SMCHARG
  17.       LOGICAL L0,L1
  18.       CHARACTER*4 CLE(NCLE),OPTSEU(NOPT)
  19.       DATA CLE/'TOUS','DVKP','PAPA','SINE','CROS','DC','VMIS'/
  20.       DATA OPTSEU/'SEUI','TOUS'/
  21.       DATA zc/-2.d-1/
  22.  
  23.       CALL LIROBJ('MMODEL  ',IPMODE,1,irt1)
  24.       CALL ACTOBJ('MMODEL  ',IPMODE,1)
  25.       IF (IERR.NE.0) RETURN
  26.       IF (IRt1.EQ.0) GOTO 100
  27.  
  28.       CALL LIROBJ('CHARGEME',ICHAR,0,IRETOU)
  29.       IF(IERR.NE.0) RETURN
  30.       IF(IRETOU.EQ.0) THEN
  31.         CALL LIROBJ('MMODEL  ',IPMOD1,1,irt2)
  32.         CALL ACTOBJ('MMODEL  ',IPMOD1,1)
  33.         IF (IERR.NE.0) RETURN
  34.         IF (IRt2.EQ.0) GOTO 100
  35.         CALL LIROBJ('MCHAML  ',IPCS1,1,IRT3)
  36.         if (ierr.ne.0) return
  37.         IF (IRt3.EQ.0) GOTO 100
  38.         itcont = ipcs1
  39.       ELSE
  40.        MCHARG = ichar
  41.        segact mcharg
  42.        if (kcharg(/1).ne.1) then
  43.         call erreur(512)
  44.         return
  45.        endif
  46.        icharg = kcharg(1) 
  47.        segact icharg
  48.         ittemp = ichpo1
  49.         itcont = ichpo2          
  50.       ENDIF
  51.  
  52.  
  53. * caracteristiques critere
  54.       CALL LIROBJ('MCHAML  ',IP1,0,IRETOU)
  55.           if (ierr.ne.0) return
  56.       CALL LIRREE(XRE1,0,iret)
  57.        if(iret.eq.0) xre1 = 0.D0
  58.       CALL LIRREE(XRE2,0,iret)
  59.        if(iret.eq.0) xre2 = 0.D0
  60.  
  61.  
  62.           CALL LIRMOT(CLE,NCLE,ICLE,0)
  63.           if(icle.eq.0) icle = 1
  64.           if (ierr.ne.0) return
  65.         IF (icle.ge.2.or.icle.le.6) THEN
  66.           CALL LIRMOT(OPTSEU,NOPT,IOP1,0)
  67.           if(iop1.eq.1) then
  68.             CALL LIRMOT(OPTSEU,NOPT,IOP2,0)
  69.             if (iop2.eq.0) then
  70.               CALL LIRREE(zecrit,1,iret)
  71.               if (iret.eq.0) then
  72.                 return
  73.               endif
  74.             elseif (iop2.eq.2) then
  75.                zecrit = XPETIT
  76.             endif
  77.           else
  78.             zecrit = zc
  79.           endif
  80.         ENDIF
  81.           if (ierr.ne.0) return
  82.  
  83. *      write(6,*)'sr',ierr,ITCONT,ITTEMP,IPMODE,IP1,xre1,xre2,ICLE
  84.  
  85.       call FATIG2(ITCONT,ITTEMP,IPMODE,IPMOD1,IP1,xre1,xre2,ICLE,NCLE,
  86.      &CLE,zecrit,ICHOUT)
  87.       if(ierr.ne.0) return
  88.  
  89.             CALL ECROBJ( 'MCHAML  ',ICHOUT )
  90.  
  91.       RETURN
  92.  100  CONTINUE
  93.       call erreur(21)
  94.       END
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

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