C TAILLE SOURCE CB215821 23/06/14 21:15:05 11676 c mr millard 93 20:00:16 354 SUBROUTINE TAILLE c===================================================================== c operateur calculant les parametres de taille par element c aux points de gauss (tenseur de taille) c c ancienne syntaxe : c ------------------ c c chel = tail modl c ob1 : modele de calcul, type mmodel c chel: chamelem de sous type scalaires contenant c les parametres de taille aux points de gauss c c===================================================================== c IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCOORD * CHARACTER*4 MUNIF(3) DATA MUNIF/'DIAM','DIRE','UNIF'/ c c ipmodl pointeur sur un modele mmodel c ipche pointeur sur un chamelem de c sous type scalaires contenant c les parametres de taille c IPMODL = 0 IUNIF = 0 c c Lecture du mot cle c CALL LIRMOT(MUNIF,3,IUNIF,0) IF (IERR.NE.0) RETURN c c Lecture du modele c CALL LIROBJ('MMODEL',IPMODL,1,IRET) CALL ACTOBJ('MMODEL',IPMODL,1) IF (IERR.NE.0) RETURN SEGACT,MCOORD C C Option : 'DIAMETRE_MIN' IF (IUNIF.EQ.1) THEN IPCHA1 = 0 IPCHA2 = 0 IPCHA3 = 0 IPCHA4 = 0 CALL LIROBJ('MCHAML',IPIN,0,IRET) IF (IERR.NE.0) RETURN IPCHA1=0 IF (IRET .EQ. 1) THEN CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN ENDIF ICAS = 5 CALL CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS) IF (IPCHA4 .NE. 0) THEN CALL ACTOBJ('MCHAML',IPCHA4,1) CALL ECROBJ('MCHAML',IPCHA4) ENDIF C Option : 'DIRECTION' & Cas ou le mot cle UNIF est seul ELSE IF (IUNIF.EQ.2) THEN C Lecture eventuelle du mot cle 'UNIF' apres le mot cle 'DIRECTION' IUNIF = 0 CALL LIRMOT(MUNIF(3),1,IUNIF,0) IF (IERR.NE.0) RETURN ENDIF c Calcul des parametres de taille par element a chaque point de Gauss c Si IUNIF non nul 0, toutes les composantes sont nulles. IPCHE = 0 IRET = 0 CALL TAILPO(IPMODL,IPCHE,IUNIF,IRET) IF (IRET.NE.0) THEN CALL ACTOBJ('MCHAML',IPCHE,1) CALL ECROBJ('MCHAML',IPCHE) ENDIF ENDIF SEGDES,MCOORD RETURN END