C HOTAN SOURCE CB215821 19/08/01 21:16:06 10279 SUBROUTINE HOTAN *_____________________________________________________________________ * * creation d'un mchaml de matrice de hooke tangente * * * * ho1=hotan mod1 si1 va1 ( ca1 ) (xprec) (flo1) (dt) (flo2) ; * * mod1 modele de calcul, type mmodel * si1 champ par element de contraintes,type mchaml * va1 champ par element de variables internes,type mchaml * ca1 champ par element de caracteristiques ( materielle * et/ou geometriques ),type mchaml * flo1 flottant (1.d-3 par defaut) * ho1 champ par element resultat, de type mchaml et de sous * type matrice de hooke tangent * * *_____________________________________________________________________ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO * CHARACTER*4 DEUXMOT(2) * on lit un ou deux flottants xprec et dt DATA DEUXMOT/'PREC','DT '/ XPREC=1.D-3 DTPS=0.D0 1 CONTINUE CALL LIRMOT(DEUXMOT,2,IVAL,0) IF ( IVAL .EQ. 1) THEN CALL LIRREE(XPREC,1,IRTFLO) GOTO 1 ELSE IF ( IVAL .EQ. 2) THEN CALL LIRREE(DTPS,1,IRTFLO) GOTO 1 ENDIF * * lecture d'un model * CALL LIROBJ('MMODEL',IPMODL,0,IRTM) IF(IRTM .EQ. 1)CALL ACTOBJ('MMODEL',IPMODL,1) IF(IERR.NE.0) GOTO 666 * * lecture du mchaml de contraintes * CALL LIROBJ('MCHAML',IPIN,1,IRT1) CALL ACTOBJ('MCHAML',IPIN,1) IF(IERR.NE.0) GOTO 666 CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN * * lecture du mchaml de variables internes * CALL LIROBJ('MCHAML',IPIN,1,IRT2) CALL ACTOBJ('MCHAML',IPIN,1) IF(IERR.NE.0) GOTO 666 CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN * * lecture du mchaml de caracteristiques * CALL LIROBJ('MCHAML',IPIN,1,IRT3) CALL ACTOBJ('MCHAML',IPIN,1) IF(IERR.NE.0) GOTO 666 CALL REDUAF(IPIN,IPMODL,IPCHE3,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN * CALL HOTANP(IPMODL,IPCHE1,IPCHE2,IPCHE3,XPREC,DTPS,IPCHOT,IRET) IF(IERR .NE. 0) RETURN * * ecriture du champs par element de matrice de hooke * IF (IRET.EQ.1) THEN CALL ACTOBJ('MCHAML ',IPCHOT,1) CALL ECROBJ('MCHAML ',IPCHOT) ENDIF 666 CONTINUE END