Télécharger la plaquette Cast3M


fr en

Télécharger fatig.eso

Retour à la liste

Numérotation des lignes : 

  1. C FATIG     SOURCE    KICH      19/10/25    21:15:11     10351          
  2.       SUBROUTINE FATIG
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C==================================
  6. C     CH2 = FATI TAB1 CH1 MOT1 ;
  7. C===================================
  8.       PARAMETER (NCLE=7)
  9. -INC CCOPTIO
  10. -INC SMCHARG
  11.       LOGICAL L0,L1
  12.       CHARACTER*4 CLE(NCLE)
  13.       DATA CLE/'TOUS','DVKP','PAPA','SINE','CROS','DC','VMIS'/
  14.  
  15.       CALL LIROBJ('MMODEL  ',IPMODE,1,irt1)
  16.       CALL ACTOBJ('MMODEL  ',IPMODE,1)
  17.       IF (IERR.NE.0) RETURN
  18.       IF (IRt1.EQ.0) GOTO 100
  19.  
  20.       CALL LIROBJ('CHARGEME',ICHAR,1,IRETOU)
  21.       IF(IERR.NE.0) RETURN
  22.       IF(IRETOU.EQ.0) GO TO 100
  23. * caracteristiques critere
  24.       CALL LIROBJ('MCHAML  ',IP1,0,IRETOU)
  25.           if (ierr.ne.0) return
  26.       CALL LIRREE(XRE1,0,iret)
  27.        if(iret.eq.0) xre1 = 0.D0
  28.       CALL LIRREE(XRE2,0,iret)
  29.        if(iret.eq.0) xre2 = 0.D0
  30.  
  31.  
  32.           CALL LIRMOT(CLE,NCLE,ICLE,0)
  33.           if(icle.eq.0) icle = 1
  34.           if (ierr.ne.0) return
  35.  
  36.        MCHARG = ichar
  37.        segact mcharg
  38.        if (kcharg(/1).ne.1) then
  39.         call erreur(512)
  40.         return
  41.        endif
  42.       icharg = kcharg(1) 
  43.       segact icharg
  44.         ittemp = ichpo1
  45.         itcont = ichpo2
  46. *      write(6,*)'sr',ierr,ITCONT,ITTEMP,IPMODE,IP1,xre1,xre2,ICLE
  47.  
  48.       call FATIG2(ITCONT,ITTEMP,IPMODE,IPZZZ,IP1,xre1,xre2,ICLE,NCLE,
  49.      &CLE,ICHOUT)
  50.       if(ierr.ne.0) return
  51.  
  52.             CALL ECROBJ( 'MCHAML  ',ICHOUT )
  53.  100  CONTINUE
  54.  
  55.       RETURN
  56.       END
  57.  
  58.  
  59.  
  60.  

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