1 : C PUCHPR SOURCE BP208322 12/05/24 21:15:04 7378 2 : 3 : SUBROUTINE PUCHPR(IPO1,XPU,IPO2,IRET) 4 : 5 : C======================================================================= 6 : C 7 : C ENTREES 8 : C IPO1=POINTEUR SUR LE CHAMPOINT 9 : C XPU =PUISSANCE ( C EST UN REEL POSITIF OU NEGATIF ) 10 : C SORTIES 11 : C IPO2=CHPOINT A LA PUISSANCE IPU 12 : C IRET=1 13 : C =0 SI UNE COMPOSANTE EST NEGATIVE 14 : C 15 : C CODE EBERSOLT AVRIL 85 16 : C 17 : C======================================================================= 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT REAL*8(A-H,O-Z) 20 : C 21 : -INC SMCHPOI 22 : C 23 : IRET=1 24 : C 25 : MCHPO1=IPO1 26 : * 27 : * INITIALISATION DU CHAPEAU DU SEGMENT 28 : * 29 : SEGINI,MCHPOI=MCHPO1 30 : NSOUPO=IPCHP(/1) 31 : 32 : C ON ORIENTE SELON LA VALEUR DE XPU (PERFORMANCES) 33 : if(XPU.eq.0.5d0) goto 100 34 : 35 : 36 : c---------------------------------------------------------------------- 37 : c Cas général Y**XPU 38 : 39 : DO 40 IA=1,NSOUPO 40 : MSOUP1=IPCHP(IA) 41 : SEGINI,MSOUPO=MSOUP1 42 : IPCHP(IA)=MSOUPO 43 : MPOVA1=IPOVAL 44 : SEGINI,MPOVAL=MPOVA1 45 : IPOVAL=MPOVAL 46 : N =VPOCHA(/1) 47 : NC=VPOCHA(/2) 48 : DO 60 IC=1,NC 49 : DO 60 IB=1,N 50 : XTRA=VPOCHA(IB,IC) 51 : IF (XTRA.GT.0.) THEN 52 : VPOCHA(IB,IC)=XTRA ** XPU 53 : ELSE 54 : VPOCHA(IB,IC)=0. 55 : IF (XTRA.LT.0.) IRET=0 56 : ENDIF 57 : 60 CONTINUE 58 : SEGDES MPOVAL 59 : SEGDES MSOUPO 60 : 40 CONTINUE 61 : GOTO 999 62 : 63 : c---------------------------------------------------------------------- 64 : c Cas : Y**0.5 65 : 100 CONTINUE 66 : 67 : DO 140 IA=1,NSOUPO 68 : MSOUP1=IPCHP(IA) 69 : SEGINI,MSOUPO=MSOUP1 70 : IPCHP(IA)=MSOUPO 71 : MPOVA1=IPOVAL 72 : SEGINI,MPOVAL=MPOVA1 73 : IPOVAL=MPOVAL 74 : N =VPOCHA(/1) 75 : NC=VPOCHA(/2) 76 : DO 160 IC=1,NC 77 : DO 160 IB=1,N 78 : XTRA=VPOCHA(IB,IC) 79 : IF (XTRA.GT.0.) THEN 80 : VPOCHA(IB,IC)=sqrt(XTRA) 81 : ELSE 82 : VPOCHA(IB,IC)=0. 83 : IF (XTRA.LT.0.) IRET=0 84 : ENDIF 85 : 160 CONTINUE 86 : SEGDES MPOVAL 87 : SEGDES MSOUPO 88 : 140 CONTINUE 89 : GOTO 999 90 : 91 : 92 : c---------------------------------------------------------------------- 93 : c FIN DU PROGRAMME 94 : 999 CONTINUE 95 : SEGDES MCHPOI 96 : C 97 : IF (IRET.NE.0) THEN 98 : IPO2=MCHPOI 99 : ELSE 100 : SEGSUP,MCHPOI 101 : IPO2=0 102 : ENDIF 103 : C 104 : RETURN 105 : END 106 : 107 : 108 :
© Cast3M 2003 - All rights reserved.
Disclaimer