C VLOC SOURCE CB215821 23/01/25 21:15:39 11573 C SUBROUTINE VLOC C===================================================================== C C Fonction : CALCULE LES VECTEURS D'ORTHOTROPIE C C Syntaxe : CHAM123 = VLOC MOD1 MAT1; C C Input : MOD1 : MODELE de calcul , type MMODEL C C Output : CHAM123 : CHAMELEM aux POINTS DE GAUSS de RIGIDITE C de sous type VECTEUR LOCAUX (de composantes C V1X V1Y V1Z V2X V2Y V3X V3Y V3Z par ex.) C contenant les vecteurs V1 V2 V3 c de base du repere local d'orthotropie C C Creation : BP, 2017-01-12 (inspiré de VSUR, JACONO et RIGI3) C Modifs : ...merci de compléter... C C===================================================================== C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCOORD IPMODL=0 IPCHE1=0 IPCHE2=0 IPCHE3=0 IRET=0 C C===================================================================== C LECTURE DU MODELE C===================================================================== C CALL LIROBJ('MMODEL ',IPMODL,1,IRET1) CALL ACTOBJ('MMODEL ',IPMODL,1) IF (IERR.NE.0) RETURN C C===================================================================== C LECTURE DU MATERIAU C===================================================================== C CALL LIROBJ('MCHAML ',IPMATE,1,IRET2) CALL ACTOBJ('MCHAML ',IPMATE,1) IF (IERR.NE.0) RETURN C C===================================================================== C CALCUL DES VECTEURS : C===================================================================== C DU REPERE LOCAL D'ORTHOTROPIE CALL REDUAF(IPMATE,IPMODL,IPMAT2,0,IRET3,KERR) IF (IRET3.NE.1) CALL ERREUR(KERR) IF(IERR.NE.0) RETURN c CALL QUESUP(IPMODL,IPMAT2,3,0,ISUP,ISUP2) c IF(ISUP.GT.1) THEN c CALL ERREUR(???) c RETURN c ENDIF SEGACT,MCOORD CALL VLOC2(IPMODL,IPMAT2,IPCHE,IRET) SEGDES,MCOORD C C===================================================================== C ECRITURE DES MCHAML C===================================================================== IF(IRET.NE.0) THEN CALL ACTOBJ('MCHAML ',IPCHE,1) CALL ECROBJ('MCHAML ',IPCHE) ENDIF END