Télécharger la plaquette Cast3M


fr en

Télécharger coml12.eso

Retour à la liste

Numérotation des lignes : 

coml12

  1. C COML12    SOURCE    OF166741  25/11/04    21:15:33     12349          
  2.       SUBROUTINE COML12(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3.      &         mwrkxe,iretou,iecou,necou,dlttmp)
  4.  
  5. *----------------------------------------------------------------
  6. * lois locales pour la mecanique
  7. *  decrites au point d integration
  8. *----------------------------------------------------------------
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC SMMODEL
  16. -INC SMELEME
  17. -INC SMINTE
  18. -INC CCHAMP
  19. -INC SMCOORD
  20.  
  21. -INC DECHE
  22.  
  23. -INC TECOU
  24.  
  25.       SEGMENT WRK2
  26.         REAL*8 TRAC(LTRAC)
  27.       ENDSEGMENT
  28.  
  29.       SEGMENT MWRKXE
  30.         REAL*8 XEL(3,NBNNbi)
  31.       ENDSEGMENT
  32.  
  33.       REAL*8 DLTTMP
  34.       dimension xcar(1)
  35. C-----------------------------------------------------------------------
  36. C
  37. c     moterr(1:6) = 'COML12 '
  38. c     moterr(7:15) = 'element '
  39. c     interr(1) = ib
  40. c     interr(2) = igau
  41. c     call erreur(-329)
  42. *      write(6,*) ' entrée dans coml12 iecou ', iecou
  43.       imodel = iqmod
  44.  
  45.       JNPLAS = wrk53.INPLAS
  46. c
  47. c     traitement du modele
  48. c
  49.       NBPGAU = nbgs
  50.       NVARI = NVART
  51.       TETA1 = ture0(1)
  52.       TETA2 = turef(1)
  53.       SUCC1 = -1.D35
  54.       SUCC2 = -1.D35
  55.       nexo = exova0(/1)
  56.       if (nexo.gt.0) then
  57.         do 1296 inex = 1,nexo
  58.           if ((nomexo(inex).eq.'SUCC    ').and.
  59.      &        (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  60.             SUCC1 = exova0(inex)
  61.             SUCC2 = exova1(inex)
  62.             goto 1295
  63.           endif
  64.  1296   continue
  65.       endif
  66.  1295 continue
  67. C
  68. C     MODELE PLASTIQUE 'LIAISON_ACBE'
  69.       IF(JNPLAS.EQ.171) then
  70.          call aclj(wrk52,wrk53,wrk54,nvari,iecou)
  71. C
  72. C     MODELE ENDOMMAGEABLE 'RICRAG'
  73.       ELSE IF (JNPLAS.EQ.144) THEN
  74.         if(ifour.ne.2) then
  75.           CALL RIC2NL(wrk52,wrk53,wrk54,nvari,iecou)
  76.         else
  77.           CALL RIC3NL(wrk52,wrk53,wrk54,nvari,iecou)
  78.         endif
  79. C
  80. C     MODELE PLASTIQUE 'INTIMP'
  81.       ELSE IF (JNPLAS.EQ.145  .AND. mfrbi.eq.7) THEN
  82.         nstrbi=nstrss
  83.         icarbi=icara
  84.         CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  85.         nstrss=nstrbi
  86.         icara=icarbi
  87. C
  88. C     MODELE PLASTIQUE 'RICJOI'
  89.       ELSE IF (JNPLAS.EQ.146) then
  90. *        write(6,*) ' ifour ',ifour
  91. *        if(ib+igau.eq.2) write(6,*)'sig0', (SIG0 (iou),iou=1,nstrs)
  92. *        if(ib+igau.eq.2) write(6,*)'depst', (DEPST (iou),iou=1,nstrs)
  93.         if(ifour.ne.2) then
  94.          CALL RICJ2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  95.      &               XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  96.         else
  97.          CALL RICJ3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  98.      &               TETA1,TETA2,
  99.      &               XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  100.         endif
  101. *        if(ib+igau.eq.2) write(6,*)'SIGF', (SIGF(iou),iou=1,nstrs)
  102. C
  103. C     MODELE ENODMMAGEABLE 'GLRC_DM'
  104.       ELSEIF(JNPLAS.EQ.157) then
  105.         CALL LCGLDM(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  106. C
  107. C     MODELE ENODMMAGEABLE 'RICBET'
  108.       ELSEIF(JNPLAS.EQ.158) then
  109.         CALL RICBET(wrk52,wrk53,wrk54,nvari)
  110. C
  111. C     MODELE ENODMMAGEABLE 'RICCOQ'
  112.       ELSEIF(JNPLAS.EQ.159) then
  113.         CALL ELOCRAK1(wrk52,wrk53,wrk54,nvari,iecou)
  114. C
  115. C     MODELE PLASTIQUE 'CONCYC'
  116.       ELSEIF(JNPLAS.EQ.173) then
  117.         CALL CONCYC1(wrk52,wrk53,wrk54,nvari,iecou)
  118. C
  119. C     MODELE PLASTIQUE 'OUGLOVA'
  120.       ELSEIF(JNPLAS.EQ.175) then
  121.         IF (MFR.EQ.27) THEN
  122.            CALL OUGLOB(XMAT,DEPST,SIG0,VAR0,SIGF,VARF)
  123.         ELSE
  124.            CALL OUGLOV(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,IFOUR)
  125.         ENDIF
  126. C
  127. C     MODELES VISCOPLASTIQUE 'SYCO1' ET 'SYCO2' (Symonds & Cowper)
  128.       ELSE IF (JNPLAS.EQ.153.OR.JNPLAS.EQ.154) then
  129. C       on recupere la courbe de traction
  130.         nccor=ncourb
  131.         call CCOTRA(WRK52,WRK2,NCCOR,WRK53)
  132.         ncourb= nccor
  133.  
  134.         iforb=ifourb
  135.         CALL SYCO12(wrk52,wrk53,wrk54,wrk2,IB,IGAU,
  136.      &                  NBPGAU,NCcor,IFORB,iecou,dlttmp)
  137. C
  138.         ncourb=nccor
  139. C
  140. C     MODELE PLASTIQUE 'DP_SOL'
  141.       ELSEIF(JNPLAS.EQ.172) then
  142.         CALL DP_SOL(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  143. C
  144. C     MODELE PLASTIQUE 'IWPR3D_SOL'
  145.       ELSEIF(JNPLAS.EQ.176) then
  146.         CALL IWPR3D(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCAR,
  147.      &              EPIN0,EPINF,EPST0,EPSTF)
  148. C
  149. C     MODELE ENDOMMAGEABLE 'EFEM'
  150.       ELSEIF(JNPLAS.EQ.177) then 
  151. c*? D'ou vient ILCOUR ?
  152.         IF ((IFOUR.EQ.-2).AND.(ILCOUR.EQ.4)) THEN
  153.           CALL PBEFEM(wrk52,wrk53,wrk54,nvari,iecou,mwrkxe)
  154.         ELSE
  155.           CALL ERREUR(5)
  156.         ENDIF
  157. C
  158.       ELSE
  159.         write(ioimp,*) 'Branchement incorrect dans COML12'
  160.         CALL ERREUR(5)
  161.       ENDIF
  162.  
  163.       RETURN
  164.       END
  165.  
  166.  
  167.  

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