1 : C KFN SOURCE NC 08/05/29 21:15:05 6112 2 : SUBROUTINE KFN (IFACFO,INOR,KIMP) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C---------------------------------------------------------------------- 6 : C IMPRESSION , NORMALISATION ET SYMETRISATION DES FACTEURS DE FORME 7 : C entrée et sortie ; 8 : C IFACFO : POINTEUR SUR L OBJET SFACFOR (FACTEURS DE FORME) 9 : C entrée : 10 : C INOR : SI 0 PAS DE NORMALISATION 11 : C KIMP : parametre d'impression 12 : C---------------------------------------------------------------------- 13 : C FACTEURS DE FORME 14 : C NNBEL1 = NOMBRE DE LIGNES + 1 15 : C NBEL2 = NOMBRE DE COLONNES 16 : C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES 17 : C 18 : SEGMENT IFACFO 19 : INTEGER LFACT(NNBEL1) 20 : ENDSEGMENT 21 : SEGMENT LFAC 22 : REAL*8 FACT(NBEL2) 23 : ENDSEGMENT 24 : POINTEUR PSUR.LFAC, PLIG.LFAC 25 : POINTEUR IFACF1.IFACFO,IFACF2.IFACFO 26 : POINTEUR LF1.LFAC,LF2.LFAC 27 : C---------------------------------------------------------------------- 28 : C OBJETS POUR L EVALUATION DES BILANS ET SYMETRISATION 29 : SEGMENT,PSOM 30 : REAL*8 SOM(N2),EBL 31 : ENDSEGMENT 32 : SEGMENT,PTRA 33 : REAL*8 TRA(N2),ESM 34 : ENDSEGMENT 35 : C---------------------------------------------------------------------- 36 : C 37 : KIMP0=0 38 : C 39 : C NOMBRE D ITERATION MAX 40 : NK=30 41 : C 42 : C CRITERE POUR NORMALISER : ERREUR LES BILANS 43 : EBILAN=0.2 44 : C CRITERE D'IMPRESSION : ERREUR LES BILANS 45 : EBIMPR=0.1 46 : 47 : C 48 : C>>> ACTIVATION DE L OBJET SFACFOR 49 : C 50 : SEGACT IFACFO 51 : N1= LFACT(/1) 52 : PSUR=LFACT(N1) 53 : SEGACT PSUR 54 : N2 = N1 - 1 55 : DO 1 L1 = 1,N2 56 : LFAC= LFACT(L1) 57 : SEGACT LFAC*MOD 58 : 1 CONTINUE 59 : 60 : SEGINI PSOM, PTRA 61 : 61 : CALL KFANAL(IFACFO,PSOM,1,PTRA,1,KIMP,KIMP) 62 : 63 : KBIL=0 64 : DO 2 I=1,N2 65 : IF (DABS(SOM(I)).GE.EBIMPR) THEN 66 : IF (DABS(SOM(I)).GE.EBILAN) THEN 67 : KBIL=1 68 : ENDIF 69 : IF ((INOR.NE.0).AND.(KIMP.GE.1)) THEN 70 : WRITE(6,1004) I,DABS(SOM(I)) 71 : 1004 FORMAT(1X,'ELEMENT ',I4, 72 : # ' ERREUR ABSOLUE SUR LE BILAN ',E9.3) 73 : ENDIF 74 : ENDIF 75 : 2 CONTINUE 76 : C 77 : IF (INOR.NE.0) THEN 78 : IF (KBIL.EQ.1) THEN 79 : C>>> PAS DE NORMALISATION --------------------------------------- 80 : WRITE(6,*) ' CAVITE NON FERMEE OU BILAN VERFIE A PLUS DE 20 81 : $% : PAS DE NORMALISATION ' 82 : ELSE 83 : C 84 : C>>> ON NORMALISE ----------------------------------------------- 85 : C 86 : IFACF1=IFACFO 87 : 88 : C IFACF1 :OBJET DE DEPART 89 : C IFACF2 :OBJET CORRIGE 90 : C 91 : NNBEL1 = N1 92 : NBEL2 = N2 93 : SEGINI IFACFO 94 : C 95 : DO 900 L1=1,NNBEL1 96 : LF1=IFACF1.LFACT(L1) 97 : SEGINI PLIG 98 : LFACT(L1) = PLIG 99 : DO 901 L2=1,NBEL2 100 : PLIG.FACT(L2)=LF1.FACT(L2) 101 : 901 CONTINUE 102 : C! 103 : SEGDES LF1 104 : C! 105 : C 106 : 900 CONTINUE 107 : C 108 : IFACF2=IFACFO 109 : C!! 110 : SEGDES IFACF1 111 : PSUR=LFACT(N1) 112 : C!! 113 : 114 : C-----ITERATIONS------------------------------------ 115 : 116 : DO 100 K=1,NK 117 : C 118 : C>>> SYMETRISATION 119 : C 120 : 121 : DO 20 L1 = 1,N2 122 : 123 : S1=PSUR.FACT(L1) 124 : LF1=LFACT(L1) 125 : DO 21 L2 = 1,N2 126 : LF2=LFACT(L2) 127 : S2=PSUR.FACT(L2) 128 : IF (L2.LT.L1) THEN 129 : FF=0.5*(S1*LF1.FACT(L2)+S2*LF2.FACT(L1)) 130 : LF1.FACT(L2)=FF/S1 131 : LF2.FACT(L1)=FF/S2 132 : ENDIF 133 : 21 CONTINUE 134 : 20 CONTINUE 135 : C 135 : CALL KFANAL(IFACF2,PSOM,1,PTRA,0,KIMP0,KIMP0) 136 : 137 : C 138 : C>>> NORMALISATION 139 : C 140 : DO 10 L1 = 1,N2 141 : LF1=LFACT(L1) 142 : S2=0.D0 143 : DO 12 L2= 1,N2 144 : S2=S2+LF1.FACT(L2) 145 : 12 CONTINUE 146 : DO 13 L2= 1,N2 147 : LF1.FACT(L2)=LF1.FACT(L2) / S2 148 : 13 CONTINUE 149 : 10 CONTINUE 150 : 150 : CALL KFANAL(IFACF2,PSOM,0,PTRA,1,KIMP0,KIMP0) 151 : IF (KIMP.GE.1) THEN 152 : WRITE(6,1000) K,EBL,ESM 153 : 1000 FORMAT(1X,'ITER',I2,' ERREURS REL MAX: BILAN ET SYMETRIE',2E9.3) 154 : ENDIF 155 : C 156 : C>>> CONVERGENCE A PRIORI 157 : C 158 : IF (EBL.LE.1.E-2.AND.ESM.LE.1.E-2) THEN 158 : CALL KFANAL(IFACF2,PSOM,1,PTRA,1,KIMP,KIMP) 159 : 160 : C ON GARDE LA SOLUTION CORRIGEE ON DETRUIT L'OBJET DE DEPART 161 : 162 : C!! 163 : SEGACT IFACF1 164 : C!! 165 : DO 950 L1=1,N1 166 : LF1=IFACF1.LFACT(L1) 167 : SEGSUP LF1 168 : LF2 = IFACF2.LFACT(L1) 169 : SEGDES LF2 170 : 950 CONTINUE 171 : SEGSUP IFACF1 172 : IFACFO=IFACF2 173 : C 174 : C>>> DESACTIVATION DE L OBJET SFACFOR 175 : C 176 : SEGDES IFACFO 177 : SEGSUP PSOM, PTRA 178 : RETURN 179 : C 180 : ENDIF 181 : 182 : 100 CONTINUE 183 : C-----ITERATIONS--FIN------------------------------- 184 : C 185 : WRITE(6,*) ' LA NORMALISATION N A PAS CONVERGÉ ' 186 : C ON GARDE L'OBJET DE DEPART ON DETRUIT l'OBJET CORRIGE 187 : C 188 : DO 975 L1=1,N1 189 : LF2 = IFACF2.LFACT(L1) 190 : SEGSUP LF2 191 : 975 CONTINUE 192 : SEGSUP IFACF2 193 : IFACFO=IFACF1 194 : C! 195 : SEGACT IFACFO 196 : C! 197 : ENDIF 198 : ENDIF 199 : 200 : DO 980 L1=1,N1 201 : LF1=IFACFO.LFACT(L1) 202 : SEGDES LF1 203 : 980 CONTINUE 204 : SEGDES IFACFO 205 : SEGSUP PSOM,PTRA 206 : C 207 : RETURN 208 : END 209 : 210 : 211 :
© Cast3M 2003 - All rights reserved.
Disclaimer