Context Navigation

source: branches/2016/dev_v3.20_2016_gravity_drainage/SOURCES/source_3.20/ice_bio_adv.f @ 24

Last change on this file since 24 was 23, checked in by vancop, 8 years ago
add new advection routine from ludivine
File size: 10.3 KB

Line
1	SUBROUTINE ice_bio_adv(kideb,kiut,nlay_i)
2
3	!------------------------------------------------------------------------------!
4	!
5	! --- ice_bio_adv ---
6	!
7	! Gravity Drainage for tracers (Advection)
8	!
9	!------------------------------------------------------------------------------!
10
11	USE lib_fortran
12
13	INCLUDE 'type.com'
14	INCLUDE 'para.com'
15	INCLUDE 'const.com'
16	INCLUDE 'ice.com'
17	INCLUDE 'thermo.com'
18	INCLUDE 'bio.com'
19
20	INTEGER ::
21	& ji , ! : horizontal space index
22	& jn ! : horizontal space index jn
23
24	REAL(8), DIMENSION( maxnlay ) :: !: dummy factors for tracer equation
25	& za , !: winter
26	& zb ,
27	& zc ,
28	& ze , !: summer
29	& zind , !: independent term in the tridiag system
30	& zindtbis , !:
31	& zdiagbis
32
33	REAL(8), DIMENSION(maxnlay,3) ::!: dummy factors for tracer equation
34	& ztrid !: tridiagonal matrix
35
36	REAL(8), DIMENSION(nlay_bio) ::
37	& z_sbr_i !: brine salinity
38
39	REAL(8), DIMENSION(ntra_bio_max) ::
40	& zpp_gas !: partial pressure
41
42	REAL(8) ::
43	& zdummy1 , !: dummy factors
44	& zdummy2 , !:
45	& zdummy3 , !:
46	& zswitchs , !: switch for summer drainage
47	& f_sn_rat ,
48	& wspd_trs ,
49	& zsat_arg ,
50	& zsat_oxy ,
51	& zsat_CO2 ,
52	& zsat_nit ,
53	& mol_diff
54
55	INTEGER ::
56	& indtr , !: index of tridiagonal system
57	& iter !: time step index
58
59	REAL(8) ::
60	& int_DSI_n ,
61	& int_DIN_n ,
62	& int_DIP_n ,
63	& int_DSI_n1 ,
64	& int_DIN_n1 ,
65	& int_DIP_n1
66
67	LOGICAL ::
68	& ln_write_bio ,
69	& ln_con_bio ,
70	& ln_flood
71
72	ln_write_bio = .TRUE.
73	ln_con_bio = .TRUE.
74	ln_flood = .TRUE.
75
76	zsol = 0.
77	zb0 = 0.
78	zpatm_gas = 0.
79	zpp_gas(:) = 0.0
80
81	!=======================================================================
82
83	WRITE(numout,*)
84	WRITE(numout,) ' * ice_bio_adv : '
85	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
86	WRITE(numout,*)
87
88	DO ji = kideb, kiut
89
90	!
91	!-----------------------------------------------------------------------
92	! 1) Initialization
93	!-----------------------------------------------------------------------
94	!
95	IF ( ln_write_bio ) THEN
96	WRITE(numout,*) ' Initialization '
97	WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
98	WRITE(numout,*)
99	ENDIF
100
101	!---------------
102	! Interpolation
103	!---------------
104	CALL ice_bio_interp_phy2bio(kideb,kiut,nlay_i,.FALSE.)
105	! interpolation of physical variables
106	! on the biological grid
107	! mass of salt, heat content, brine volume, Rb, PAR
108
109	CALL ice_bio_interp_diffus(kideb,kiut,nlay_i,.TRUE.)
110
111	!--------------------------------
112	! Brine concentration of tracers
113	!--------------------------------
114	DO jn = 1, ntra_bio
115	IF ( flag_diff(jn) .AND. flag_active(jn) ) THEN
116	DO jk = 1, nlay_bio
117	c_i_bio(jn,jk) = cbu_i_bio(jn,jk) / e_i_bio(jk)
118	END DO
119	ENDIF
120	IF ( flag_adsorb(jn) .AND. flag_active(jn) ) THEN
121	DO jk = 1, nlay_bio
122	c_i_bio(jn,jk) = 0.
123	END DO
124	ENDIF
125	WRITE(numout,) ' 01 ** jn = ', jn
126	WRITE(numout,*) ' c_i_bio : ', c_i_bio(jn,:)
127	END DO
128
129
130
131	!--------------------------------
132	! Integrated old bulk concentration
133	!--------------------------------
134
135	! jn = 1 pour => DSI
136	! jn = 2 pour => DIN
137	! jn = 3 pour => DIP
138
139	int_DSI_n = SUM (cbu_i_bio(1,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
140	int_DIN_n = SUM (cbu_i_bio(2,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
141	int_DIP_n = SUM (cbu_i_bio(3,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
142
143	WRITE(numout,*) ' int_DSI_n : ', int_DSI_n
144	WRITE(numout,*) ' int_DIN_n : ', int_DIN_n
145	WRITE(numout,*) ' int_DIP_n : ', int_DIP_n
146
147	!---------------------------------------------------------------
148	! Equilibrate carbonate system to get aqueous CO2 concentration
149	!---------------------------------------------------------------
150	! IF ( ln_carbon ) CALL ice_carb_chem
151
152	! DO jn = 1, ntra_bio
153	! WRITE(numout,) ' 02 ** jn = ', jn
154	! WRITE(numout,*) ' c_i_bio : ', c_i_bio(jn,:)
155	! END DO
156
157	!--------------------
158	! Conservation check
159	!--------------------
160
161	! CALL ice_bio_column(kideb,kiut,ntra_bio,mt_i_bio_init,cbu_i_bio,
162	! & deltaz_i_bio, .FALSE.)
163
164	! IF ( ln_write_bio ) THEN
165	! DO jn = 1, ntra_bio
166	! WRITE(numout,*) ' mt_i_bio_init : ', mt_i_bio_init(jn)
167	! END DO
168	! ENDIF
169
170	! layer by layer
171	! DO jn = 1, ntra_bio
172	! DO jk = 1, nlay_bio
173	! m_i_bio_init(jn,jk) = cbu_i_bio(jn,jk)*deltaz_i_bio(jk)
174	! END DO
175	! END DO
176
177
178	!------------------------------------------------------------------------------\|
179	! Update ice concentrations
180	!------------------------------------------------------------------------------\|
181	!
182
183	DO jn = 1, ntra_bio
184	IF ( flag_diff(jn) .AND. flag_active(jn) ) THEN
185
186	DO layer = 1, nlay_bio
187	za(layer) = w_adv_br(layer) * ddtb / deltaz_i_bio(layer)
188	END DO
189
190	! first layer
191	cbu_i_bio(jn,1) = c_i_bio(jn,1) * ( e_i_b(1) + za(1) ) +
192	& c_i_bio(jn,2) * ( - za(1) )
193
194	! inner layers
195	DO layer = 2, nlay_bio - 1
196	cbu_i_bio(jn,layer) = c_i_bio(jn,layer-1) *
197	& (za(layer)/2.) +
198	& c_i_bio(jn,layer) * e_i_b(layer) +
199	& c_i_bio(jn,layer+1)*(-za(layer)/2.)
200	END DO
201
202	! lowermost layer
203	cbu_i_bio(jn,nlay_bio) = c_i_bio(jn,nlay_bio-1) *
204	& ( za(nlay_bio)/2. ) +
205	& c_i_bio(jn,nlay_bio) *
206	& (e_i_b(nlay_bio) +
207	& za(nlay_bio)/2. ) -
208	& za(nlay_bio) * c_w_bio(jn)
209
210	IF ( ln_write_bio ) THEN
211	WRITE(numout,*)
212	WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn,layer) ,
213	& layer = 1, nlay_bio )
214	ENDIF
215
216	ENDIF ! flag_diif flag_active
217
218	END DO ! ntrabio
219
220
221	!--------------------------------
222	! Integrated NEW bulk concentration
223	!--------------------------------
224
225	! jn = 1 pour => DSI
226	! jn = 2 pour => DIN
227	! jn = 3 pour => DIP
228
229	int_DSI_n1 = SUM(cbu_i_bio(1,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
230	int_DIN_n1 = SUM(cbu_i_bio(2,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
231	int_DIP_n1 = SUM(cbu_i_bio(3,1:nlay_bio)*deltaz_i_bio(1:nlay_bio))
232
233	WRITE(numout,*) ' int_DSI_n1 : ', int_DSI_n1
234	WRITE(numout,*) ' int_DIN_n1 : ', int_DIN_n1
235	WRITE(numout,*) ' int_DIP_n1 : ', int_DIP_n1
236
237	!-------------------------------------------------
238	! Flux nutrient with Sea Water (positive donward)
239	!-------------------------------------------------
240
241	FDSI_AD = - (int_DSI_n1 - int_DSI_n)/ddtb
242	FDIN_AD = - (int_DIN_n1 - int_DIN_n)/ddtb
243	FDIP_AD = - (int_DIP_n1 - int_DIP_n)/ddtb
244
245	WRITE(numout,*) ' FDIN_AD : ', FDIN_AD
246	WRITE(numout,*) ' FDIP_AD : ', FDIP_AD
247	WRITE(numout,*) ' FDSI_AD : ', FDSI_AD
248
249	WRITE(numout,*) 'TESTBIO w_adv_br : ', ( w_adv_br(layer),
250	& layer = 1, nlay_bio )
251
252	!
253	!-----------------------------------------------------------------------
254	! 8) Mass of salt conserved ?
255	!-----------------------------------------------------------------------
256	!
257	! Final mass of salt
258	! CALL ice_sal_column( kideb , kiut , z_ms_i_fin ,
259	! & sn_i_b(1:nlay_i),
260	! & deltaz_i_phy, nlay_i, .FALSE. )
261
262	! Bottom flux ( positive upwards for conservation routine )
263	! zfb = - e_i_b(nlay_bio) *
264	! & ( diff_br(nlay_bio) * 2.0 / deltaz_i_bio(nlay_bio) *
265	! & ( c_i_bio(nlay_bio) - oce_sal ) + w_flood * ( z_flood *
266	! & oce_sal + ( 1. - z_flood ) * c_i_bio(nlay_bio) ) )
267	! & - e_i_b(nlay_bio) * w_flush * c_i_bio(nlay_bio)
268	! & - qsummer * z_sbr_i(nlay_i) / ddtb
269
270
271	! fsb = - zfb * rhog / 1000. ! ice-ocean salt flux is positive downwards
272	! IF ( ln_write ) THEN
273	! WRITE(numout,*) ' fsb : ', fsb
274	! WRITE(numout,*)
275	! ENDIF
276
277	! Surface flux of salt
278	! zfsu = 0.0
279
280	! conservation check
281	! zerror = 1.0e-15
282	! CALL ice_sal_conserv(kideb,kiut,'ice_sal_adv : ',zerror,
283	! & z_ms_i_ini,z_ms_i_fin,
284	! & zfb , zfsu , ddtb)
285
286	! ENDIF ! ln_sal
287	!
288	!------------------------------------------------------------------------------\|
289
290
291	!
292	!-----------------------------------------------------------------------
293	! 9) End of the routine
294	!-----------------------------------------------------------------------
295	!
296	END DO ! ji
297
298	IF ( ln_write_bio ) THEN
299
300	WRITE(numout,*)
301	WRITE(numout,) ' After advection of tracers * '
302	WRITE(numout,*) ' model output '
303
304	DO jn = 1, ntra_bio
305	IF ( flag_active(jn) ) THEN
306	WRITE(numout,*) ' biotr_i_nam : ', biotr_i_nam(jn)
307	WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn, jk),
308	& jk = 1, nlay_bio )
309	ENDIF ! flag_active
310	END DO ! jn
311	WRITE(numout,*)
312
313	ENDIF ! ln_write_bio
314
315	IF ( ln_carbon ) CALL ice_carb_chem
316
317	WRITE(numout,*)
318	WRITE(numout,*) ' End of ice_bio_adv '
319	WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
320	!
321	!=============================================================================!
322	!-- End of ice_bio_adv --
323
324	END SUBROUTINE

Note: See TracBrowser for help on using the repository browser.

Download in other formats: