1 : C NORMA3 SOURCE CHAT 05/01/13 01:59:59 5004 2 : SUBROUTINE NORMA3(ICHPOI,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,IPLAC1, 3 : 1 PGRAND) 4 : ************************************************************************ 5 : * 6 : * N O R M A 3 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * NORMER UN 'CHPOINT EN RAMENANT SA PLUS GRANDE VALEUR A 1 13 : * ON NE CREE PAS UN NOUVEAU CHPOINT 14 : * 15 : * MODE D'APPEL: 16 : * ------------- 17 : * 17 : * CALL NORMA3 (ICHPOI,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,IPLAC1,PGRAND 18 : * 19 : * ARGUMENTS: (E)=ENTREE (S)=SORTIE 20 : * ---------- 21 : * 22 : * ICHPOI ENTIER (E) POINTEUR SUR L'OBJET 'CHPOINT' A NORMER. 23 : * IPLMOT ENTIER (E) VOIR LE S.P. "MAXIM1". 24 : * MOTCLE CHARACTER (E) VOIR LE S.P. "MAXIM1". 25 : * IFLUI ENTIER (E) IL Y A DES COEF POUR P ET PI (0 SINON) 26 : * COEFP REEL (E) COEFFICIENT A APPLIQUER A LA COMPOSANTE P 27 : * COEFPI REEL (E) COEFFICIENT A APPLIQUER A LA COMPOSANTE PI 28 : * IPLAC1 ENTIER (E) POINTEUR SUR SEGMENT MTEMP2 OU ZERO(0) 29 : * PGRAND REEL (S) COEFFICIENT DE NORMALISATION 30 : * 31 : * SOUS-PROGRAMMES APPELES: 32 : * ------------------------ 33 : * 34 : * MAXIM4,MAXIM1, ERREUR. 35 : * 36 : * AUTEUR, DATE DE CREATION: 37 : * ------------------------- 38 : * 39 : * MARTINE FARVACQUE 10 JUIN 86 40 : * 41 : * LANGAGE: 42 : * -------- 43 : * 44 : * ESOPE + FORTRAN77 45 : * 46 : ************************************************************************ 47 : * 48 : IMPLICIT INTEGER(I-N) 49 : -INC CCOPTIO 50 : -INC SMCHPOI 51 : * 52 : SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC) 53 : * (REMPLI DANS LE S.P. "MAXIM1") 54 : * 55 : REAL*8 PGRAND,COEFP,COEFPI 56 : CHARACTER*4 MOTCLE 57 : * 58 : * --- NORMALISATION DU FLUIDE 58 : IF(IFLUI.NE.0) CALL MAXIM4 (ICHPOI,COEFP,COEFPI) 59 : * 60 : * -- RECHERCHE DU MAXIMUM -- 61 : IF(IPLAC1.EQ.0) THEN 62 : SEGINI MTEMP2 63 : ELSE 64 : MTEMP2=IPLAC1 65 : SEGACT MTEMP2*MOD 66 : MAXSOU=0 67 : MAXN=0 68 : MAXNC=0 69 : ENDIF 70 : * 70 : CALL MAXIM1 (ICHPOI,IPLMOT,MOTCLE,MTEMP2, PGRAND) 71 : IF (IERR .NE. 0) RETURN 72 : IF (PGRAND .EQ. 0.D0) THEN 73 : NUMERR = 150 73 : CALL ERREUR (NUMERR) 74 : RETURN 75 : END IF 76 : * 77 : * -- NORMALISATION -- 78 : * 79 : 80 : SEGACT,MTEMP2 81 : * 82 : MCHPOI=ICHPOI 83 : SEGACT MCHPOI 84 : NSOUPO = IPCHP(/1) 85 : * 86 : DO 100 IB100=1,NSOUPO 87 : * 88 : MSOUPO = IPCHP(IB100) 89 : SEGACT MSOUPO 90 : NC = NOCOMP(/2) 91 : MPOVAL = IPOVAL 92 : SEGACT MPOVAL*MOD 93 : N = VPOCHA(/1) 94 : * 95 : DO 120 IB120=1,NC 96 : DO 130 IB130=1,N 97 : VPOCHA(IB130,IB120) = VPOCHA(IB130,IB120) / PGRAND 98 : 130 CONTINUE 99 : 120 CONTINUE 100 : IF(IB100 .EQ. MAXSOU) VPOCHA(MAXN,MAXNC) = 1.D0 101 : * 102 : SEGDES,MPOVAL,MSOUPO 103 : * 104 : 100 CONTINUE 105 : * 106 : IF(IPLAC1.EQ.0) SEGSUP MTEMP2 107 : SEGDES,MCHPOI 108 : RETURN 109 : END 110 : 111 :
© Cast3M 2003 - All rights reserved.
Disclaimer