1 : C KFANAL SOURCE NC 08/05/29 21:15:00 6112 2 : SUBROUTINE KFANAL (IFACFO,PSOM,KBIL,PTRA,KSYM,LIMP,LIMP2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C---------------------------------------------------------------------- 6 : C CALCUL DES ERREURS SUR LE BILAN ET LA SYMETRIE 7 : C SP APPELE PAR KFN 8 : C 9 : C entrée: 10 : C IFACFO : POINTEUR SUR L OBJET SFACFOR (SUPPOSE ACTIVE) 11 : C ------ 12 : C KBIL = 1 calcul des bilans 13 : C KSYM = 1 calcul de la symétrie 14 : C 15 : C LIMP : PARAMETRE IMPRESSION GENERAL 16 : C SI GE.1 ON IMPRIME LES LES VALEURS GLOBALES EBL ET ESM 17 : C LIMP2: DETAILS 18 : C SI GE.2 VALEURS RELATIVE AU MAX PAR LIGNE 19 : C SI GE.3 TOUT Y COMPRIS LES FACTEURS DE FORME 20 : C 21 : C sortie : 22 : C PSOM : OBJET ASSOCIE AU BILAN 23 : C EBL REPRESENTE LE MAX DE L ERREUR SUR LES BILANS 24 : C PTRA : OBJET ASSOCIE A LA SYMETRIE 25 : C ESM REPRESENTE LE MAX DE L ERREUR SUR LA SYMETRIE 26 : C---------------------------------------------------------------------- 27 : C FACTEURS DE FORME 28 : C NNBEL1 = NOMBRE DE LIGNES + 1 29 : C NBEL2 = NOMBRE DE COLONNES 30 : C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES 31 : C 32 : SEGMENT IFACFO 33 : INTEGER LFACT(NNBEL1) 34 : ENDSEGMENT 35 : SEGMENT LFAC 36 : REAL*8 FACT(NBEL2) 37 : ENDSEGMENT 38 : POINTEUR PSUR.LFAC, PLIG.LFAC 39 : POINTEUR PCOL.LFAC 40 : C---------------------------------------------------------------------- 41 : SEGMENT,PSOM 42 : REAL*8 SOM(N2),EBL 43 : ENDSEGMENT 44 : SEGMENT,PTRA 45 : REAL*8 TRA(N2),ESM 46 : ENDSEGMENT 47 : C---------------------------------------------------------------------- 48 : C 49 : N2 = LFACT(/1)-1 50 : PSUR=LFACT(N2+1) 51 : 51 : CALL UTINIV(TRA,N2) 52 : 53 : C>>> VERIFICATION DE SYMETRIE 54 : C ------------------------ 55 : 56 : IF (KSYM.EQ.1) THEN 57 : 58 : 59 : DO 800 K1=1,N2 60 : PLIG=LFACT(K1) 61 : C> SEGACT PLIG 61 : CALL UTINIV(SOM,N2) 62 : DO 801 K2=1,N2 63 : IF (K2.NE.K1) THEN 64 : PCOL=LFACT(K2) 65 : C> SEGACT PCOL 66 : IF (PLIG.FACT(K2).GE.1E-6.AND.PCOL.FACT(K1).GE.1E-6) THEN 67 : SOM(K2) = PSUR.FACT(K1)*PLIG.FACT(K2) 68 : SOM(K2) = SOM(K2) - PSUR.FACT(K2)*PCOL.FACT(K1) 69 : SOM(K2) = SOM(K2)/PLIG.FACT(K2)/PSUR.FACT(K1) 70 : ENDIF 71 : C> SEGDES PCOL 72 : ENDIF 73 : 801 CONTINUE 73 : CALL UTMXV(SOM,N2,TRA(K1)) 74 : IF (LIMP2.GE.4) THEN 75 : WRITE(6,*) ' FIJ LIGNE ',K1 75 : CALL UTPRIM(PLIG.FACT,N2) 76 : ENDIF 77 : IF (LIMP2.GE.4) THEN 78 : WRITE(6,*) ' SYMETRIE ',K1 78 : CALL UTPRIM(SOM,N2) 79 : ENDIF 80 : C> SEGDES PLIG 81 : 800 CONTINUE 81 : CALL UTMXV(TRA,N2,ESM) 82 : 83 : IF (LIMP2.GE.2) THEN 84 : WRITE(6,*) 85 : WRITE(6,*) 'SYMETRIE : ECART RELATIF MAXIMAL PAR LIGNE ' 85 : CALL UTPRIM(TRA,N2) 86 : ENDIF 87 : IF(LIMP.GE.1) THEN 88 : WRITE(6,1001) ESM 89 : 1001 FORMAT(1X,'SYMETRIE : ECART RELATIF MAXIMAL GLOBAL ',E12.5) 90 : ENDIF 91 : 92 : ENDIF 93 : 94 : 95 : IF (KBIL.EQ.1) THEN 96 : 97 : C 98 : C>>> CALCUL DES BILANS ET IMPRESSION EVENTUELLE 99 : C ------------------------------------------ 100 : C 101 : DO 500 K1 = 1,N2 102 : SOM(K1) = 0. 103 : PLIG = LFACT(K1) 104 : C> SEGACT PLIG 105 : DO 501 K2=1,N2 106 : SOM(K1) = SOM(K1) + PLIG.FACT(K2) 107 : 501 CONTINUE 108 : C> SEGDES PLIG 109 : 500 CONTINUE 110 : 111 : IF (LIMP2.GE.2) THEN 112 : WRITE(6,*) 113 : WRITE(6,*) 'BILAN ' 113 : CALL UTPRIM(SOM,N2) 114 : ENDIF 115 : 116 : DO 502 K1 =1,N2 117 : SOM(K1) = SOM(K1) - 1.D0 118 : 502 CONTINUE 118 : CALL UTMXV(SOM,N2,EBL) 119 : 120 : IF (LIMP.GE.1) THEN 121 : WRITE(6,1000) EBL 122 : 1000 FORMAT(1X,'BILAN : ECART MAXIMAL ',E12.5) 123 : ENDIF 124 : 125 : ENDIF 126 : 127 : 128 : RETURN 129 : END 130 : 131 :
© Cast3M 2003 - All rights reserved.
Disclaimer