1 : C NORME2 SOURCE CHAT 05/01/13 02:00:22 5004 2 : SUBROUTINE NORME2 (IPX,XNORM2,IPRR,IPY,YNORM2,IPLMOX, 3 : C IPLMOY,IPRX) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * N O R M E 2 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * 14 : * MODIFIER PAR UN COEFFICIENT DE PROPORTIONALITE UN 'CHPOINT' POUR 15 : * QUE SA "NORME AU CARRE" VAILLE +/- "XNORM2". 16 : * 17 : * MODE D'APPEL: 18 : * ------------- 19 : * 19 : * CALL NORME2 (IPX,XNORM2,IPRR,IPY,YNORM2) 20 : * 21 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 22 : * ----------- 23 : * 24 : * IPX ENTIER (E) POINTEUR DU 'CHPOINT' A MODIFIER. 25 : * XNORM2 REEL DP (E) VALEUR DESIREE POUR LA "NORME AU CARRE". 26 : * IPRR ENTIER (E) POINTEUR DE LA 'RIGIDITE' SERVANT A 27 : * "NORMER". 28 : * IPY ENTIER (S) POINTEUR DU 'CHPOINT' MODIFIE. 29 : * YNORM2 REEL DP (S) VALEUR DE LA "NORME AU CARRE" DU 'CHPOINT' 30 : * DE POINTEUR "IPY". 31 : * 32 : * REMARQUES: 33 : * ---------- 34 : * 35 : * LA "NORME AU CARRE" EST DEFINIE PAR "XT.RR.X" 36 : * 37 : * SI L'ON ECRIT "NORME AU CARRE" ENTRE GUILLEMETS, C'EST PARCE 38 : * QU'IL NE S'AGIT PAS D'UNE VERITABLE NORME SI "RR" N'EST PAS 39 : * DEFINIE POSITIVE. 40 : * 41 : * LA VARIABLE "YNORM2" EXISTE PRECISEMENT POUR INDIQUER SI L'ON A 42 : * BIEN OBTENU "XNORM2" POUR NORME AU CARRE ET NON PAS "-XNORM2". 43 : * ELLE MET EGALEMENT EN EVIDENCE LES ERREURS D'ARRONDI. 44 : * 45 : * SOUS-PROGRAMMES APPELES: 46 : * ------------------------ 47 : * 48 : * MUCHPO, XTMX. 49 : * 50 : * AUTEUR, DATE DE CREATION: 51 : * ------------------------- 52 : * 53 : * PASCAL MANIGOT 17 AVRIL 1985 54 : * 55 : * LANGAGE: 56 : * -------- 57 : * 58 : * FORTRAN77 59 : * 60 : ************************************************************************ 61 : * 62 : -INC CCOPTIO 63 : * 64 : * 65 : IPRX=0 66 : IPRRX=0 67 : IF((IPLMOX*IPLMOY).EQ.0) GOTO 10 67 : CALL MUCPRI(IPX,IPRR,IPRRX) 67 : CALL XTY1(IPX,IPRRX,IPLMOX,IPLMOY,XTRRX) 68 : GOTO 20 68 : 10 CALL XTMX (IPX,IPRR, XTRRX) 69 : IF (IERR .NE. 0) RETURN 70 : 20 CONTINUE 71 : * 72 : COEFF = SQRT( ABS(XNORM2 / XTRRX) ) 73 : MULTPL = 1 73 : CALL MUCHPO (IPX,COEFF, IPY,MULTPL) 74 : IF (IERR .NE. 0) RETURN 75 : IF(IPRRX.EQ.0) GOTO 30 75 : CALL MUCHPO (IPRRX,COEFF,IPRX,MULTPL) 75 : CALL DTCHPO(IPRRX) 76 : * 77 : 30 CONTINUE 78 : YNORM2 = ABS(XNORM2/XTRRX) * XTRRX 79 : IF (IERR .NE. 0) RETURN 80 : IF (IIMPI .EQ. 627) THEN 81 : WRITE (IOIMP,*) 'ON DOIT AVOIR ',YNORM2,' = +/- ',XNORM2 82 : END IF 83 : * 84 : END 85 :
© Cast3M 2003 - All rights reserved.
Disclaimer