C FEFP SOURCE JB251061 23/05/10 21:15:10 11667 *--------------------------------------------------------------------- * Integration of FeFp models *--------------------------------------------------------------------- c SUBROUTINE FEFP c SUBROUTINE FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR, c . IPCHE7,IPCHE8,IPCHE9,IPRIGI, c . PRECIS,NITMAX,NUPDATE) c SUBROUTINE FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,IMATRI, c . NBELEM,NBPTEL,NBNN,LRE,MFR, c . IVADESP,IVADPI,IVARI,IVAMAT, c . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7, c . NDEP,NDEF,NSTRS,NVARI,NMATT,PRECIS,NITMAX,NUPDATE, c . KERRE) c subroutine apf_driver_fefp(BE,VARF,SIGF,DDHOOK, c . NDEF,NVARI,NSTRS,LHOOK, c . XMAT,xdensi,PRECIS,NITMAX,KERRE, c . nescri,nues,nmodel,nnumer,deltax, c . level,kmax,iaugla,caugla) c subroutine pushf35(a,f,a1) c subroutine prin35(b,bpr,qen,q6,q6t) c subroutine eig35(v,d,rot) *--------------------------------------------------------------------- *--------------------------------------------------------------------- *--------------------------------------------------------------------- SUBROUTINE FEFP *--------------------------------------------------------------------- * Integration of FeFp models *--------------------------------------------------------------------- * SYNTAXE= * SIGF VARF DEPPFI RI1 = 'ECFEFP' MODL DEPPL0 VAR0 ZDEPT CARAC * (PRECIS) (NITMAX) (NUPDATE); * IN= * MMODEL | MODL OBJET MODELE * MCHAML | DEPPL0 DEFORMATIONS INELASTIQUES AU DEBUT DU PAS * MCHAML | VAR0 VARIABLES INTERNES AU DEBUT DU PAS * CHAMPOINT | ZDEPT deplacements entre conf de depart et arrivee * MCHAML | CARAC CARACTERISTIQUES GEOMETRIQUES * FLOTTANT | PRECIS PRECISION POUR ITERATIONS INTERNES * INTEGER | NITMAX maximum number of iterations at local level * INTEGER | NUPDATE =1 UPDATE ; =0 TOTAL - LAGRANGIAN * * OUT= * MCHAML | SIGF CONTRAINTES A LA FIN DU PAS * MCHAML | VARF VARIABLES INTERNES A LA FIN DU PAS * MCHAML | DEPIN DEFORMATIONS INELASTIQUES A LA FIN DU PAS * MRIGI | RI1 CONSISTENT TANGENT MATRIX *--------------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMCOORD segact mcoord ************************ * Lectura de datos ************************ * modelo CALL LIROBJ('MMODEL ',IPMODL,1,IRT) CALL ACTOBJ('MMODEL ',IPMODL,1) IF (IERR.NE.0) RETURN * deformacion plastica inicial CALL LIROBJ('MCHAML ',IPIN,1,IRT) CALL ACTOBJ('MCHAML ',IPIN,1) IF (IERR.NE.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN MCHELM=IPCHE1 SEGACT MCHELM c Usa L1, N1, N3 IF(MCHELM.TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN MOTERR(1:32)='DEFORMATIONS INELASTIQUES' CALL ERREUR(565) RETURN ENDIF * variables internas iniciales CALL LIROBJ('MCHAML ',IPIN,1,IRT) CALL ACTOBJ('MCHAML ',IPIN,1) IF(IERR .NE. 0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN MCHELM=IPCHE2 SEGACT MCHELM IF(TITCHE.NE.'VARIABLES INTERNES')THEN MOTERR(1:32)='VARIABLES INTERNES' CALL ERREUR(565) RETURN ENDIF * incremento de desplazamientos CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT) CALL ACTOBJ('CHPOINT ',IPCHP1,1) IF(IERR .NE. 0) RETURN * paso de campo nodal a campo elemental en nodos (ct=1) CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE3,1) IF(IERR .NE. 0) RETURN * caracteristicas materiales y geometricas CALL LIROBJ('MCHAML ',IPIN,1,IRT) CALL ACTOBJ('MCHAML ',IPIN,1) IF(IERR .NE. 0) RETURN CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN MCHELM=IPCAR SEGACT MCHELM IF(TITCHE.NE.'CARACTERISTIQUES')THEN MOTERR(1:32)='CARACTERISTIQUES' CALL ERREUR(565) RETURN ENDIF * precision para iteraciones internas CALL LIRREE(PRECIS,0,IRT) IF(IRT.EQ.0) PRECIS=1.D-10 * num max de iteraciones internas CALL LIRENT(NITMAX,0,IRT) IF (IRT.EQ.0) NITMAX=25 * Update or total (default) lagrangian formulation CALL LIRENT(NUPDATE,0,IRT) IF (IRT.EQ.0) NUPDATE=0 * deformacion plana o axisimetrico IF ((IFOUR.gt.0).or.(IFOUR.lt.-1)) then write(*,*) ' Formulacion no disponible' return endif ************************ * calcular ************************ CALL FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR, . IPCHE7,IPCHE8,IPCHE9,IPRIGI, . PRECIS,NITMAX,NUPDATE) IF(IERR .NE. 0) RETURN ************************ * escribir resultados ************************ CALL ACTOBJ('MCHAML ',IPCHE9,1) CALL ACTOBJ('MCHAML ',IPCHE8,1) CALL ACTOBJ('MCHAML ',IPCHE7,1) CALL ECROBJ('MCHAML ',IPCHE9) CALL ECROBJ('MCHAML ',IPCHE8) CALL ECROBJ('MCHAML ',IPCHE7) CALL ECROBJ('RIGIDITE',IPRIGI) * borrar los desplazamientos en campo elemental END