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