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