Download dirich.eso

Back to the list

   1 : C DIRICH    SOURCE    CHAT      06/03/16    21:16:32     5336           
   2 :       SUBROUTINE DIRICH
   3 :       
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : -INC CCOPTIO                                                                    
   7 : -INC CCNOYAU
   8 : -INC SMTABLE
   9 : -INC SMLREEL
  10 : 
  11 :        LOGICAL LOGRE,LOGIN
  12 :        REAL*8 TEMPS(0:1000),YOUNG(0:1000)
  13 :        REAL*8 TREL(0:10),EVO(0:1000,0:10)
  14 :        CHARACTER*8  CHARIN,CHARRE
  15 :        CHARACTER*(8) CHARA,TYPIND,TYPOBJ
  16 : C                                                                               
  17 :       CHARACTER*4 MOUNIT,MOCODE(3)
  18 : 
  19 : C                                                                               
  20 :       DATA MOCODE/'EURO','BPEL','LCPC'/
  21 : 
  22 : C                                                                               
  23 : C     ON LIT LE MOT UNITE
  24 : C                                                                               
  24 :       CALL LIRCHA(MOUNIT,1,IRETOU)
  25 :       IF(IERR.NE.0) RETURN
  25 :       CALL LIRREE(TMAX,1,IRETOU)
  26 :       IF(IERR.NE.0) RETURN
  26 :       CALL LIRENT(NB,1,IRETOU)
  27 :       IF(IERR.NE.0) RETURN
  27 :       CALL LIRMOT(MOCODE,3,IMLU,0)
  28 : *
  29 : *      MOT CLE EURO PAR DEFAUT
  30 : *
  31 :       IF(IMLU.EQ.0) IMLU=1
  32 : *
  33 : *     CAS EUROCODE
  34 : *
  35 : 
  36 :       IF(IMLU.EQ.1) THEN
  36 :         CALL LIRREE(HO,1,IRETOU)
  37 :         IF(IERR.NE.0) RETURN
  37 :         CALL LIRREE(ROH,1,IRETOU)
  38 :         IF(IERR.NE.0) RETURN
  38 :         CALL LIRREE(S,1,IRETOU)
  39 :         IF(IERR.NE.0) RETURN
  39 :         CALL LIRREE(FCM,1,IRETOU)
  40 :         IF(IERR.NE.0) RETURN
  41 : *
  42 : *     CAS BPEL
  43 : *
  44 :       ELSE IF(IMLU.EQ.2) THEN
  44 :         CALL LIRREE(RM,1,IRETOU)
  45 :         IF(IERR.NE.0) RETURN
  45 :         CALL LIRREE(RH,1,IRETOU)
  46 :         IF(IERR.NE.0) RETURN
  46 :         CALL LIRREE(FC28,1,IRETOU)
  47 :         IF(IERR.NE.0) RETURN
  48 : *
  49 : *     CAS LCPC
  50 : *
  51 :       ELSE
  51 :           CALL LIRREE(H0,1,IRETOU)
  52 :           IF(IERR.NE.0) RETURN
  52 :           CALL LIRREE(RHOS,1,IRETOU)
  53 :           IF(IERR.NE.0) RETURN
  53 :           CALL LIRREE(E1AN,1,IRETOU)
  54 :           IF(IERR.NE.0) RETURN
  55 :       ENDIF
  56 : *
  57 : *      TESTS SUR LES DONNEES
  58 : *
  59 :       IF (MOUNIT.EQ.'SECO') THEN 
  60 :         TMAX=TMAX/3600./24.
  61 :       ELSE IF (MOUNIT.EQ.'ANNE')   THEN
  62 :         TMAX=TMAX*365.
  63 :       ELSE IF (MOUNIT.NE.'JOUR') THEN
  64 :         MOTERR(1:4)= MOUNIT
  64 :         CALL ERREUR(7)
  65 :         RETURN 
  66 :       ENDIF
  67 : 
  68 :       IF (NB.GT.8) THEN
  69 :          NB=8
  70 :       ENDIF
  71 :       
  72 : *
  73 : *   ICI APPEL AUX ROUTINES DE CALCUL
  74 : *
  75 :       IF(IMLU.EQ.1) THEN
  76 : *
  77 : *     ENTREES :  HO en mm
  78 : *     EUROCODE   ROH en valeur reelle (  entre 0 et 1 )
  79 : *                FCM en MPa
  80 : *                Temps en jours
  81 : *
  82 :          HO=HO*1000.D0
  83 :          ROH=ROH/100.D0
  83 :          CALL EURODI(HO,ROH,FCM,S,TMAX,NB,TEMPS,
  84 :      &               TREL,EVO,YOUNG,LIDIM)
  85 : *
  86 :       ELSE IF (IMLU.EQ.2) THEN
  87 : *
  88 : *     ENTREES :  RM en cm
  89 : *     BPEL       RH en %  ( entre 0 et 100 )
  90 : *                FC28 en MPa
  91 : *                Temps en jours
  92 : *
  93 :          RM=RM*100.D0
  93 :          CALL BPELDI(RM,RH,FC28,TMAX,NB,TEMPS,
  94 :      &               TREL,EVO,YOUNG,LIDIM)
  95 : 
  96 :       ELSE
  97 : *
  98 : *     ENTREES :  H0 en mm
  99 : *     LCPC       RHOS taux d'armatures passives
 100 : *                dans une section de beton arme.
 101 : *                (0. < RHOS < 1.)
 102 : *
 103 :           H0 = H0*1000.D0
 103 :           CALL LCPCDI(H0,RHOS,E1AN,TMAX,NB,TEMPS,
 104 :      &                TREL,EVO,YOUNG,LIDIM)
 105 : *
 106 :       ENDIF
 107 : *
 108 : *     CREATION DES TABLES
 109 : *
 109 :        CALL CRTABL(IPT1)
 109 :        CALL CRTABL(IPT2)
 110 : 
 111 : 
 112 : *
 113 : *   CREATION DE DEUX PROGS
 114 : *
 115 :        JG=LIDIM+1
 116 : 
 117 : *  ON CREE LES ABSCISSES
 118 :        SEGINI MLREEL
 119 :        IPRABS=MLREEL
 120 :        DO I=0,LIDIM
 121 :          PROG(I+1)=TEMPS(I)
 122 :        ENDDO
 123 :        SEGDES MLREEL
 124 : 
 125 : 
 126 : *  ON CREE LE PROG DES MODULES D'YOUNG
 127 :        SEGINI MLREEL
 128 :        IPRMOD=MLREEL
 129 :        DO I=0,LIDIM
 130 :          PROG(I+1)=YOUNG(I)
 131 :        ENDDO
 132 :        SEGDES MLREEL
 133 : 
 134 : *
 135 : *   CREATION DE L'OBJET MODULE D'YOUNG
 136 : *
 137 : 
 137 :       CALL DIRIC1('TEMP',IPRABS,'YOUN',IPRMOD,IPEVYO)
 138 : 
 139 : 
 140 :        DO 10 IC=0,NB
 141 : *
 142 : *        ON CREE LES ORDONNEES
 143 : *
 144 :          SEGINI MLREEL
 145 :          IPRORD=MLREEL
 146 :          DO I=0,LIDIM
 147 :            PROG(I+1)=EVO(I,IC)
 148 :          ENDDO
 149 : *
 150 : *
 151 : *   CREATION D'UN OBJET EVOLUTION
 152 : *
 153 : 
 153 :       CALL DIRIC1('TEMP',IPRABS,'MODU',IPRORD,IPEV)
 154 :       IF(IERR.NE.0) RETURN
 155 : *
 156 : *        DANS LA TABLE DES MODULES
 157 : *        A L'INDICE II ON MET L'EVOLUTION DE POINTEUR IPEV
 158 : *
 158 :       CALL ECCTAB(IPT2,'ENTIER  ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
 159 :      &                 'EVOLUTIO',IVALRE,XVALRE,CHARRE,LOGRE,IPEV)
 160 : 
 161 : 
 162 : *
 163 : *        DANS LA TABLE DES TEMPS
 164 : *        A L'INDICE II ON MET LE TEMPS TREL(IC)
 165 : *
 165 :       CALL ECCTAB(IPT1,'ENTIER  ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
 166 :      &                 'FLOTTANT',IVALRE,TREL(IC),CHARRE,LOGRE,IOBRE)
 167 : 
 168 : 
 169 :   10  CONTINUE
 170 : 
 171 : 
 172 : 
 173 : *
 174 : *     ECRITURE DES RESULTATS
 175 : *
 175 :       CALL ECROBJ('TABLE',IPT2)
 175 :       CALL ECROBJ('TABLE',IPT1)
 175 :       CALL ECROBJ('EVOLUTIO',IPEVYO)
 176 :       RETURN                                                                    
 177 :       END
 178 :  

© Cast3M 2003 - All rights reserved.
Disclaimer