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    KICH      22/09/22    21:15:02     11465          
  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,NOPT=2)
  9.  
  10. -INC PPARAM
  11. -INC CCREEL
  12. -INC CCOPTIO
  13. -INC SMCHARG
  14.       LOGICAL L0,L1
  15.       CHARACTER*4 CLE(NCLE),OPTSEU(NOPT)
  16.       DATA CLE/'TOUS','DVKP','PAPA','SINE','CROS','DC','VMIS'/
  17.       DATA OPTSEU/'SEUI','TOUS'/
  18.       DATA zc/-2.d-1/
  19.  
  20.       CALL LIROBJ('MMODEL  ',IPMODE,1,irt1)
  21.       CALL ACTOBJ('MMODEL  ',IPMODE,1)
  22.       IF (IERR.NE.0) RETURN
  23.       IF (IRt1.EQ.0) GOTO 100
  24.  
  25.       CALL LIROBJ('CHARGEME',ICHAR,1,IRETOU)
  26.       IF(IERR.NE.0) RETURN
  27.       IF(IRETOU.EQ.0) GO TO 100
  28. * caracteristiques critere
  29.       CALL LIROBJ('MCHAML  ',IP1,0,IRETOU)
  30.           if (ierr.ne.0) return
  31.       CALL LIRREE(XRE1,0,iret)
  32.        if(iret.eq.0) xre1 = 0.D0
  33.       CALL LIRREE(XRE2,0,iret)
  34.        if(iret.eq.0) xre2 = 0.D0
  35.  
  36.  
  37.           CALL LIRMOT(CLE,NCLE,ICLE,0)
  38.           if(icle.eq.0) icle = 1
  39.           if (ierr.ne.0) return
  40.         IF (icle.ge.2.or.icle.le.6) THEN
  41.           CALL LIRMOT(OPTSEU,NOPT,IOP1,0)
  42.           if(iop1.eq.1) then
  43.             CALL LIRMOT(OPTSEU,NOPT,IOP2,0)
  44.             if (iop2.eq.0) then
  45.               CALL LIRREE(zecrit,1,iret)
  46.               if (iret.eq.0) then
  47.                 return
  48.               endif
  49.             elseif (iop2.eq.2) then
  50.                zecrit = XPETIT
  51.             endif
  52.           else
  53.             zecrit = zc
  54.           endif
  55.         ENDIF
  56.           if (ierr.ne.0) return
  57.  
  58.        MCHARG = ichar
  59.        segact mcharg
  60.        if (kcharg(/1).ne.1) then
  61.         call erreur(512)
  62.         return
  63.        endif
  64.       icharg = kcharg(1) 
  65.       segact icharg
  66.         ittemp = ichpo1
  67.         itcont = ichpo2
  68. *      write(6,*)'sr',ierr,ITCONT,ITTEMP,IPMODE,IP1,xre1,xre2,ICLE
  69.  
  70.       call FATIG2(ITCONT,ITTEMP,IPMODE,IPZZZ,IP1,xre1,xre2,ICLE,NCLE,
  71.      &CLE,zecrit,ICHOUT)
  72.       if(ierr.ne.0) return
  73.  
  74.             CALL ECROBJ( 'MCHAML  ',ICHOUT )
  75.  100  CONTINUE
  76.  
  77.       RETURN
  78.       END
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  

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