The TELEMAC-MASCARET system  trunk
cvsp_compress_brut_gaia.f
Go to the documentation of this file.
1 ! ********************************
2  SUBROUTINE cvsp_compress_brut_gaia(J)
3 ! ********************************
4 !
5 !
6 !***********************************************************************
7 ! GAIA V8P1 16/05/2017
8 !***********************************************************************
9 !
15 !
19 !
25 !
30 !
35 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
37 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
38 !
39  USE interface_gaia_bedload, ex =>
42 !
44  USE cvsp_outputfiles_gaia, ONLY: cp
45  IMPLICIT NONE
46 !
47 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
48 !
49  INTEGER, INTENT(IN) :: J
50 !
51 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
52 !
53  DOUBLE PRECISION Z_LOW ,Z_HIGH, SECHIGHT,DUMMY
54 !
55 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
56 !
57 ! USING T1 INSTEAD, ASSUMING THAT NUMBER OF NODES ALWAYS BIGGER THAN NUMBER OF GRAIN SIZE CLASSES
58 !
59  INTEGER NEWPRO_MAX, K, I, JG
60  DOUBLE PRECISION H,L,M
61  LOGICAL RET
62 !
63 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
64 !
65 !TEMPORARY VERTICAL SORTING PROFILE: FRACTION + DEPTH FOR EACH LAYER, CLASS, POINT
66 !
67  DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_FNEW
68  DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_DNEW
69 !
70 !-----------------------------------------------------------------------
71 !
72  ALLOCATE(pro_dnew(pro_max_max,nsicla))
73  ALLOCATE(pro_fnew(pro_max_max,nsicla))
74 
75  jg = j
76  IF(ncsize.GT.1) jg = mesh%KNOLG%I(j)
77  IF(cvsp_db_gaia(jg,0)) CALL cvsp_p_gaia('./','BRUT',jg)
78 !
79 !-----------------------------------------------------------------------
80 ! REMOVES NUMERIC INSTABILITIES
81 !-----------------------------------------------------------------------
82  DO k = 1, pro_max(j)
83  ret = cvsp_check_f_gaia(j,k,'BeforeBRUT: ')
84  ENDDO
86 !
87 !-----------------------------------------------------------------------
88 ! WORKS LIKE THE MAKE_ACT LAYER ROUTINE BUT FOR VSP
89 !-----------------------------------------------------------------------
90 !
91  newpro_max=int(max(8.d0,(dble(pro_max_max - 4 * nsicla)*0.7d0)))
92 !
93 !-----------------------------------------------------------------------
94 ! NEW VSP SECTION HEIGHT
95 !-----------------------------------------------------------------------
96 !
97  h=pro_d(j,pro_max(j),1) !High
98  l=pro_d(j,1,1) !Low
99  m=h-l !Mighty
100 !
101 !SECTION THICKNESS
102  sechight = m / (newpro_max - 1)
103  sechight = max(sechight,dcla(1))
104  newpro_max=int(m/sechight+1)
105  newpro_max=max(2,newpro_max)
106  sechight = m / (newpro_max - 1)
107 !
108 !VERY THIN SECTION
109  IF (m.LE.sechight) THEN
110  newpro_max = 3
111  z_low = l
112  z_high = h
113  DO i = 1, nsicla
114  pro_dnew(1,i) = l
115  pro_dnew(2,i) = l
116  pro_dnew(3,i) = h
117  ENDDO
118  IF (m.GT.0.d0) THEN
119  dummy=cvsp_integrate_volume_gaia(j,1,z_high,z_low,t1%R)/
120  & (z_high-z_low)
121  DO i = 1, nsicla
122  pro_fnew(1,i) = t1%R(i) / sechight
123  pro_fnew(2,i) = t1%R(i) / sechight
124  pro_fnew(3,i) = t1%R(i) / sechight
125  ENDDO
126  ELSE
127  DO i = 1, nsicla
128  pro_fnew(1,i) = 0.d0
129  pro_fnew(2,i) = 0.d0
130  pro_fnew(3,i) = 0.d0
131  ENDDO
132  ENDIF
133 !
134 ! LESS THIN SECTIONS
135  ELSE
136  DO k = 1, newpro_max
137  pro_dnew(k,1) = (k-1)*sechight + pro_d(j,1,1)
138  z_low = pro_dnew(k,1) - 0.5d0*sechight
139  z_high = pro_dnew(k,1) + 0.5d0*sechight
140  IF(k.EQ.1) z_low = l
141  IF(k.EQ.newpro_max) z_high = h
142  dummy=cvsp_integrate_volume_gaia(j,1,z_high,z_low,t1%R)/
143  & sechight
144  DO i = 1, nsicla
145  pro_dnew(k,i) = (k-1)*sechight + pro_d(j,1,1)
146  IF (z_high-z_low.LE.zero) THEN
147  pro_fnew(k,i) = 0.d0
148  ELSE
149  pro_fnew(k,i) = t1%R(i) / sechight
150  ENDIF
151 !
152 ! UPPER AND LOWER SECTIONS ARE ONLY HALF STRENGTH
153  IF(k.EQ.1) pro_fnew(k,i) = pro_fnew(k,i)*2
154  IF(k.EQ.newpro_max) pro_fnew(k,i) = pro_fnew(k,i)*2
155  IF (pro_fnew(k,i).GE.1.0d0) THEN
156  IF(cp) print*,'JKI,F,SECHIGHT,M,NEWPMAX',
157  & j,k,i,pro_fnew(k,i),sechight,m,newpro_max
158  IF(cp) print*,'L,H,Z_LOW,Z_HIGH',
159  & l,h,z_low,z_high,t1%R(1),t1%R(2)
160  ENDIF
161  ENDDO
162  ENDDO
163  ENDIF
164 !
165 !-----------------------------------------------------------------------
166 ! RESUBSTITUTE
167 !-----------------------------------------------------------------------
168 !
169  DO i = 1, nsicla
170  DO k = 1, newpro_max
171  pro_d(j,k,i) = pro_dnew(k,i)
172  pro_f(j,k,i) = pro_fnew(k,i)
173  ENDDO
174  ENDDO
175 !
176  pro_max(j) = newpro_max
177 !
178  IF(pro_max(j).LE.2) THEN
179  WRITE(lu,*) ' COMPRESSBRUT: NOT ENOUGH PRO_MAX '
180  CALL plante(1)
181  stop
182  ENDIF
183 !
184  IF(cvsp_db_gaia(jg,0)) CALL cvsp_p_gaia('./','BRUE',jg)
185 !
186 !-----------------------------------------------------------------------
187 !
188  DEALLOCATE(pro_dnew)
189  DEALLOCATE(pro_fnew)
190 !
191 !-----------------------------------------------------------------------
192 ! REMOVES NUMERIC INSTABILITIES
193 !-----------------------------------------------------------------------
194 !
195  CALL cvsp_check_steady_gaia(j)
196  ret = .true.
197  DO k = 1, pro_max(j)
198  ret = cvsp_check_f_gaia(j,k,'AFTERBRUT: ')
199  ENDDO
200 !
201 !-----------------------------------------------------------------------
202 !
203  RETURN
204  END SUBROUTINE cvsp_compress_brut_gaia
subroutine cvsp_compress_brut_gaia(J)
subroutine cvsp_p_gaia(PATH_PRE, FILE_PRE, JG)
Definition: cvsp_p_gaia.f:7
subroutine cvsp_check_steady_gaia(J)
logical cp
Logical for debug printouts.
double precision zero
Parameter used for clipping variables or testing values against zero.
double precision, dimension(nsiclm), target dcla
Sediment diameter for each class It is only relevant for non-cohesive sediments. For the bedload...
integer, target nsicla
Number of sediment classes of bed material (less than NISCLM)
double precision, dimension(:,:,:), allocatable, target pro_f
Vertical sorting profile: fraction for each layer, class, point.
type(bief_obj), pointer t1
Aliases for work vectors in tb.
double precision function cvsp_integrate_volume_gaia(J, I, Z_HIGH, Z_LOW, A)
double precision, dimension(:,:,:), allocatable, target pro_d
Vertical sorting profile: depth for each layer, class, point.
recursive logical function cvsp_check_f_gaia(J, K, SOMETEXT)
integer pro_max_max
Maximum Number of Profile SECTIONS.
logical function cvsp_db_gaia(J_GLOBAL, TIMESTAMP)
Definition: cvsp_db_gaia.f:7
type(bief_mesh), target mesh
Mesh structure.
integer, dimension(:), allocatable pro_max
Maximum layer number in a vertical sorting profile for each point.