The TELEMAC-MASCARET system  trunk
cvsp_add_fraction.f
Go to the documentation of this file.
1 ! ****************************
2  SUBROUTINE cvsp_add_fraction
3 ! ****************************
4 !
5  &(j, i, dzfcl)
6 !
7 !***********************************************************************
8 ! SISYPHE V6P3 12/03/2013
9 !***********************************************************************
10 !
11 !brief ADDS A FRACTION TO THE TOPMOST VERTICAL SORTING PROFILE SECTION
12 !
13 !history UWE MERKEL
14 !+ 2011
15 !+ V6P2
16 !+
17 !
18 !history P. A. TASSI (EDF R&D, LNHE)
19 !+ 12/03/2013
20 !+ V6P3
21 !+ Cleaning, cosmetic
22 !
23 !
24 !history R. KOPMANN (BAW)
25 !+ 25/02/2019
26 !+ V7P2
27 !+ Considering a new case: only 1 fraction occurs, must have value 1
28 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
29 !| J |<--| INDEX OF A POINT IN MESH
30 !| I |<--| INDEX OF A FRACTION
31 !| DZFCL |<--| EVOLUTION OF FRACTION I [M]
32 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
33 !
35 !
36  IMPLICIT NONE
37 !
38 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
39 !
40  INTEGER, INTENT(IN) :: J
41  INTEGER, INTENT(IN) :: I
42  DOUBLE PRECISION, INTENT(IN) :: DZFCL
43 !
44 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
45 !
46  DOUBLE PRECISION STR_OLD, STR_NEW, TEMP1, TEMP2, AT
47  DOUBLE PRECISION SUMF, SUMF2
48  INTEGER II
49  LOGICAL RET, CVSP_CHECK_F
50 !
51 !-----------------------------------------------------------------------
52 !
53  at = dt*lt/percou
54 !
55 !-----------------------------------------------------------------------
56 ! MAKES SURE THAT THERE IS NO INFLUENCE ON THE PROFILE POINTS BELOW
57 ! BY INSERTING A SECTION WITH 0 STRENGTH IF IT DOESN'T EXIST ALREADY
58 !
59 ! CHECKS FOR BREAKPOINT (= 0 STRENGTH)
60 !-----------------------------------------------------------------------
61 !
62  IF (pro_max(j).GT.2) THEN
63  IF (pro_d(j,pro_max(j)-1,1).GT.pro_d(j,pro_max(j)-2,1)) THEN
64 !
65 !-----------------------------------------------------------------------
66 !INSERT
67 !-----------------------------------------------------------------------
68 !
69  pro_max(j) = pro_max(j) + 1
70 !
71 !-----------------------------------------------------------------------
72 !SHIFTS BREAKPOINT
73 !-----------------------------------------------------------------------
74 !
75  DO ii=1,nsicla
76  pro_f(j,pro_max(j),ii) = pro_f(j,pro_max(j)-1,ii)
77  pro_f(j,pro_max(j)-1,ii) = pro_f(j,pro_max(j)-2,ii)
78  pro_d(j,pro_max(j),ii) = pro_d(j,pro_max(j)-1,ii)
79  pro_d(j,pro_max(j)-1,ii) = pro_d(j,pro_max(j)-2,ii)
80  ENDDO
81 
82  ENDIF
83  ENDIF
84 !
85 !-----------------------------------------------------------------------
86 ! ADDS MATERIAL
87 !-----------------------------------------------------------------------
88 !
89 !
90 !-----------------------------------------------------------------------
91 !STRENGTH OF FRACTION
92 !-----------------------------------------------------------------------
93 !
94  str_old = (pro_d(j,pro_max(j),i)-pro_d(j,pro_max(j)-1,i))
95  str_new = dzfcl + str_old
96 !
97 !-----------------------------------------------------------------------
98 !NEW FRACTIONS
99 !TOP
100 !-----------------------------------------------------------------------
101 !
102  pro_f(j,pro_max(j),i) =
103  & (dzfcl + pro_f(j,pro_max(j),i) * str_old) / (str_new)
104 !
105 !-----------------------------------------------------------------------
106 !BOTTOM
107 !-----------------------------------------------------------------------
108 !
109  pro_f(j,pro_max(j)-1,i) =
110  & (dzfcl + pro_f(j,pro_max(j)-1,i) * str_old) / (str_new)
111 !
112 !-----------------------------------------------------------------------
113 !NEW DEPTH=Z OF FRACTION
114 !-----------------------------------------------------------------------
115 !
116  pro_d(j,pro_max(j),i) = dzfcl + pro_d(j,pro_max(j),i)
117 !
118 !-----------------------------------------------------------------------
119 !SHIFTING PERCENTAGE FOR THE OTHER FRACTIONS
120 !-----------------------------------------------------------------------
121 !
122  sumf = 0.d0
123  sumf2 = 0.d0
124  DO ii=1,nsicla
125  IF (i /= ii) THEN
126 !
127 !-----------------------------------------------------------------------
128 ! SUM OF FRACTIONS AFTER SEDIMENTATION /= I
129 !-----------------------------------------------------------------------
130 !
131  temp1 = pro_f(j,pro_max(j),ii) * str_old / str_new
132  temp2 = pro_f(j,pro_max(j)-1,ii) * str_old / str_new
133 !
134 !-----------------------------------------------------------------------
135 ! ASSIGN NEW THICKNESS & CORRECTED FRACTIONS
136 !-----------------------------------------------------------------------
137 !
138  pro_f(j,pro_max(j),ii) = temp1
139  pro_d(j,pro_max(j),ii) = dzfcl + pro_d(j,pro_max(j),ii)
140  pro_f(j,pro_max(j)-1,ii) = temp2
141  sumf = sumf + temp1
142  sumf2 = sumf2 + temp2
143  ENDIF
144  ENDDO
145  IF(sumf.EQ.0.d0) THEN
146  pro_f(j,pro_max(j),i) = 1.d0
147  ENDIF
148 
149  IF(sumf2.EQ.0.d0) THEN
150  pro_f(j,pro_max(j)-1,i) = 1.d0
151  ENDIF
152 !
153 !-----------------------------------------------------------------------
154 ! REMOVES FLOATING POINT TRUCATIONS
155 !-----------------------------------------------------------------------
156 !
157  ret = cvsp_check_f(j,pro_max(j),'ADF: MAX ')
158  ret = cvsp_check_f(j,pro_max(j)-1,'ADF: MAX+1')
159  IF (pro_max(j).GT.2) THEN
160  ret = cvsp_check_f(j,pro_max(j)-2,'ADF: MAX+2')
161  ENDIF
162  IF (pro_max(j).GT.3) THEN
163  ret = cvsp_check_f(j,pro_max(j)-3,'ADF: MAX+3')
164  ENDIF
165 !
166 !-----------------------------------------------------------------------
167 !
168  RETURN
169  END SUBROUTINE cvsp_add_fraction
double precision, dimension(:,:,:), allocatable, target pro_f
double precision, target dt
integer, dimension(:), allocatable pro_max
subroutine cvsp_add_fraction(J, I, DZFCL)
double precision, dimension(:,:,:), allocatable, target pro_d