1 : C SUGEGE SOURCE CHAT 06/03/29 21:35:08 5360 2 : C 3 : C ********************************************************************** 4 : C FICHIER : HEXOS.F 5 : C OBJET : RACCORD DE 2 MAILLAGES GRILLES. 6 : C FONCT. : 7 : C OBJET HEXOS : RACCORD DE 2 MAILLAGES SURFACIQUES (GRILLES) 8 : C 9 : C AUTEUR : O. STAB 10 : C DATE : 03.97 11 : C MODIFICATIONS : 12 : C AUTEUR, DATE, OBJET : 13 : C 14 : C 15 : C ********************************************************************** 16 : C 17 : SUBROUTINE SUGEGE(DEN1,DEN2,DLONG,RAISON,NB,iarr) 18 : C ********************************************************************** 19 : C OBJET SUGEGE : CALCULE LA RAISON ET LE NOMBRE DE TERMES D'UNE SUITE 20 : C OBJET GEOMETRIQUE 21 : C 22 : C EN ENTREE : 23 : C 24 : C DLONG : LONGUEUR TOTALE 25 : C DEN1 : TAILLE SOUHAITEE POUR LE DEBUT (OPTIONNEL 0.0) 26 : C DEN2 : " " " " " POUR LA FIN (OPTIONNEL 0.0) 27 : C NB : NOMBRE DE COUCHES SOUHAITEES (OPTIONNEL 0) 28 : C 29 : C EN SORTIE : 30 : C 31 : C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES 32 : C RAISON : RAISON DE LA SUITE GEOMETRIQUE 33 : CS 34 : C REMARQUE : LES PARAMETRES NON FOURNIS DOIVENT ETRE MIS A 0.0 ou 0 35 : C ********************************************************************** 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8(A-H,O-Z) 38 : INTEGER NB,iarr 39 : C 40 : REAL*8 X,Y,XYZEPS 41 : d1=den1/DLONG 42 : d2= den2/dlong 42 : CALL DECOUP( NB,D1,D2,RAISON,NBELEM,DE,DI,DLONG) 43 : DEN1=D1*DLONG 44 : DEN2=D2*DLONG 45 : NB=NBELEM 46 : RETURN 47 : C 48 : C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS 49 : C REAL*8 XYZHUG,XYZMIN,XYZEPS 50 : C 51 : C XYZEPS = 1.19209290E-07 52 : C 53 : C XYZEPS=1.d-10 54 : C iarr = 0 55 : C IF( NB.EQ. 0 )THEN 56 : C =============== 57 : C ==== CALCUL DE NB ==== 58 : C =============== 59 : C IF(( DEN1.LE.XYZEPS ).AND.( DEN1.GE. -XYZEPS))THEN 60 : C RAISON = 1.0 61 : C IF(( DEN2.LE.XYZEPS ).AND.( DEN2.GE. -XYZEPS))THEN 62 : C NB = 1 63 : C ELSE 64 : C NB = ( DLONG / DEN2 ) 65 : C ENDIF 66 : C ELSE 67 : C ---- DEN1 != 0 ---- 68 : C IF(( DEN2.LE.XYZEPS ).AND.( DEN2.GE. -XYZEPS))THEN 69 : C RAISON = 1.0 70 : C NB = ( DLONG / DEN1 ) 71 : C ELSE 72 : C ---- DEN1 != 0 ET DEN2 != 0 ---- 73 : C X = LOG(DLONG + DEN2)-LOG(DLONG + DEN1) 74 : C IF((DEN1.GE.DLONG-XYZEPS).OR.(DEN2.GE.DLONG-XYZEPS))THEN 75 : C X = 0.0 76 : C ELSE 77 : C X = LOG(DLONG - DEN1)-LOG(DLONG - DEN2) 78 : C ENDIF 79 : C IF( (X.LE.XYZEPS).AND.(X.GE.-XYZEPS) )THEN 80 : C RAISON = 1.0 81 : C NB = (2 * DLONG / (DEN1+DEN2)) 82 : C ELSE 83 : C RAISON = ( DLONG - DEN1 ) / ( DLONG - DEN2 ) 84 : C Y = LOG(DEN2) - LOG(DEN1) 85 : C X = (Y / X) + 1.0 86 : C NB = NINT(X) 87 : C X = (DEN2/DEN1)**(1.0 / (NB-1)) 88 : C ENDIF 89 : C ENDIF 90 : C ENDIF 91 : C ELSE 92 : C =============== 93 : C ==== NB EST DONNE ==== 94 : C =============== 95 : C IF(( DEN1.LE.XYZEPS ).AND.( DEN1.GE. -XYZEPS))THEN 96 : C IF(( DEN2.LE.XYZEPS ).AND.( DEN2.GE. -XYZEPS))THEN 97 : C RAISON = 1.0 98 : C ELSE 99 : C iarr = -3 100 : C RAISON = 0 101 : C ENDIF 102 : C ELSE 103 : C ---- DEN1 != 0 ---- 104 : C IF(( DEN2.LE.XYZEPS ).AND.( DEN2.GE. -XYZEPS))THEN 105 : C iarr = -3 106 : C RAISON = 0 107 : C ELSE 108 : C ---- DEN1 != 0 ET DEN2 != 0 ---- 109 : C IF((DEN1.GE.DLONG-XYZEPS).OR.(DEN2.GE.DLONG-XYZEPS))THEN 110 : C X = 0.0 111 : C ELSE 112 : C X = LOG(DLONG - DEN1)-LOG(DLONG - DEN2) 113 : C ENDIF 114 : C IF( (X.LE.XYZEPS).AND.(X.GE.-XYZEPS) )THEN 115 : C RAISON = 1.0 116 : C ELSE 117 : C RAISON = ( DLONG - DEN1 ) / ( DLONG - DEN2 ) 118 : C Y = LOG(DEN2) - LOG(DEN1) 119 : C X = (Y / X) + 1.0 120 : C 121 : CC RAISON = (DEN2/DEN1)**(1.0 / (NB-1)) 122 : C ENDIF 123 : C ENDIF 124 : C ENDIF 125 : C ENDIF 126 : C 127 : 9999 END 128 : 129 : 130 :
© Cast3M 2003 - All rights reserved.
Disclaimer