1 : C PIOCAU SOURCE CHAT 11/03/16 21:29:02 6902 2 : SUBROUTINE PIOCAU(IM) 3 : C======================================================================= 4 : C OPERATEUR TRANSFORMANT LES CONTRAINTES DE PIOLA KIRCHHOFF 5 : C EN CONTRAINTES DE CAUCHY ET RECIPROQUEMENT 6 : C 7 : C IM = 0 : SI2 = PICA MODL1 SI1 DU (UXFEM) ; 8 : C IM = 1 : SI2 = CAPI MODL1 SI1 DU (UXFEM) ; 9 : C 10 : C MODL1= OBJET MODELE (TYPE MMODEL) 11 : C 12 : C SI1 = CHAMP DE CONTRAINTES (TYPE MCHAML)EN ENTREE 13 : C OU DE DEFORMATIONS 14 : C 15 : C SI2 = CHAMP DE CONTRAINTES (TYPE MCHAML) EN SORTIE 16 : C OU DE DEFORMATIONS 17 : C 18 : C DU = INCRMT DE DEPLACEMENT ENTRE CONFIG DE DEPART ET ACTUELLE 19 : C (TYPE CHPOINT) 20 : C 21 : C UXFEM = DEPLACEMENT ENRICHI ENTRE CONFIG FISSURE FERMEE ET 22 : C CONFIG DE DEPART (elements xq4r et xc8r) 23 : C 24 : C CODE COMBESCURE SEPT 87 25 : C 26 : C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI le 12/4/91 27 : C======================================================================= 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8(A-H,O-Z) 30 : -INC CCOPTIO 31 : -INC SMMODEL 32 : -INC SMCHAML 33 : POINTEUR MCHEX1.MCHELM 34 : C 35 : IPCHA1=0 36 : IPCHP1=0 37 : IPCHE1=0 38 : IPCHE2=0 39 : *as xfem 2010_01_13 40 : IPCHP0=0 41 : ICHAX1=0 42 : IRET=0 43 : 44 : IPMODL=0 45 : C 45 : CALL LIROBJ('MMODEL',IPMODL,1,IRT1) 46 : IF(IERR.NE.0)RETURN 47 : C 48 : C Je verifie que je n'utilise pas PICA avec un des modeles interdit (OTTOSEN, UO2) 49 : C j active le segment pour verifier son contenu 50 : C 51 : MMODEL = IPMODL 52 : SEGACT MMODEL 53 : * Nombre de partitions : 54 : NBPART = KMODEL(/1) 55 : IPICA = 0 56 : * Boucle sur les partitions du modèle. 57 : * Le chamelem résultat aura autant de partitions qu'il y a de 58 : * sous-maillages supports correspondant. 59 : DO 4 IPART=1,NBPART 60 : IMODEL = KMODEL(IPART) 61 : SEGACT IMODEL 62 : IF ((INATUU.EQ.108).OR.(INATUU.EQ.42)) THEN 63 : IPICA=1 64 : ENDIF 65 : 66 : *as xfem 2010_01_13 67 : NOBMO1=IVAMOD(/1) 68 : if (NOBMO1.ne.0) then 69 : Do iobmo1=1,NOBMO1 70 : if (TYMODE(iobmo1).eq.'MCHAML') then 71 : MCHEX1=IVAMOD(iobmo1) 72 : SEGACT MCHEX1 73 : if ((MCHEX1.TITCHE).eq.'ENRICHIS') then 74 : ICHAX1 = MCHEX1.ICHAML(1) 75 : SEGDES MCHEX1 76 : goto 3 77 : endif 78 : SEGDES MCHEX1 79 : endif 80 : Enddo 81 : endif 82 : 3 CONTINUE 83 : *fin as xfem 2010_01_13 84 : 85 : SEGDES IMODEL 86 : 4 CONTINUE 87 : SEGDES MMODEL 88 : C 89 : C fin de la verification des modeles interdits et presence XFEM 90 : C 90 : CALL LIROBJ('MCHAML',IPCHE1,1,IRT4) 91 : IF(IERR.NE.0) RETURN 92 : C 93 : C ON LIT UN CHPOINT DE DEPLACEMENTS 94 : C 94 : CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT5) 95 : IF(IERR.NE.0) RETURN 96 : C 97 : C Si on utilise un modele interdit, on va faire une simple copie du MCHAML; sinon on utilise la procedure normale 98 : C 99 : IF (IPICA.NE.0) THEN 99 : CALL COPIE8(IPCHE1,IPCHE2) 100 : if (ierr.ne.0) return 101 : IRET=1 102 : ELSE 103 : *as xfem 2010_01_13 104 : if (ichax1.ne.0) then 104 : call LIROBJ('CHPOINT',IPCHP0,1,IRT6) 105 : if (ierr.ne.0) then 106 : write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ', 107 : & 'deplacement entre la config. 0 et la config. de reference' 108 : return 109 : endif 110 : endif 111 : 111 : CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IPCHE2,IRET) 112 : *fin as xfem 2010_01_13 113 : 114 : ENDIF 115 : C 115 : IF(IRET.EQ.1) CALL ECROBJ('MCHAML',IPCHE2) 116 : RETURN 117 : END 118 : 119 : 120 :
© Cast3M 2003 - All rights reserved.
Disclaimer