The TELEMAC-MASCARET system  trunk
cvsp_compress_brut.f
Go to the documentation of this file.
1 ! ********************************
2  SUBROUTINE cvsp_compress_brut(J)
3 ! ********************************
4 !
5 !
6 !***********************************************************************
7 ! SISYPHE V7P2 16/05/2017
8 !***********************************************************************
9 !
10 !brief COMPRESSES A VERTICAL SORTING PROFILE IN POINT J TO PREVENT
11 !+ EXTENSIV GROTH OF SECTION / NODE NUMBERS
12 !+
13 !+ BRUTAL VERSION
14 !+ IN CASE OF EMERGENCY, IF NO OTHER ALGORITHM IS ALLOWED TO COMPRESS,
15 !+ TO PREVENT PRO_MAX_MAX OVERFLOW
16 !
17 !history UWE MERKEL
18 !+ 23/12/2011
19 !+ V6P2
20 !+
21 !
22 !history PABLO TASSI PAT (EDF-LNHE)
23 !+ 12/02/2013
24 !+ V6P3
25 !+ PREPARING FOR THE USE OF A HIGHER NSICLM VALUE
26 !+ (BY REBEKKA KOPMANN)
27 !+
28 !
29 !history P. A. TASSI (EDF R&D, LNHE)
30 !+ 12/03/2013
31 !+ V6P3
32 !+ Cleaning, cosmetic
33 !
34 !history R. KOPMANN (BAW)
35 !+ 25/02/2019
36 !+ V7P2
37 !+ Removing 1/NSICLA
38 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
39 !| J |<--| INDEX OF A POINT IN MESH
40 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 !
44 !
46  USE cvsp_outputfiles, ONLY: cp
47  IMPLICIT NONE
48 !
49 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
50 !
51  INTEGER, INTENT(IN) :: J
52  DOUBLE PRECISION Z_LOW ,Z_HIGH, SECHIGHT,DUMMY
53 !
54 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
55 !
56 ! USING T1 INSTEAD, ASSUMING THAT NUMBER OF NODES ALWAYS BIGGER THAN NUMBER OF GRAIN SIZE CLASSES
57 !
58  INTEGER NEWPRO_MAX, K, I, JG
59  DOUBLE PRECISION H,L,M
60  LOGICAL RET
61 !
62 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
63 !
64 !TEMPORARY VERTICAL SORTING PROFILE: FRACTION + DEPTH FOR EACH LAYER, CLASS, POINT
65 !
66  DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_FNEW
67  DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_DNEW
68 !
69 !-----------------------------------------------------------------------
70 !
71  ALLOCATE(pro_dnew(pro_max_max,nsicla))
72  ALLOCATE(pro_fnew(pro_max_max,nsicla))
73 
74  jg = j
75  IF(ncsize.GT.1) jg = mesh%KNOLG%I(j)
76  IF(cvsp_db(jg,0)) CALL cvsp_p('./','BRUA',jg)
77 !
78 !-----------------------------------------------------------------------
79 ! REMOVES NUMERIC INSTABILITIES
80 !-----------------------------------------------------------------------
81  DO k = 1, pro_max(j)
82  ret = cvsp_check_f(j,k,'BeforeBRUT: ')
83  ENDDO
84  CALL cvsp_check_steady(j)
85 !
86 !-----------------------------------------------------------------------
87 ! WORKS LIKE THE MAKE_ACT LAYER ROUTINE BUT FOR VSP
88 !-----------------------------------------------------------------------
89 !
90  newpro_max=int(max(8.d0,(dble(pro_max_max - 4 * nsicla)*0.7d0)))
91 !
92 !-----------------------------------------------------------------------
93 ! NEW VSP SECTION HEIGHT
94 !-----------------------------------------------------------------------
95 !
96  h=pro_d(j,pro_max(j),1) !High
97  l=pro_d(j,1,1) !Low
98  m=h-l !Mighty
99 !
100 !SECTION THICKNESS
101  sechight = m / (newpro_max - 1)
102  sechight = max(sechight,fdm(1))
103  newpro_max=int(m/sechight+1)
104  newpro_max=max(2,newpro_max)
105  sechight = m / (newpro_max - 1)
106 !
107 !VERY THIN SECTION
108  IF (m.LE.sechight) THEN
109  newpro_max = 3
110  z_low = l
111  z_high = h
112  DO i = 1, nsicla
113  pro_dnew(1,i) = l
114  pro_dnew(2,i) = l
115  pro_dnew(3,i) = h
116  ENDDO
117  IF (m.GT.0.d0) THEN
118  dummy=cvsp_integrate_volume(j,1,z_high,z_low,t1%R)/
119  & (z_high-z_low)
120  DO i = 1, nsicla
121  pro_fnew(1,i) = t1%R(i) / sechight
122  pro_fnew(2,i) = t1%R(i) / sechight
123  pro_fnew(3,i) = t1%R(i) / sechight
124  ENDDO
125  ELSE
126  DO i = 1, nsicla
127  pro_fnew(1,i) = 0.d0
128  pro_fnew(2,i) = 0.d0
129  pro_fnew(3,i) = 0.d0
130  ENDDO
131  ENDIF
132 !
133 ! LESS THIN SECTIONS
134  ELSE
135  DO k = 1, newpro_max
136  pro_dnew(k,1) = (k-1)*sechight + pro_d(j,1,1)
137  z_low = pro_dnew(k,1) - 0.5d0*sechight
138  z_high = pro_dnew(k,1) + 0.5d0*sechight
139  IF(k.EQ.1) z_low = l
140  IF(k.EQ.newpro_max) z_high = h
141  dummy=cvsp_integrate_volume(j,1,z_high,z_low,t1%R)/
142  & sechight
143  DO i = 1, nsicla
144  pro_dnew(k,i) = (k-1)*sechight + pro_d(j,1,1)
145  IF (z_high-z_low.LE.zero) THEN
146  pro_fnew(k,i) = 0.d0
147  ELSE
148  pro_fnew(k,i) = t1%R(i) / sechight
149  ENDIF
150 !
151 ! UPPER AND LOWER SECTIONS ARE ONLY HALF STRENGTH
152  IF(k.EQ.1) pro_fnew(k,i) = pro_fnew(k,i)*2
153  IF(k.EQ.newpro_max) pro_fnew(k,i) = pro_fnew(k,i)*2
154  IF (pro_fnew(k,i).GE.1.0d0) THEN
155  IF(cp) print*,'JKI,F,SECHIGHT,M,NEWPMAX',
156  & j,k,i,pro_fnew(k,i),sechight,m,newpro_max
157  IF(cp) print*,'L,H,Z_LOW,Z_HIGH',
158  & l,h,z_low,z_high,t1%R(1),t1%R(2)
159  ENDIF
160  ENDDO
161  ENDDO
162  ENDIF
163 !
164 !-----------------------------------------------------------------------
165 ! RESUBSTITUTE
166 !-----------------------------------------------------------------------
167 !
168  DO i = 1, nsicla
169  DO k = 1, newpro_max
170  pro_d(j,k,i) = pro_dnew(k,i)
171  pro_f(j,k,i) = pro_fnew(k,i)
172  ENDDO
173  ENDDO
174 !
175  pro_max(j) = newpro_max
176 !
177  IF(pro_max(j).LE.2) THEN
178  WRITE(lu,*) ' COMPRESSBRUT: NOT ENOUGH PRO_MAX '
179  CALL plante(1)
180  stop
181  ENDIF
182 !
183  IF(cvsp_db(jg,0)) CALL cvsp_p('./','BRUE',jg)
184 !
185 !-----------------------------------------------------------------------
186 !
187  DEALLOCATE(pro_dnew)
188  DEALLOCATE(pro_fnew)
189 !
190 !-----------------------------------------------------------------------
191 ! REMOVES NUMERIC INSTABILITIES
192 !-----------------------------------------------------------------------
193 !
194  CALL cvsp_check_steady(j)
195  ret = .true.
196  DO k = 1, pro_max(j)
197  ret = cvsp_check_f(j,k,'AFTERBRUT: ')
198  ENDDO
199 !
200 !-----------------------------------------------------------------------
201 !
202  RETURN
203  END SUBROUTINE cvsp_compress_brut
recursive logical function cvsp_check_f(J, K, SOMETEXT)
Definition: cvsp_check_f.f:7
double precision function cvsp_integrate_volume(J, I, Z_HIGH, Z_LOW, A)
double precision, dimension(:,:,:), allocatable, target pro_f
logical function cvsp_db(J_GLOBAL, TIMESTAMP)
Definition: cvsp_db.f:7
subroutine cvsp_p(PATH_PRE, FILE_PRE, JG)
Definition: cvsp_p.f:7
type(bief_obj), pointer t1
integer, dimension(:), allocatable pro_max
double precision, dimension(nsiclm), target fdm
subroutine cvsp_check_steady(J)
double precision, dimension(:,:,:), allocatable, target pro_d
subroutine cvsp_compress_brut(J)
type(bief_mesh), target mesh