The TELEMAC-MASCARET system  trunk
cvsp_add_fraction_gaia.f
Go to the documentation of this file.
1 ! *********************************
2  SUBROUTINE cvsp_add_fraction_gaia
3 ! *********************************
4 !
5  &(j, i, dzfcl)
6 !
7 !***********************************************************************
8 ! GAIA V8P1 12/03/2013
9 !***********************************************************************
10 !
12 !
16 !
21 !
22 !
27 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
31 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
32 !
34 !
35  IMPLICIT NONE
36 !
37 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
38 !
39  INTEGER, INTENT(IN) :: J
40  INTEGER, INTENT(IN) :: I
41  DOUBLE PRECISION, INTENT(IN) :: DZFCL
42 !
43 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
44 !
45  DOUBLE PRECISION STR_OLD, STR_NEW, TEMP1, TEMP2, AT
46  DOUBLE PRECISION SUMF, SUMF2
47  INTEGER II
48  LOGICAL RET, CVSP_CHECK_F_GAIA
49 !
50 !-----------------------------------------------------------------------
51 !
52  at = dt*lt/percou
53 !
54 !-----------------------------------------------------------------------
55 ! MAKES SURE THAT THERE IS NO INFLUENCE ON THE PROFILE POINTS BELOW
56 ! BY INSERTING A SECTION WITH 0 STRENGTH IF IT DOESN'T EXIST ALREADY
57 !
58 ! CHECKS FOR BREAKPOINT (= 0 STRENGTH)
59 !-----------------------------------------------------------------------
60 !
61  IF (pro_max(j).GT.2) THEN
62  IF (pro_d(j,pro_max(j)-1,1).GT.pro_d(j,pro_max(j)-2,1)) THEN
63 !
64 !-----------------------------------------------------------------------
65 !INSERT
66 !-----------------------------------------------------------------------
67 !
68  pro_max(j) = pro_max(j) + 1
69 !
70 !-----------------------------------------------------------------------
71 !SHIFTS BREAKPOINT
72 !-----------------------------------------------------------------------
73 !
74  DO ii=1,nsicla
75  pro_f(j,pro_max(j),ii) = pro_f(j,pro_max(j)-1,ii)
76  pro_f(j,pro_max(j)-1,ii) = pro_f(j,pro_max(j)-2,ii)
77  pro_d(j,pro_max(j),ii) = pro_d(j,pro_max(j)-1,ii)
78  pro_d(j,pro_max(j)-1,ii) = pro_d(j,pro_max(j)-2,ii)
79  ENDDO
80 
81  ENDIF
82  ENDIF
83 !
84 !-----------------------------------------------------------------------
85 ! ADDS MATERIAL
86 !-----------------------------------------------------------------------
87 !
88 !
89 !-----------------------------------------------------------------------
90 !STRENGTH OF FRACTION
91 !-----------------------------------------------------------------------
92 !
93  str_old = (pro_d(j,pro_max(j),i)-pro_d(j,pro_max(j)-1,i))
94  str_new = dzfcl + str_old
95 !
96 !-----------------------------------------------------------------------
97 !NEW FRACTIONS
98 !TOP
99 !-----------------------------------------------------------------------
100 !
101  pro_f(j,pro_max(j),i) =
102  & (dzfcl + pro_f(j,pro_max(j),i) * str_old) / (str_new)
103 !
104 !-----------------------------------------------------------------------
105 !BOTTOM
106 !-----------------------------------------------------------------------
107 !
108  pro_f(j,pro_max(j)-1,i) =
109  & (dzfcl + pro_f(j,pro_max(j)-1,i) * str_old) / (str_new)
110 !
111 !-----------------------------------------------------------------------
112 !NEW DEPTH=Z OF FRACTION
113 !-----------------------------------------------------------------------
114 !
115  pro_d(j,pro_max(j),i) = dzfcl + pro_d(j,pro_max(j),i)
116 !
117 !-----------------------------------------------------------------------
118 !SHIFTING PERCENTAGE FOR THE OTHER FRACTIONS
119 !-----------------------------------------------------------------------
120 !
121  sumf = 0.d0
122  sumf2 = 0.d0
123  DO ii=1,nsicla
124  IF (i /= ii) THEN
125 !
126 !-----------------------------------------------------------------------
127 ! SUM OF FRACTIONS AFTER SEDIMENTATION /= I
128 !-----------------------------------------------------------------------
129 !
130  temp1 = pro_f(j,pro_max(j),ii) * str_old / str_new
131  temp2 = pro_f(j,pro_max(j)-1,ii) * str_old / str_new
132 !
133 !-----------------------------------------------------------------------
134 ! ASSIGN NEW THICKNESS & CORRECTED FRACTIONS
135 !-----------------------------------------------------------------------
136 !
137  pro_f(j,pro_max(j),ii) = temp1
138  pro_d(j,pro_max(j),ii) = dzfcl + pro_d(j,pro_max(j),ii)
139  pro_f(j,pro_max(j)-1,ii) = temp2
140  sumf = sumf + temp1
141  sumf2 = sumf2 + temp2
142  ENDIF
143  ENDDO
144  IF(sumf.EQ.0.d0) THEN
145  pro_f(j,pro_max(j),i) = 1.d0
146  ENDIF
147 
148  IF(sumf2.EQ.0.d0) THEN
149  pro_f(j,pro_max(j)-1,i) = 1.d0
150  ENDIF
151 !
152 !-----------------------------------------------------------------------
153 ! REMOVES FLOATING POINT TRUCATIONS
154 !-----------------------------------------------------------------------
155 !
156  ret = cvsp_check_f_gaia(j,pro_max(j),'ADF: MAX ')
157  ret = cvsp_check_f_gaia(j,pro_max(j)-1,'ADF: MAX+1')
158  IF (pro_max(j).GT.2) THEN
159  ret = cvsp_check_f_gaia(j,pro_max(j)-2,'ADF: MAX+2')
160  ENDIF
161  IF (pro_max(j).GT.3) THEN
162  ret = cvsp_check_f_gaia(j,pro_max(j)-3,'ADF: MAX+3')
163  ENDIF
164 !
165 !-----------------------------------------------------------------------
166 !
167  RETURN
168  END SUBROUTINE cvsp_add_fraction_gaia
double precision, target dt
Time step It may be different from the one in TELEMAC because of the morphological factor...
subroutine cvsp_add_fraction_gaia(J, I, DZFCL)
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.
integer, target lt
Numero du pas de temps.
double precision, dimension(:,:,:), allocatable, target pro_d
Vertical sorting profile: depth for each layer, class, point.
integer percou
COUPLING PERIOD USED IN CVSM TO CALCULATE THE TIME, SHOULD COME FROM TELEMAC ONE DAY.
integer, dimension(:), allocatable pro_max
Maximum layer number in a vertical sorting profile for each point.