1 : C PUCHEL SOURCE BP208322 10/12/15 21:15:29 6813 2 : SUBROUTINE PUCHEL(IPCHE1,IPU,IPCHPU,IRET) 3 : *_______________________________________________________________________ 4 : * 5 : * ELEVATION A UNE PUISSANCE ENTIERE D'UN CHAMELEM 6 : * 7 : * ENTREES : 8 : * --------- 9 : * 10 : * IPCHE1 POINTEUR SUR LE CHAMPS PAR ELEMENT A ELEVER A LA PUISSANC 11 : * IPU 12 : * IPU PUISSANCE ( C EST UN ENTIER POSITIF OU NEGATIF ) 13 : * 14 : * 15 : * SORTIES : 16 : * --------- 17 : * 18 : * IPCHPU POINTEUR SUR LE CHAMELEM RESULTANT 19 : * IRET=1 20 : * =0 SI OPERATION IMPOSSSIBLE 21 : * 22 : * CODE EBERSOLT AVRIL 85 23 : * 24 : * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90 25 : * 26 : *_______________________________________________________________________ 27 : * 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : IMPLICIT INTEGER(I-N) 30 : -INC SMCHAML 31 : -INC CCOPTIO 32 : -INC SMLREEL 33 : -INC SMEVOLL 34 : * 35 : IRET=1 36 : MCHEL1=IPCHE1 37 : * 38 : * INITIALISATION DU CHAPEAU DU SEGMENT 39 : * 40 : SEGINI,MCHELM=MCHEL1 41 : IPCHPU=MCHELM 42 : * 43 : * BOUCLE SUR LES SOUS ZONES 44 : * 45 : DO 30 ISOUS=1,ICHAML(/1) 46 : MCHAM1=ICHAML(ISOUS) 47 : SEGINI,MCHAML=MCHAM1 48 : ICHAML(ISOUS)=MCHAML 49 : DO 40 ICOMP=1,IELVAL(/1) 50 : MELVA1=IELVAL(ICOMP) 51 : SEGINI,MELVAL=MELVA1 52 : IELVAL(ICOMP)=MELVAL 53 : IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN 54 : N1PTEL=VELCHE(/1) 55 : N1EL =VELCHE(/2) 56 : DO 20 IGAU=1,N1PTEL 57 : DO 20 IB=1,N1EL 58 : XTRA=VELCHE(IGAU,IB) 59 : VELCHE(IGAU,IB)=XTRA ** IPU 60 : 20 CONTINUE 61 : ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN 62 : N2PTEL=IELCHE(/1) 63 : N2EL =IELCHE(/2) 64 : DO 10 IGAU=1,N2PTEL 65 : DO 10 IB=1,N2EL 66 : MLREE1=IELCHE(IGAU,IB) 67 : SEGACT MLREE1 68 : JG=MLREE1.PROG(/1) 69 : SEGINI MLREEL 70 : DO 11 IPROG=1,JG 71 : XTRA=MLREE1.PROG(IPROG) 72 : PROG(IPROG)=XTRA ** IPU 73 : 11 CONTINUE 74 : IELCHE(IGAU,IB)=MLREEL 75 : SEGDES MLREE1,MLREEL 76 : 10 CONTINUE 77 : ELSE IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') THEN 78 : N2PTEL=IELCHE(/1) 79 : N2EL =IELCHE(/2) 80 : DO 12 IGAU=1,N2PTEL 81 : DO 12 IB=1,N2EL 82 : MEVOL1=IELCHE(IGAU,IB) 83 : c XFLO=REAL(IPU) 84 : IRET=1 84 : CALL PUEVOL(MEVOL1,0.D0,IPU,MEVOL2,IRET) 85 : IELCHE(IGAU,IB)=MEVOL2 86 : 12 CONTINUE 87 : ELSE 88 : * 89 : * NOM DE COMPOSANTE NON RECONNU 90 : * 91 : MOTERR(1:4)='** ' 92 : MOTERR(5:8)=NOMCHE(ICOMP) 92 : CALL ERREUR(335) 93 : SEGSUP MELVAL,MCHAML,MCHELM 94 : IPCHPU=0 95 : RETURN 96 : ENDIF 97 : SEGDES MELVAL 98 : 40 CONTINUE 99 : SEGDES MCHAML 100 : 30 CONTINUE 101 : SEGDES MCHELM 102 : RETURN 103 : END 104 : 105 : 106 : 107 : 108 : 109 :
© Cast3M 2003 - All rights reserved.
Disclaimer