Télécharger la plaquette Cast3M


fr en

Télécharger config.eso

Retour à la liste

Numérotation des lignes : 

config

  1. C CONFIG    SOURCE    PV090527  25/01/30    21:15:02     12111          
  2.       SUBROUTINE CONFIG     
  3. C=======================================================================
  4. C   OPERATEUR TRANSFORMANT LES CONTRAINTES SUR LA CONFIGURATION COURANTE
  5. C
  6. C       MOD1= OBJET MODELE (TYPE MMODEL)
  7. C
  8. C       SI1 = CHAMP  DE CONTRAINTES (TYPE MCHAML)EN ENTREE
  9. C                OU DE DEFORMATIONS
  10. C
  11. C       SI2 = CHAMP  DE CONTRAINTES (TYPE MCHAML) EN SORTIE
  12. C                OU DE DEFORMATIONS
  13. C
  14. C       CNF = CONFIGURATION COURANTE                                         
  15. C
  16. C       CODE COMBESCURE SEPT 87
  17. C
  18. C=======================================================================
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC SMCOORD
  28. -INC SMCHPOI 
  29. -INC SMELEME 
  30.       POINTEUR MCHEX1.MCHELM
  31. C
  32.       PARAMETER(NDERI=7)
  33.       CHARACTER*4 MODERI(NDERI)
  34.       DATA MODERI/'LINE','QUAD','I  ','II  ','TRUE','JAUM','UTIL'/
  35. c       -> IDERI =  1      2     1      2      3      4      5
  36. c          traitement particulier uniquement si IDERI = 4 ou 5
  37.  
  38.  
  39.       LOGICAL CARACT
  40.  
  41.       CHARACTER*(LOCOMP) NODEF(3),NODEG(3)
  42.       CHARACTER*(LOCOMP) RODEF(3),RODEG(3)
  43.  
  44.       DATA NODEF / 'UX  ','UY  ','UZ  ' /
  45.       DATA NODEG / 'UR  ','UZ  ','UT  ' /
  46.       DATA RODEF / 'RX  ','RY  ','RZ  ' /
  47.       DATA RODEG / 'RR  ','RZ  ','RT  ' /
  48. C-----------------------------------------------------------------------
  49.  
  50.       IPMODL=0
  51.       IPCHE1=0
  52.       IPCHE2=0
  53.       IPCHP1=0
  54.       mchpoi=0
  55. *as xfem 2010_01_13
  56.       IPCHP0=0
  57.       ICHAX1=0
  58.       IDERI=0
  59.       im=1
  60.       ideri=mepsil
  61.  
  62.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
  63.       IF(IERR.NE.0) RETURN
  64.       CALL ACTOBJ('MMODEL  ',IPMODL,2)
  65.       IF(IERR.NE.0)RETURN
  66. C
  67. C     ON LIT LE MCHAML A TRANSFORMER
  68. C
  69.       CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
  70.       if (ipin.eq.0) ierr=2
  71.       IF(IERR.NE.0) RETURN
  72. **    call verrou(2)
  73.       segact mcoord             
  74.       mchelm=ipin
  75. *  sauver les configuration et passage dans mclcnf pour le reduaf
  76.       segact mchelm
  77.       if(mclcnf.eq.0.or.mclcnf.eq.mcoord) then
  78.          call ecrobj('MCHAML  ',ipin)
  79. **       call verrou(3)
  80.          return
  81.       endif
  82.       CALL ACTOBJ('MCHAML  ',IPIN,2)
  83.       mcoor1=mclcnf
  84.       IF(IERR.NE.0) RETURN
  85.       segact mcoord
  86. **    write (6,*) 'mclcnf mcoord avant reduag',mclcnf,mcoord
  87. *  ici faire quelque chose pour que reduaf ne plante pas sur une erreur de configuration
  88.       CALL REDUAG(IPIN,IPMODL,IPCHE1,0,IR,KER)
  89.       if (ierr.ne.0) return
  90.       mchelm=ipche1
  91. **    write (6,*) 'mcoor1 mcoord apres reduag',mcoor1,mcoord
  92.       IF(IR   .NE. 1) CALL ERREUR(KER)
  93.       IF(IERR .NE. 0) RETURN
  94. C
  95. C     ON construit le chpoint de deplacement a partir de la config courante et de celle du
  96. C     chamelem
  97. C
  98.       caract=.false.
  99.        if (titche.eq.'CARACTERISTIQUES') caract=.true.
  100.  
  101.        call lirobj('CHPOINT ',ipchp1,0,iretou)
  102.        mchpoi=ipchp1
  103.       if (iretou.eq.0) then
  104.        segact,mcoord,mcoor1
  105.        nbpts1=mcoor1.xcoor(/1)/(idim+1)
  106.        NAT=2
  107.        NSOUPO=1
  108.        SEGINI MCHPOI
  109.        ipchp1=mchpoi
  110.        NCT=2
  111.        nc=3
  112. **     write(6,*) 'config ifour',ifour
  113.        if (ifour.gt.1.or.idim.eq.3) then
  114.          ncT=3
  115.          nc=6
  116.        endif
  117.        if (ifour.eq.1) then
  118.          ncT=3
  119.          nc=4
  120.        endif
  121.        mrotat=mrota
  122.        mrota1=mcoor1.mrota
  123.        if(mrotat.ne.0) segact mrotat                
  124.        if(mrota1.ne.0) segact mrota1                
  125.        if (mrotat.eq.0.and.mrota1.eq.0) nc=nct
  126.        SEGINI MSOUPO
  127.        IPCHP(1)=msoupo
  128.        if (ifour.ne.0.and.ifour.ne.1) then
  129.          do i=1,nct
  130.            nocomp(i)=nodef(i)
  131.          enddo
  132.        else
  133.          do i=1,nct
  134.            nocomp(i)=nodeg(i)
  135.          enddo
  136.        endif
  137.        if (ifour.ne.0.and.ifour.ne.1) then
  138.          do i=nct+1,nc
  139.            nocomp(i)=rodef(i-nct+1)
  140.          enddo
  141.        elseif (ifour.eq.0.or.ifour.eq.1) then
  142.          nocomp(3)=rodeg(3)
  143.        endif 
  144.        N=nbpts
  145.        segini mpoval
  146.        ipoval=mpoval
  147. **     write(6,*) 'config icar',icar
  148. **     write(6,*) 'config nbpts nbpts1',nbpts,nbpts1
  149.        do i=1,min(nbpts,nbpts1)
  150.        do j=1,nct
  151.         ij=(i-1)*(idim+1)+j
  152.         ij0=(i-1)*idim+j
  153.         vpocha(i,j)=xcoor(ij)-mcoor1.xcoor(ij)
  154.        enddo
  155.        do j=1,nct+1,nc
  156.         if(mrota.ne.0.and.mrota1.ne.0) then 
  157.              vpocha(i,j)=xrota(i,j)-mrota1.xrota(i,j)
  158.         elseif(mrota.ne.0.and.mrota1.eq.0) then 
  159.              vpocha(i,j)=xrota(i,j)
  160.         elseif(mrota.eq.0.and.mrota1.ne.0) then 
  161.              vpocha(i,j)=         -mrota1.xrota(i,j)
  162.         endif
  163.        enddo
  164.        enddo
  165.        do i=min(nbpts,nbpts1)+1,nbpts
  166.        do j=1,1,idim
  167.         ij=(i-1)*(idim+1)+j
  168.         ij0=(i-1)*idim+j
  169.         vpocha(i,j)=xcoor(ij)
  170.        enddo
  171.        enddo
  172.        if(mrota.ne.0) then                                  
  173.        do i=min(nbpts,nbpts1)+1,nbpts
  174.        do j=1,nct+1,nc
  175.              vpocha(i,j)=xrota(i,j)
  176.        enddo
  177.        enddo
  178.        endif
  179.        if (.not.caract) then
  180.        do i=1,nbpts
  181.        do j=1,nc
  182.          vpocha(i,j)=-vpocha(i,j)
  183.        enddo
  184.        enddo
  185.        endif
  186.        nbnn=1
  187.        nbelem=nbpts       
  188.        nbsous=0
  189.        nbref=0
  190.        segini meleme
  191. **     write(6,*) 'segini meleme ',meleme
  192.        itypel=1
  193.        do i=1,nbelem
  194.          num(1,i)=i
  195.        enddo
  196.        igeoc=meleme
  197.       segdes mcoor1
  198.       endif
  199.       segact mchpoi
  200. **    call ecchpo(mchpoi,1)
  201.  
  202. *as xfem 2010_01_13
  203.       if (ierr.ne.0) then
  204.         if (ichax1.ne.0) then
  205.           write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  206.      &       'deplacement entre la config. 0 et la config. de reference'
  207.           return
  208.         endif
  209.       endif
  210. C
  211.       MMODEL = IPMODL
  212.       NBPART = KMODEL(/1)
  213.       IPICA = 0
  214.       DO 4 IPART=1,NBPART
  215.         IMODEL = KMODEL(IPART)
  216. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  217. C doivent pas modifier les champs !
  218. * septembre 2019: cette restriction est enlevee
  219. **      IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  220. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  221. C et ne doivent donc pas etre transportees !
  222.         IF ( INATUU.EQ.-1) IPICA = IPICA+1
  223. C Verification presence XFEM
  224. *as xfem 2010_01_13
  225.         NOBMO1=IVAMOD(/1)
  226.         if (NOBMO1.ne.0) then
  227.           Do iobmo1=1,NOBMO1
  228.             if (TYMODE(iobmo1).eq.'MCHAML') then
  229.               MCHEX1=IVAMOD(iobmo1)
  230.               if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  231.                 ICHAX1 = MCHEX1.ICHAML(1)
  232.                 goto 3
  233.               endif
  234.             endif
  235.           Enddo
  236.         endif
  237.  3      CONTINUE
  238. *fin as xfem 2010_01_13
  239.  4    CONTINUE
  240.  
  241. C Presence XFEM -> pointeur ICHAX1 non nul
  242. *as xfem 2010_01_13
  243.       if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  244.         write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  245.      &      'deplacement entre la config. 0 et la config. de reference'
  246.         CALL ERREUR(21)
  247.         return
  248.       endif
  249.  
  250. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  251. C                   Recopie MCHAML IPCHE1 tel quel et on quitte
  252.       IF (IPICA.EQ.NBPART) THEN
  253.         IRET = 1
  254.         CALL COPIE8(IPCHE1,IPCHE2)
  255. C
  256. C Melange de MODELEs : Traitement GENERAL
  257. C
  258.       ELSE
  259.         IRET = 0
  260.         mchelm=ipche1
  261.         segact mchelm*mod
  262.         if (.not.caract) then
  263. **    write (6,*) 'mcoors mcoord avant piocap',mcoors,mcoord,mchelm
  264.         mclcnf=mcoord
  265.         segact mcoord
  266.         nbpts=xcoor(/1)/(idim+1)
  267.         CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
  268.      &              IPCHE2,IRET)
  269.         mchelm=ipche2
  270. **    write (6,*) 'mclcnf mcoord apres piocap',mclcnf,mcoord,mchelm
  271.         else
  272. C       Mise a jour des caracteristiques materielles
  273. **    write (6,*) 'mclcnf mcoord avant formch',mclcnf,mcoord,mchelm
  274.         CALL FORMCH(IPMODL,IPCHE1,IPCHP1,iret,IPCHe2)
  275.         mchelm=ipche2
  276.         segact mchelm*mod
  277.         mclcnf=mcoord
  278. **    write (6,*) 'mclcnf mcoord apres formch',mclcnf,mcoord,mchelm
  279.         endif
  280.         segact mcoord
  281.         nbpts=xcoor(/1)/(idim+1)
  282.         segdes mcoord
  283. **      call verrou(3)
  284.       ENDIF
  285.  
  286.       IF (IRET.EQ.1) THEN
  287. **      write(6,*) 'sortie de config ',ipche2
  288.         CALL ACTOBJ('MCHAML  ',IPCHE2,2)
  289.         CALL ECROBJ('MCHAML  ',IPCHE2)
  290.       ENDIF
  291. ** nettoyage du chpoint cree
  292.       if (mchpoi.ne.0) then
  293.         do isp=1,ipchp(/1)
  294.           msoupo=ipchp(isp)
  295.           mpoval=ipoval
  296.           segsup mpoval
  297.           meleme=igeoc
  298.           segsup meleme
  299.           segsup msoupo                                                                 
  300.         enddo
  301.         segsup mchpoi
  302.       endif
  303.       END
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  

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