1 : C PRESSI SOURCE PV 09/03/12 21:31:25 6325 2 : SUBROUTINE PRESSI 3 : *_______________________________________________________________________ 4 : * 5 : * OPERATEUR PRESSI 6 : * 7 : * 8 : * ANCIENNE SYNTAXE : 9 : * __________________ 10 : * 11 : * FP = PRESSI I MASS OBJAF I P OBJ I (CARA) 12 : * I CHPOP I 13 : * I COQU OBJAF I P I I VECT I (CARA) 14 : * I CHPOP I I NORM I 15 : * I FISS OBJAF I P I VECT POIN CARA 16 : * I CHPOP I 17 : * 18 : * FP CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES 19 : * OBJAF OBJET AFFECTE ,MASSIF ,COQUE OU FISS SUR LEQUEL 20 : * S APPLIQUE LA PRESSION 21 : * P VALEUR ALGEBRIQUE DE LA PRESSION 22 : * OBJ POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT 23 : * LA FACE SUR LAQUELLE S'APPLIQUE LA PRESSION 24 : * CHPOP CHPOINT CONTENANT LES VALEURS ALGEBRIQUES 25 : * DES PRESSIONS AUX NOEUDS 26 : * VECT POUR COQUE ET LINESPRING , VECTEUR INDIQUANT LA 27 : * DIRECTION DANS LAQUELLE S APPLIQUE LA PRESSION 28 : * NORM MOT CLE INDIQUANT QUE LA PRESSION EST POSITIVE 29 : * SI ELLE EST PORTEE PAR LA NORMALE POSITIVE 30 : * A L ELEMENT 31 : * CARA POUR LES MASSIFS EN CONTRAINTES PLANES ET 32 : * POUR LES COQUES EPAISSES , CHELEM CONTENANT 33 : * LES VALEURS DES EPAISSEURS AUX POINTS 34 : * D INTEGRATION 35 : * POIN POUR LE LINESPRING , POINT OU SE RAPPORTE 36 : * LE VECTEUR 37 : * CARA POUR LE LINESPRING , CHELEM CONTENANT LES VALEURS 38 : * DES CARACTERISTIQUES AUX POINTS D INTEGRATION 39 : * 40 : * 41 : * 42 : * NOUVELLE SYNTAXE : 43 : * __________________ 44 : * 45 : * FP = PRESSI I MASS MODEL I P MAIL I (CARA) 46 : * I CHPOT I 47 : * I COQU MODEL I P I I VECT I (CARA) 48 : * I CHPOT I I NORM I 49 : * I FISS MODEL I P I VECT POIN CARA 50 : * I CHPOT I 51 : * 52 : * FP CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES 53 : * MODEL OBJET MMODEL ,MASSIF ,COQUE OU FISS SUR LEQUEL 54 : * S APPLIQUE LA PRESSION 55 : * P VALEUR ALGEBRIQUE DE LA PRESSION 56 : * MAIL POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT 57 : * LA FACE SUR LAQUELLE S'APPLIQUE LA PRESSION 58 : * CHPOT CHPOINT CONTENANT LES VALEURS ALGEBRIQUES 59 : * DES PRESSIONS AUX NOEUDS 60 : * VECT POUR COQUE ET LINESPRING , VECTEUR INDIQUANT LA 61 : * DIRECTION DANS LAQUELLE S APPLIQUE LA PRESSION 62 : * NORM MOT CLE INDIQUANT QUE LA PRESSION EST POSITIVE 63 : * SI ELLE EST PORTEE PAR LA NORMALE POSITIVE 64 : * A L ELEMENT 65 : * CARA POUR LES MASSIFS EN CONTRAINTES PLANES ET 66 : * POUR LES COQUES EPAISSES, MCHAML CONTENANT 67 : * LES VALEURS DES EPAISSEURS AUX POINTS 68 : * D INTEGRATION 69 : * POIN POUR LE LINESPRING , POINT OU SE RAPPORTE 70 : * LE VECTEUR 71 : * CARA POUR LE LINESPRING ,MCHAML CONTENANT LES VALEURS 72 : * DES CARACTERISTIQUES AUX POINTS D INTEGRATION 73 : * 74 : * 75 : * MODIF EBERSOLT MAI 85 PRESSION SUR LES LEVRES DU LINESPRING 76 : * 77 : * PASSAGE AUX NOUVEAU CHAMALEM PAR JM CAMPENON LE 04 08 90 78 : *_______________________________________________________________________ 79 : IMPLICIT INTEGER(I-N) 80 : IMPLICIT REAL*8 (A-H,O-Z) 81 : -INC CCOPTIO 82 : -INC SMCHPOI 83 : -INC SMCHAML 84 : * 85 : CHARACTER*4 MTYPE(5),MNORM(1) 86 : CHARACTER*(4) MOSCAL,MOPOI1 87 : * 88 : DATA MTYPE/'MASS','COQU','FISS','TUYA','SHB8'/ 89 : DATA MNORM/'NORM'/ 90 : DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/ 91 : * 92 : IPMODL=0 93 : IPCHE1=0 94 : IPCHE2=0 95 : IPCHA1=0 96 : ICONV=0 97 : IRET=0 98 : * 99 : * ON LIT UN MOT CLE 100 : * 100 : CALL LIRMOT(MTYPE,5,IMLU,1) 101 : IF (IERR.NE.0) RETURN 102 : * 103 : * ON LIT UN MMODEL 104 : * 104 : CALL LIROBJ('MMODEL ',IPMODL,1,IRETMO) 105 : IF (IERR.NE.0) RETURN 106 : * 107 : * ON LIT UN CHAMP POINT (FACULTATIF) 108 : * 108 : CALL LIROBJ('CHPOINT ',IPCHE1,0,IRETPO) 109 : IF (IERR.NE.0) RETURN 110 : * 111 : IF (IMLU.EQ.1) THEN 112 : *_______________________________________________________________________ 113 : * 114 : * ON A LU LE MOT MASSIF 115 : *_______________________________________________________________________ 116 : * 117 : * ON LIT SOIT UN FLOTTANT ET UN MAILLAGE ,SOIT UN CHPOINT 118 : * 119 : IPMAIL=0 120 : P=0.D0 121 : IF (IRETPO.EQ.0) THEN 121 : CALL LIRREE(XXX,1,IRETOU) 122 : IF (IERR.NE.0) RETURN 123 : P=XXX 123 : CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETMA) 124 : IF (IERR.NE.0) RETURN 125 : ENDIF 126 : * 126 : CALL FPMASS(IPCHE1,IPMODL,IPTFP,IPMAIL,P,IRET) 127 : IF (IRET.EQ.0.OR.IERR.NE.0) RETURN 128 : GOTO 666 129 : * 130 : ELSE IF (IMLU.EQ.2) THEN 131 : *_______________________________________________________________________ 132 : * 133 : * ON A LU LE MOT COQUE 134 : *_______________________________________________________________________ 135 : * 136 : * ON LIT SOIT UN FLOTTANT, SOIT UN CHPOINT 137 : * 138 : P=0.D0 139 : IF (IRETPO.EQ.0) THEN 139 : CALL LIRREE(XXX,1,IRETOU) 140 : IF (IERR.NE.0) RETURN 141 : P=XXX 142 : IPCHE1=0 143 : ENDIF 144 : * 145 : * ON LIT LE MOT CLE NORM SINON ON APPELERA PRORIE QUI 146 : * LIRA SES DONN{ES 147 : * 147 : CALL LIRMOT(MNORM,1,JMLU,0) 148 : IF (IERR.NE.0) RETURN 149 : * 150 : * LA LECTURE D'UN CHAMELEM DE CARACTERISTIQUE (FACULTATIVE 151 : * EST FAITE DANS FPCOQU 152 : * 152 : CALL FPCOQU(P,IPCHE1,IPMODL,JMLU,IPTFP,IRET,ICONV) 153 : IF (IRET.EQ.0.OR.IERR.NE.0) RETURN 154 : GOTO 666 155 : * 156 : ELSE IF (IMLU.EQ.3) THEN 157 : *_______________________________________________________________________ 158 : * 159 : * ON A LU LE MOT FISSURE 160 : *______________________________________________________________________ 161 : * 162 : * ON LIT SOIT UN FLOTTANT ,SOIT UN CHPOINT 163 : * 164 : P=0.D0 165 : IF (IRETPO.EQ.0) THEN 165 : CALL LIRREE(XXX,1,IRETOU) 166 : IF (IERR.NE.0) RETURN 167 : P=XXX 168 : IPCHE1=0 169 : ENDIF 170 : * 171 : * ON LIT UN VECTEUR 172 : * 172 : CALL LIROBJ('POINT ',IPVECT,1,IRETVC) 173 : IF (IERR.NE.0) RETURN 174 : * 175 : * ON LIT UN POINT 176 : * 176 : CALL LIROBJ('POINT ',IPPOIN,1,IRETPT) 177 : IF (IERR.NE.0) RETURN 178 : * 179 : * ON LIT UN CHELEM DE CARACTERISTIQUES 180 : * 180 : CALL LIROBJ('MCHAML',IPCHE2,1,IRETCH) 181 : IF (IERR.NE.0) RETURN 182 : * 182 : CALL FPFISS(P,IPCHE1,IPMODL,IPVECT,IPPOIN,IPCHE2,IPTFP,IRET) 183 : IF (IRET.EQ.0.OR.IERR.NE.0) RETURN 184 : GOTO 666 185 : * 186 : ELSE IF (IMLU.EQ.4) THEN 187 : *_______________________________________________________________________ 188 : * 189 : * ON A LU LE MOT TUYAU 190 : *______________________________________________________________________ 191 : * 192 : * ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES) 193 : * 193 : CALL LIROBJ('MCHAML',IPCHE1,1,IRETC2) 194 : IF (IERR.NE.0) RETURN 195 : * 195 : CALL FPTUYA(IPMODL,IPCHE1,IPTFP,IRET) 196 : IF (IERR.NE.0.OR.IRET.NE.1)THEN 197 : RETURN 198 : ENDIF 199 : GOTO 666 200 : 201 : ELSE IF (IMLU.EQ.5) THEN 202 : *_______________________________________________________________________ 203 : * 204 : * ON A LU LE MOT SHB8 205 : *______________________________________________________________________ 206 : * 207 : * ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES) 208 : * 209 : IPMAIL=0 210 : P=0.D0 211 : IF (IRETPO.EQ.0) THEN 211 : CALL LIRREE(XXX,1,IRETOU) 212 : IF (IERR.NE.0) RETURN 213 : P=XXX 214 : ENDIF 215 : * 215 : CALL FPshb8(IPMODL,IPCHE1,P,IPTFP) 216 : IF (IPTFP.EQ.0)THEN 217 : RETURN 218 : ENDIF 219 : GOTO 666 220 : * 221 : ENDIF 222 : * 223 : 666 CONTINUE 224 : * 225 : * LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR 226 : * POUR TOUTES LES COMPOSANTES DU CHPOINT 227 : * 228 : MCHPOI=IPTFP 229 : SEGACT MCHPOI 230 : NAT = MAX(JATTRI(/1),1) 231 : NSOUPO = IPCHP(/1) 232 : SEGADJ MCHPOI 233 : * le champ de force nodale est discret. 234 : JATTRI(1) = 2 235 : DO 100 IA=1,NSOUPO 236 : MSOUPO=IPCHP(IA) 237 : SEGACT MSOUPO*MOD 238 : DO 101 NC=1,NOHARM(/1) 239 : NOHARM(NC)=NIFOUR 240 : 101 CONTINUE 241 : SEGDES MSOUPO 242 : 100 CONTINUE 243 : * 244 : SEGDES MCHPOI 245 : * 245 : CALL ECROBJ('CHPOINT ',IPTFP) 246 : RETURN 247 : END 248 : 249 : 250 : 251 : 252 : 253 : 254 :
© Cast3M 2003 - All rights reserved.
Disclaimer