1 : C YFRTI SOURCE CHAT 05/01/13 04:17:40 5004 2 : SUBROUTINE YFRTI(DRR,LE,NEL,K0,NPT,IES,NP,IAXI,IPADL,KIMPL, 3 : & COEF,NCOEF,IKK, 4 : & BETA,NBETA,IKB, 5 : & V0 ,NV0 ,IKV, 6 : & UN,F,F1) 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8 (A-H,O-Z) 10 : C*********************************************************************** 11 : C 12 : C BETA 13 : C CALCUL LE TENSEUR DE PERTE DE CHARGE K U I KX I 14 : C K--> I KY I 15 : C I KZ I 16 : C 17 : C COEFF : K 18 : C BETA : BETA 19 : C 20 : C 21 : C 22 : C*********************************************************************** 23 : C 24 : DIMENSION LE(NP,*),IPADL(*),DRR(NP,NEL) 25 : DIMENSION UN(NPT,IES),F(NPT,IES),F1(NPT,IES) 26 : DIMENSION COEF(NCOEF,IES),BETA(NBETA,IES),V0(NV0,IES) 27 : -INC CCREEL 28 : C 29 : IF(IES.EQ.2) THEN 30 : C 31 : C ******* 32 : C * 2 D * 33 : C ******* 34 : C 35 : C write(6,*)' NPT=',NPT,' IES=',IES,' IKK=',ikk,' IKB=',ikb, 36 : C & ' IKV=',ikv 37 : 38 : IF(KIMPL.EQ.0)THEN 39 : 40 : DO 502 K=1,NEL 41 : NK=K+K0 42 : KK=1+(1-IKK)*(NK-1) 43 : KB=1+(1-IKB)*(NK-1) 44 : 45 : DO 502 I=1,NP 46 : NF=IPADL(LE(I,K)) 47 : KV=1+(1-IKV)*(NF-1) 48 : UXN=UN(NF,1)-V0(KV,1) 49 : UX=ABS(UXN)+XPETIT 50 : BX=(BETA(KB,1)-1.D0)*LOG(UX) 51 : ABX=ABS(BX) 52 : IF(ABX.LE.XPETIT)THEN 53 : UX=1.D0 54 : ELSE 55 : UX=EXP(BX) 56 : ENDIF 57 : UYN=UN(NF,2)-V0(KV,2) 58 : UY=ABS(UYN)+XPETIT 59 : BY=(BETA(KB,2)-1.D0)*LOG(UY) 60 : ABY=ABS(BY) 61 : IF(ABY.LE.XPETIT)THEN 62 : UY=1.D0 63 : ELSE 64 : UY=EXP(BY) 65 : ENDIF 66 : FF1=COEF(KK,1)*UX*UXN*DRR(I,K) 67 : FF2=COEF(KK,2)*UY*UYN*DRR(I,K) 68 : F(NF,1)=F(NF,1)+FF1 69 : F(NF,2)=F(NF,2)+FF2 70 : 502 CONTINUE 71 : 72 : ELSE 73 : DO 402 K=1,NEL 74 : NK=K+K0 75 : KK=1+(1-IKK)*(NK-1) 76 : KB=1+(1-IKB)*(NK-1) 77 : 78 : DO 402 I=1,NP 79 : NF=IPADL(LE(I,K)) 80 : KV=1+(1-IKV)*(NF-1) 81 : 82 : UXNE=-V0(KV,1) 83 : UXNI=UN(NF,1) 84 : UXN =UN(NF,1)-V0(KV,1) 85 : UX=ABS(UXN)+XPETIT 86 : BX=(BETA(KB,1)-1.D0)*LOG(UX) 87 : ABX=ABS(BX) 88 : IF(ABX.LE.XPETIT)THEN 89 : UX=1.D0 90 : ELSE 91 : UX=EXP(BX) 92 : ENDIF 93 : 94 : UYNE=-V0(KV,2) 95 : UYNI=UN(NF,2) 96 : UYN =UN(NF,2)-V0(KV,2) 97 : UY=ABS(UYN)+XPETIT 98 : BY=(BETA(KB,2)-1.D0)*LOG(UY) 99 : ABY=ABS(BY) 100 : IF(ABY.LE.XPETIT)THEN 101 : UY=1.D0 102 : ELSE 103 : UY=EXP(BY) 104 : ENDIF 105 : 106 : FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K) 107 : c il semble qu'il y ait une erreur sur le terme 108 : c FFI1 mis en commentaire. On le remplace par 109 : c l'expression suivante. 110 : c FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K) 111 : FFI1=COEF(KK,1)*UX*DRR(I,K) 112 : FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K) 113 : c il semble qu'il y ait une erreur sur le terme 114 : c FFI2 mis en commentaire. On le remplace par 115 : c l'expression suivante. 116 : c FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K) 117 : FFI2=COEF(KK,2)*UY*DRR(I,K) 118 : F(NF,1)=F(NF,1)+FFE1 119 : F(NF,2)=F(NF,2)+FFE2 120 : F1(NF,1)=F1(NF,1)+FFI1 121 : F1(NF,2)=F1(NF,2)+FFI2 122 : 402 CONTINUE 123 : 124 : ENDIF 125 : 126 : C 127 : C ******* 128 : C * 3 D * 129 : C ******* 130 : C 131 : ELSE 132 : 133 : IF(KIMPL.EQ.0)THEN 134 : 135 : DO 503 K=1,NEL 136 : NK=K+K0 137 : KK=1+(1-IKK)*(NK-1) 138 : KB=1+(1-IKB)*(NK-1) 139 : 140 : DO 503 I=1,NP 141 : NF=IPADL(LE(I,K)) 142 : KV=1+(1-IKV)*(NF-1) 143 : UXN=UN(NF,1)-V0(KV,1) 144 : UX=ABS(UXN)+XPETIT 145 : BX=(BETA(KB,1)-1.D0)*LOG(UX) 146 : ABX=ABS(BX) 147 : IF(ABX.LE.XPETIT)THEN 148 : UX=1.D0 149 : ELSE 150 : UX=EXP(BX) 151 : ENDIF 152 : UYN=UN(NF,2)-V0(KV,2) 153 : UY=ABS(UYN)+XPETIT 154 : BY=(BETA(KB,2)-1.D0)*LOG(UY) 155 : ABY=ABS(BY) 156 : IF(ABY.LE.XPETIT)THEN 157 : UY=1.D0 158 : ELSE 159 : UY=EXP(BY) 160 : ENDIF 161 : UZN=UN(NF,3)-V0(KV,3) 162 : UZ=ABS(UZN)+XPETIT 163 : BZ=(BETA(KB,3)-1.D0)*LOG(UZ) 164 : ABZ=ABS(BZ) 165 : IF(ABZ.LE.XPETIT)THEN 166 : UZ=1.D0 167 : ELSE 168 : UZ=EXP(BZ) 169 : ENDIF 170 : FF1=COEF(KK,1)*UX*UXN*DRR(I,K) 171 : FF2=COEF(KK,2)*UY*UYN*DRR(I,K) 172 : FF3=COEF(KK,3)*UZ*UZN*DRR(I,K) 173 : F(NF,1)=F(NF,1)+FF1 174 : F(NF,2)=F(NF,2)+FF2 175 : F(NF,3)=F(NF,3)+FF3 176 : 503 CONTINUE 177 : 178 : ELSE 179 : DO 403 K=1,NEL 180 : NK=K+K0 181 : KK=1+(1-IKK)*(NK-1) 182 : KB=1+(1-IKB)*(NK-1) 183 : 184 : DO 403 I=1,NP 185 : NF=IPADL(LE(I,K)) 186 : 187 : KV=1+(1-IKV)*(NF-1) 188 : UXNE=-V0(KV,1) 189 : UXNI=UN(NF,1) 190 : UXN =UN(NF,1)-V0(KV,1) 191 : UX=ABS(UXN)+XPETIT 192 : BX=(BETA(KB,1)-1.D0)*LOG(UX) 193 : ABX=ABS(BX) 194 : IF(ABX.LE.XPETIT)THEN 195 : UX=1.D0 196 : ELSE 197 : UX=EXP(BX) 198 : ENDIF 199 : 200 : UYNE=-V0(KV,2) 201 : UYNI=UN(NF,2) 202 : UYN =UN(NF,2)-V0(KV,2) 203 : UY=ABS(UYN)+XPETIT 204 : BY=(BETA(KB,2)-1.D0)*LOG(UY) 205 : ABY=ABS(BY) 206 : IF(ABY.LE.XPETIT)THEN 207 : UY=1.D0 208 : ELSE 209 : UY=EXP(BY) 210 : ENDIF 211 : 212 : UZNE=-V0(KV,3) 213 : UZNI=UN(NF,3) 214 : UZN =UN(NF,3)-V0(KV,3) 215 : UZ=ABS(UZN)+XPETIT 216 : BZ=(BETA(KB,3)-1.D0)*LOG(UZ) 217 : ABZ=ABS(BZ) 218 : IF(ABZ.LE.XPETIT)THEN 219 : UZ=1.D0 220 : ELSE 221 : UZ=EXP(BZ) 222 : ENDIF 223 : 224 : FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K) 225 : c il semble qu'il y ait une erreur sur le terme 226 : c FFI1 mis en commentaire. On le remplace par 227 : c l'expression suivante. 228 : c FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K) 229 : FFI1=COEF(KK,1)*UX*DRR(I,K) 230 : FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K) 231 : c il semble qu'il y ait une erreur sur le terme 232 : c FFI2 mis en commentaire. On le remplace par 233 : c l'expression suivante. 234 : c FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K) 235 : FFI2=COEF(KK,2)*UY*DRR(I,K) 236 : FFE3=COEF(KK,3)*UZ*UZNE*DRR(I,K) 237 : c il semble qu'il y ait une erreur sur le terme 238 : c FFI3 mis en commentaire. On le remplace par 239 : c l'expression suivante. 240 : c FFI3=COEF(KK,3)*UZ*UZNI*DRR(I,K) 241 : FFI3=COEF(KK,3)*UZ*DRR(I,K) 242 : F(NF,1)=F(NF,1)+FFE1 243 : F(NF,2)=F(NF,2)+FFE2 244 : F(NF,3)=F(NF,3)+FFE3 245 : F1(NF,1)=F1(NF,1)+FFI1 246 : F1(NF,2)=F1(NF,2)+FFI2 247 : F1(NF,3)=F1(NF,3)+FFI3 248 : 403 CONTINUE 249 : 250 : ENDIF 251 : 252 : ENDIF 253 : 254 : 255 : RETURN 256 : 1001 FORMAT(20(1X,I5)) 257 : 1002 FORMAT(10(1X,1PE11.4)) 258 : END 259 : 260 : 261 : 262 : 263 :
© Cast3M 2003 - All rights reserved.
Disclaimer