C PRESSI SOURCE PV 09/03/12 21:31:25 6325 SUBROUTINE PRESSI *_______________________________________________________________________ * * OPERATEUR PRESSI * * * ANCIENNE SYNTAXE : * __________________ * * FP = PRESSI I MASS OBJAF I P OBJ I (CARA) * I CHPOP I * I COQU OBJAF I P I I VECT I (CARA) * I CHPOP I I NORM I * I FISS OBJAF I P I VECT POIN CARA * I CHPOP I * * FP CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES * OBJAF OBJET AFFECTE ,MASSIF ,COQUE OU FISS SUR LEQUEL * S APPLIQUE LA PRESSION * P VALEUR ALGEBRIQUE DE LA PRESSION * OBJ POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT * LA FACE SUR LAQUELLE S'APPLIQUE LA PRESSION * CHPOP CHPOINT CONTENANT LES VALEURS ALGEBRIQUES * DES PRESSIONS AUX NOEUDS * VECT POUR COQUE ET LINESPRING , VECTEUR INDIQUANT LA * DIRECTION DANS LAQUELLE S APPLIQUE LA PRESSION * NORM MOT CLE INDIQUANT QUE LA PRESSION EST POSITIVE * SI ELLE EST PORTEE PAR LA NORMALE POSITIVE * A L ELEMENT * CARA POUR LES MASSIFS EN CONTRAINTES PLANES ET * POUR LES COQUES EPAISSES , CHELEM CONTENANT * LES VALEURS DES EPAISSEURS AUX POINTS * D INTEGRATION * POIN POUR LE LINESPRING , POINT OU SE RAPPORTE * LE VECTEUR * CARA POUR LE LINESPRING , CHELEM CONTENANT LES VALEURS * DES CARACTERISTIQUES AUX POINTS D INTEGRATION * * * * NOUVELLE SYNTAXE : * __________________ * * FP = PRESSI I MASS MODEL I P MAIL I (CARA) * I CHPOT I * I COQU MODEL I P I I VECT I (CARA) * I CHPOT I I NORM I * I FISS MODEL I P I VECT POIN CARA * I CHPOT I * * FP CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES * MODEL OBJET MMODEL ,MASSIF ,COQUE OU FISS SUR LEQUEL * S APPLIQUE LA PRESSION * P VALEUR ALGEBRIQUE DE LA PRESSION * MAIL POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT * LA FACE SUR LAQUELLE S'APPLIQUE LA PRESSION * CHPOT CHPOINT CONTENANT LES VALEURS ALGEBRIQUES * DES PRESSIONS AUX NOEUDS * VECT POUR COQUE ET LINESPRING , VECTEUR INDIQUANT LA * DIRECTION DANS LAQUELLE S APPLIQUE LA PRESSION * NORM MOT CLE INDIQUANT QUE LA PRESSION EST POSITIVE * SI ELLE EST PORTEE PAR LA NORMALE POSITIVE * A L ELEMENT * CARA POUR LES MASSIFS EN CONTRAINTES PLANES ET * POUR LES COQUES EPAISSES, MCHAML CONTENANT * LES VALEURS DES EPAISSEURS AUX POINTS * D INTEGRATION * POIN POUR LE LINESPRING , POINT OU SE RAPPORTE * LE VECTEUR * CARA POUR LE LINESPRING ,MCHAML CONTENANT LES VALEURS * DES CARACTERISTIQUES AUX POINTS D INTEGRATION * * * MODIF EBERSOLT MAI 85 PRESSION SUR LES LEVRES DU LINESPRING * * PASSAGE AUX NOUVEAU CHAMALEM PAR JM CAMPENON LE 04 08 90 *_______________________________________________________________________ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMCHPOI -INC SMCHAML * CHARACTER*4 MTYPE(5),MNORM(1) CHARACTER*(4) MOSCAL,MOPOI1 * DATA MTYPE/'MASS','COQU','FISS','TUYA','SHB8'/ DATA MNORM/'NORM'/ DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/ * IPMODL=0 IPCHE1=0 IPCHE2=0 IPCHA1=0 ICONV=0 IRET=0 * * ON LIT UN MOT CLE * CALL LIRMOT(MTYPE,5,IMLU,1) IF (IERR.NE.0) RETURN * * ON LIT UN MMODEL * CALL LIROBJ('MMODEL ',IPMODL,1,IRETMO) IF (IERR.NE.0) RETURN * * ON LIT UN CHAMP POINT (FACULTATIF) * CALL LIROBJ('CHPOINT ',IPCHE1,0,IRETPO) IF (IERR.NE.0) RETURN * IF (IMLU.EQ.1) THEN *_______________________________________________________________________ * * ON A LU LE MOT MASSIF *_______________________________________________________________________ * * ON LIT SOIT UN FLOTTANT ET UN MAILLAGE ,SOIT UN CHPOINT * IPMAIL=0 P=0.D0 IF (IRETPO.EQ.0) THEN CALL LIRREE(XXX,1,IRETOU) IF (IERR.NE.0) RETURN P=XXX CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETMA) IF (IERR.NE.0) RETURN ENDIF * CALL FPMASS(IPCHE1,IPMODL,IPTFP,IPMAIL,P,IRET) IF (IRET.EQ.0.OR.IERR.NE.0) RETURN GOTO 666 * ELSE IF (IMLU.EQ.2) THEN *_______________________________________________________________________ * * ON A LU LE MOT COQUE *_______________________________________________________________________ * * ON LIT SOIT UN FLOTTANT, SOIT UN CHPOINT * P=0.D0 IF (IRETPO.EQ.0) THEN CALL LIRREE(XXX,1,IRETOU) IF (IERR.NE.0) RETURN P=XXX IPCHE1=0 ENDIF * * ON LIT LE MOT CLE NORM SINON ON APPELERA PRORIE QUI * LIRA SES DONN{ES * CALL LIRMOT(MNORM,1,JMLU,0) IF (IERR.NE.0) RETURN * * LA LECTURE D'UN CHAMELEM DE CARACTERISTIQUE (FACULTATIVE * EST FAITE DANS FPCOQU * CALL FPCOQU(P,IPCHE1,IPMODL,JMLU,IPTFP,IRET,ICONV) IF (IRET.EQ.0.OR.IERR.NE.0) RETURN GOTO 666 * ELSE IF (IMLU.EQ.3) THEN *_______________________________________________________________________ * * ON A LU LE MOT FISSURE *______________________________________________________________________ * * ON LIT SOIT UN FLOTTANT ,SOIT UN CHPOINT * P=0.D0 IF (IRETPO.EQ.0) THEN CALL LIRREE(XXX,1,IRETOU) IF (IERR.NE.0) RETURN P=XXX IPCHE1=0 ENDIF * * ON LIT UN VECTEUR * CALL LIROBJ('POINT ',IPVECT,1,IRETVC) IF (IERR.NE.0) RETURN * * ON LIT UN POINT * CALL LIROBJ('POINT ',IPPOIN,1,IRETPT) IF (IERR.NE.0) RETURN * * ON LIT UN CHELEM DE CARACTERISTIQUES * CALL LIROBJ('MCHAML',IPCHE2,1,IRETCH) IF (IERR.NE.0) RETURN * CALL FPFISS(P,IPCHE1,IPMODL,IPVECT,IPPOIN,IPCHE2,IPTFP,IRET) IF (IRET.EQ.0.OR.IERR.NE.0) RETURN GOTO 666 * ELSE IF (IMLU.EQ.4) THEN *_______________________________________________________________________ * * ON A LU LE MOT TUYAU *______________________________________________________________________ * * ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES) * CALL LIROBJ('MCHAML',IPCHE1,1,IRETC2) IF (IERR.NE.0) RETURN * CALL FPTUYA(IPMODL,IPCHE1,IPTFP,IRET) IF (IERR.NE.0.OR.IRET.NE.1)THEN RETURN ENDIF GOTO 666 ELSE IF (IMLU.EQ.5) THEN *_______________________________________________________________________ * * ON A LU LE MOT SHB8 *______________________________________________________________________ * * ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES) * IPMAIL=0 P=0.D0 IF (IRETPO.EQ.0) THEN CALL LIRREE(XXX,1,IRETOU) IF (IERR.NE.0) RETURN P=XXX ENDIF * CALL FPshb8(IPMODL,IPCHE1,P,IPTFP) IF (IPTFP.EQ.0)THEN RETURN ENDIF GOTO 666 * ENDIF * 666 CONTINUE * * LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR * POUR TOUTES LES COMPOSANTES DU CHPOINT * MCHPOI=IPTFP SEGACT MCHPOI NAT = MAX(JATTRI(/1),1) NSOUPO = IPCHP(/1) SEGADJ MCHPOI * le champ de force nodale est discret. JATTRI(1) = 2 DO 100 IA=1,NSOUPO MSOUPO=IPCHP(IA) SEGACT MSOUPO*MOD DO 101 NC=1,NOHARM(/1) NOHARM(NC)=NIFOUR 101 CONTINUE SEGDES MSOUPO 100 CONTINUE * SEGDES MCHPOI * CALL ECROBJ('CHPOINT ',IPTFP) RETURN END