Télécharger dirich.eso

Retour à la liste

dirich
C DIRICH    SOURCE    CB215821  23/07/12    21:15:04     11704          
      SUBROUTINE DIRICH
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC SMTABLE
-INC SMLREEL
 
       LOGICAL LOGRE,LOGIN
       REAL*8 TEMPS(0:1000),YOUNG(0:1000)
       REAL*8 TREL(0:10),EVO(0:1000,0:10)
       CHARACTER*8  CHARIN,CHARRE
       CHARACTER*(8) CHARA,TYPIND,TYPOBJ
C
      CHARACTER*4 MOUNIT,MOCODE(3)
 
C
      DATA MOCODE/'EURO','BPEL','LCPC'/
 
      XVALIN=0.D0
      CHARIN='        '
      LOGIN =.FALSE.
      IOBIN=0
      IVALRE=0
      XVALRE=0.D0
      IOBRE=0
 
C
C     ON LIT LE MOT UNITE
C
      CALL LIRCHA(MOUNIT,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL LIRREE(TMAXA,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL LIRENT(NB,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL LIRMOT(MOCODE,3,IMLU,0)
*
*      MOT CLE EURO PAR DEFAUT
*
      IF(IMLU.EQ.0) IMLU=1
*
*     CAS EUROCODE
*
 
      IF(IMLU.EQ.1) THEN
        CALL LIRREE(HO,1,IRETOU)
        IF(IERR.NE.0) RETURN
        CALL LIRREE(ROH,1,IRETOU)
        IF(IERR.NE.0) RETURN
        CALL LIRREE(S,1,IRETOU)
        IF(IERR.NE.0) RETURN
        CALL LIRREE(FCM,1,IRETOU)
        IF(IERR.NE.0) RETURN
*
*     CAS BPEL
*
      ELSE IF(IMLU.EQ.2) THEN
        CALL LIRREE(RM,1,IRETOU)
        IF(IERR.NE.0) RETURN
        CALL LIRREE(RH,1,IRETOU)
        IF(IERR.NE.0) RETURN
        CALL LIRREE(FC28,1,IRETOU)
        IF(IERR.NE.0) RETURN
*
*     CAS LCPC
*
      ELSE
          CALL LIRREE(H0,1,IRETOU)
          IF(IERR.NE.0) RETURN
          CALL LIRREE(RHOS,1,IRETOU)
          IF(IERR.NE.0) RETURN
          CALL LIRREE(E1AN,1,IRETOU)
          IF(IERR.NE.0) RETURN
      ENDIF
*
*      TESTS SUR LES DONNEES
*
      TMAX=TMAXA
      IF (MOUNIT.EQ.'SECO') THEN
        TMAX=TMAXA/3600./24.
      ELSE IF (MOUNIT.EQ.'ANNE')   THEN
        TMAX=TMAXA*365.
      ELSE IF (MOUNIT.NE.'JOUR') THEN
        MOTERR = MOUNIT
        CALL ERREUR(7)
        RETURN
      ENDIF
 
      IF (NB.GT.8) THEN
         NB=8
      ENDIF
 
*
*   ICI APPEL AUX ROUTINES DE CALCUL
*
      IF(IMLU.EQ.1) THEN
*
*     ENTREES :  HO en mm
*     EUROCODE   ROH en valeur reelle (  entre 0 et 1 )
*                FCM en MPa
*                Temps en jours
*
         HO=HO*1000.D0
         ROH=ROH/100.D0
         CALL EURODI(HO,ROH,FCM,S,TMAX,NB,TEMPS,
     &               TREL,EVO,YOUNG,LIDIM)
*
      ELSE IF (IMLU.EQ.2) THEN
*
*     ENTREES :  RM en cm
*     BPEL       RH en %  ( entre 0 et 100 )
*                FC28 en MPa
*                Temps en jours
*
         RM=RM*100.D0
         CALL BPELDI(RM,RH,FC28,TMAX,NB,TEMPS,
     &               TREL,EVO,YOUNG,LIDIM)
 
      ELSE
*
*     ENTREES :  H0 en mm
*     LCPC       RHOS taux d'armatures passives
*                dans une section de beton arme.
*                (0. < RHOS < 1.)
*
          H0 = H0*1000.D0
          CALL LCPCDI(H0,RHOS,E1AN,TMAX,NB,TEMPS,
     &                TREL,EVO,YOUNG,LIDIM)
*
      ENDIF
*
*     CREATION DES TABLES
*
       CALL CRTABL(IPT1)
       CALL CRTABL(IPT2)
 
 
*
*   CREATION DE DEUX PROGS
*
       JG=LIDIM+1
*
* AM 5/9/16  ON REMET LA SORTIE DANS LES UNITES ANNONCEES
*
      IF (MOUNIT.EQ.'SECO') THEN
        FAFAC= 3600.*24.
      ELSE IF (MOUNIT.EQ.'ANNE')   THEN
        FAFAC= 1./365.
      ELSE
        FAFAC= 1.
      ENDIF
 
*  ON CREE LES ABSCISSES
       SEGINI MLREEL
       IPRABS=MLREEL
       DO I=0,LIDIM
         PROG(I+1)=TEMPS(I)*FAFAC
       ENDDO
*
* AM 5/9/16  ON ETEND LES TEMPS A TMAX SI BESOIN 
*
       IF(PROG(JG).LT.TMAXA) PROG(JG)=TMAXA
 
       SEGDES MLREEL
 
 
*  ON CREE LE PROG DES MODULES D'YOUNG
       SEGINI MLREEL
       IPRMOD=MLREEL
       DO I=0,LIDIM
         PROG(I+1)=YOUNG(I)
       ENDDO
       SEGDES MLREEL
 
*
*   CREATION DE L'OBJET MODULE D'YOUNG
*
 
      CALL DIRIC1('TEMP',IPRABS,'YOUN',IPRMOD,IPEVYO)
 
 
       DO 10 IC=0,NB
*
*        ON CREE LES ORDONNEES
*
         SEGINI MLREEL
         IPRORD=MLREEL
         DO I=0,LIDIM
           PROG(I+1)=EVO(I,IC)
         ENDDO
*
* AM 5/9/16  ON REMET LES INVERSES DES TEMPS DE RELAXATION
*            DANS LES BONNES UNITES
*
         TREL(IC)=TREL(IC)/FAFAC
*
*
*   CREATION D'UN OBJET EVOLUTION
*
 
      CALL DIRIC1('TEMP',IPRABS,'MODU',IPRORD,IPEV)
      IF(IERR.NE.0) RETURN
*
*        DANS LA TABLE DES MODULES
*        A L'INDICE II ON MET L'EVOLUTION DE POINTEUR IPEV
*
      CALL ECCTAB(IPT2,'ENTIER  ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
     &                 'EVOLUTIO',IVALRE,XVALRE,CHARRE,LOGRE,IPEV)
 
 
*
*        DANS LA TABLE DES TEMPS
*        A L'INDICE II ON MET LE TEMPS TREL(IC)
*
      CALL ECCTAB(IPT1,'ENTIER  ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
     &                 'FLOTTANT',IVALRE,TREL(IC),CHARRE,LOGRE,IOBRE)
 
 
  10  CONTINUE
 
 
 
*
*     ECRITURE DES RESULTATS
*
      CALL ECROBJ('TABLE',IPT2)
      CALL ECROBJ('TABLE',IPT1)
      CALL ECROBJ('EVOLUTIO',IPEVYO)
      RETURN
      END
 
 
 
 
 

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