C TAILPO SOURCE CB215821 24/04/12 21:17:18 11897 C responsable : Mr MILLARD C======================================================================= C SUBROUTINE TAILPO(IPMODL,IPCHE,IUNIF,IRET) C C======================================================================= C ENTREES : C --------- C IPMODL= pointeur sur un MMODEL C C SORTIES : C -------- C IPCHE = CHAMELEM contenant les parametres de tailles aux C point de GAUSS necessaire a modele beton OTTOSEN C IRET = 1 si succes 0 sinon C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER(XUN=1.D0,XZER=0.D0) EXTERNAL SHAPE -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMMODEL -INC SMELEME -INC SMCOORD -INC SMINTE SEGMENT MTRA1 REAL*8 XEL(3,NBNN) REAL*8 VCOMP(NCOMP) REAL*8 SHP(6,NBNN),SHPZER(6,NBNN) REAL*8 SHPQSI(6,NBNN),SHPETA(6,NBNN),SHPDZE(6,NBNN) C* REAL*8 SHPGAU(6,NBNN) ENDSEGMENT SEGMENT MTRA2 REAL*8 BPSS(3,3),YEL(3,NBNN) ENDSEGMENT * SEGMENT INFO * INTEGER INFELE(JG) * ENDSEGMENT C C ACTIVATION DU MODELE C MMODEL= IPMODL NSOUS=KMODEL(/1) C C CREATION DU MCHELM C N1=NSOUS L1=16 N3=6 SEGINI,MCHELM TITCHE='CARACTERISTIQUES' IFOCHE=IFOUR NHRM=NIFOUR C======================================================================= C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES C======================================================================= C DO 500 ISOUS=1,NSOUS C C----------------------------------------------------------------------- C Traitement du modele de la sous-zone ISOUS C----------------------------------------------------------------------- IMODEL=KMODEL(ISOUS) IPMAIL=IMAMOD C Numero de l element fini dans nomtp de CCHAMP.INC MELE=NEFMOD NFOR=FORMOD(/2) C Recherche de formulations particulieres CALL PLACE(FORMOD,NFOR,ITHER ,'THERMIQUE' ) CALL PLACE(FORMOD,NFOR,IDIFF ,'DIFFUSION' ) CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE') C----------------------------------------------------------------------- C INFORMATION SUR L'ELEMENT FINI C----------------------------------------------------------------------- * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) * IF (IERR.NE.0) THEN * CALL ERREUR(660) * RETURN * ENDIF * INFO=IPINF IF (ITHER.NE.0 .OR. IDIFF.NE.0 .OR. ITHEHY.NE.0) THEN MFR=NUMMFR(MELE) CALL TSHAPE(MELE,'GAUSS',MINTE) MFR=NUMMFR(MELE) ELSE MELE=INFELE(1) C Numero de la formulation de l element fini (massif ...) MFR =INFELE(13) C Pointeur sur un segment d integration MINTE=INFMOD(5) ENDIF IELE=NUMGEO(MELE) * MINTE=INFELE(11) * SEGSUP INFO C----------------------------------------------------------------------- C- CREATION DU MCHAML DE LA SOUS ZONE--------------------- C----------------------------------------------------------------------- C Remplissage de l'entete dans le MCHELM C pointeur sur le maillage de la sous zone (maillage elementaire) IMACHE(ISOUS)=IPMAIL C Nom du constituant CONCHE(ISOUS)=CONMOD C =0 pour des valeurs independantes du repere C en fait, ces valeurs dependent du repere global mais C nous voulons un champ de caracteristiques (donc idpt du repere) INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 C numero de l harmonique de Fourier INFCHE(ISOUS,3)=NHRM C pointeur sur un SMINTE INFCHE(ISOUS,4)=MINTE C =0 pour des champs de defomations et contraintes usuels INFCHE(ISOUS,5)=0 C =3 SMINTE pointe sur un segment d integration aux pts de GAUSS C pour la rigidite IF (ITHER.NE.0 .OR. IDIFF.NE.0 .OR. ITHEHY.NE.0) THEN INFCHE(ISOUS,6)=6 ELSE INFCHE(ISOUS,6)=3 ENDIF C NOMBRE DES COMPOSANTES SELON LA DIMENSION N2 = 0 IF (IDIM.EQ.2) N2=7 IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9 )) N2=7 IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.31)) N2=12 C ERREUR FORMULATION INDISPONIBLE IF (N2 .EQ. 0) THEN MOTERR(1:8)=NOMFR(MFR) CALL ERREUR(193) RETURN ENDIF C----------------------------------------------------------------------- C CREATION DU MCHAML C----------------------------------------------------------------------- SEGINI MCHAML ICHAML(ISOUS)=MCHAML C----------------------------------------------------------------------- C Remplissage du MCHAML C----------------------------------------------------------------------- NCOMP = N2 DO i=1,NCOMP TYPCHE(i)='REAL*8' ENDDO * C NOM DES COMPOSANTES SELON LA DIMENSION C Si l option de calcul est PLAN IF (IFOMOD.EQ.-1) THEN NOMCHE(1)='LXX ' NOMCHE(2)='LYY ' NOMCHE(3)='LZZ ' NOMCHE(4)='LXY ' NOMCHE(5)='PXX ' NOMCHE(6)='PYY ' NOMCHE(7)='PXY ' C Si l option de calcul est AXIS ou FOUR ELSE IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN NOMCHE(1)='LRR ' NOMCHE(2)='LZZ ' NOMCHE(3)='LOO ' NOMCHE(4)='LRZ ' NOMCHE(5)='PRR ' NOMCHE(6)='PZZ ' NOMCHE(7)='PRZ ' C Si l option de calcul est TRID CAS MASSIF ELSE IF (IFOMOD.EQ.2.AND.(MFR.EQ.1.OR.MFR.EQ.31)) THEN NOMCHE( 1)='LXX ' NOMCHE( 2)='LYY ' NOMCHE( 3)='LZZ ' NOMCHE( 4)='LXY ' NOMCHE( 5)='LXZ ' NOMCHE( 6)='LYZ ' NOMCHE( 7)='PXX ' NOMCHE( 8)='PYY ' NOMCHE( 9)='PZZ ' NOMCHE(10)='PXY ' NOMCHE(11)='PXZ ' NOMCHE(12)='PYZ ' C Si l option de calcul est TRID CAS COQUES ELSE IF (IFOMOD.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN NOMCHE(1)='LSS ' NOMCHE(2)='LTT ' NOMCHE(3)='LNN ' NOMCHE(4)='LST ' NOMCHE(5)='PSS ' NOMCHE(6)='PTT ' NOMCHE(7)='PST ' ELSE CALL ERREUR(5) ENDIF C C----------------------------------------------------------------------- C CREATION ET REMPLISSAGE DU MELVAL DE CHAQUE COMPOSANTE C----------------------------------------------------------------------- C Nous n avons que des composantes scalaires donc N2*=0---- N2PTEL=0 N2EL =0 C Cas 1 : Champs UNIFORMEs (valeur nulle) IF (IUNIF.NE.0) THEN N1PTEL=1 N1EL=1 DO i=1,NCOMP SEGINI,MELVAL IELVAL(i)=MELVAL VELCHE(1,1)=XZER ENDDO C Cas 2 : Calculs des tenseurs en chaque point d'integration ! ELSE C---------INFORMATION sur les fonctions de forme ( MINTE )--------- NBPGAU=POIGAU(/1) C----ACTIVATION DU MELEME : Maillage elementaire de la sous zone--- MELEME=IPMAIL NBNN =NUM(/1) NBELEM=NUM(/2) N1PTEL=NBPGAU N1EL =NBELEM C-Initialisation du segment des valeurs aux points de Gauss DO i=1,NCOMP SEGINI,MELVAL IELVAL(i)=MELVAL ENDDO C-- Segments de travail SEGINI,MTRA1 MTRA2=0 IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9)) SEGINI,MTRA2 C-------------------------------------------------------------------- C initialisation des fonctions de formes aux points de GAUSS C pour l element de reference de cette sous zone C-------------------------------------------------------------------- C-initialisation des fonctions de forme a l origine et sur les axes- CALL SHAPE(XZER,XZER,XZER,IELE,SHPZER,IRET) * IF (IRET.EQ.0) THEN * CALL ERREUR(662) * GOTO 592 * ENDIF CALL SHAPE(XUN,XZER,XZER,IELE,SHPQSI,IRET) * IF (IRET.EQ.0) THEN * CALL ERREUR(662) * GOTO 592 * ENDIF CALL SHAPE(XZER,XUN,XZER,IELE,SHPETA,IRET) * IF (IRET.EQ.0) THEN * CALL ERREUR(662) * GOTO 592 * ENDIF CALL SHAPE(XZER,XZER,XUN,IELE,SHPDZE,IRET) IF (IRET.EQ.0) THEN CALL ERREUR(662) GOTO 592 ENDIF C BOUCLE SUR CHAQUE ELEMENT C----------------------------------------------------------------------- DO 1000 IB=1,NBELEM C extraction des coordonnees des noeuds de l element IB C resultat dans XEL CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) C C CAS DES COQUES 3D - RECHERCHE DES COORDONNEES LOCALES IF (IDIM.EQ.3.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN C* IF (MTRA2.NE.0) THEN DO j=1,NBNN DO i=1,3 YEL(i,j)=XEL(i,j) ENDDO ENDDO CALL VPAST(YEL,BPSS) CALL VCORL1(YEL,XEL,BPSS,NBNN) ENDIF C C BOUCLE SUR CHAQUE POINT DE GAUSS C============================================================= DO 1004 IC=1,NBPGAU DO j=1,NBNN DO i=1,6 SHP(i,j)=SHPTOT(i,j,IC) ENDDO ENDDO POI=POIGAU(IC) * QSI=QSIGAU(IC) * ETA=ETAGAU(IC) * DZE=DZEGAU(IC) * CALL SHAPE(QSI,ETA,DZE,IELE,SHPGAU,IRET) * IF (IRET.EQ.0) THEN * CALL ERREUR(662) * GOTO 592 * ENDIF C CALL TAILCA(MTRA1,POI,IDIM,IFOUR,NBNN,MELE,IELE,MFR,IRET) IF (IRET.EQ.0) THEN CALL ERREUR(663) GOTO 592 ENDIF C DO i=1,NCOMP MELVAL=IELVAL(i) VELCHE(IC,IB)=VCOMP(i) ENDDO C 1004 CONTINUE C 1000 CONTINUE 592 CONTINUE SEGSUP,MTRA1 IF (MTRA2.NE.0) SEGSUP,MTRA2 ENDIF IF (IERR.NE.0) GOTO 9990 C============================================================ C------------ BOUCLE SUR LES SOUS ZONES RESTANTES ----------- C============================================================ 500 CONTINUE C---------------------FIN NORMAL DU CALCUL------------------------- IPCHE=MCHELM IRET=1 RETURN C------------------------------------------------------------------- C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR C------------------------------------------------------------------- 9990 CONTINUE SEGSUP,MCHELM IPCHE=0 IRET =0 END