Context Navigation

source: branches/GRISLIv3/SOURCES/prescribe-H-i2s_mod.f90 @ 430

Last change on this file since 430 was 430, checked in by dumas, 13 months ago
Cleaning branch: SOURCES/Recul_force_grounding_line printtable_mod.f90 and steps_time_loop_avec_iterbeta.f90 moved in TRASH-SOURCES and deleted in Makefile.grisli.inc
File size: 10.0 KB

Line
1	!> \file prescribe-H-i2s_mod.f90
2	!!
3	!! Determine mask and thickness for prescription of H
4	!! include ice2sea prescribed retreat (Cat april 2012)
5	!<
6
7	!> \namespace prescribe_H
8	!!
9	!! Determine mask and thickness for prescription of H
10	!!
11	!! \author CatRitz
12	!! \date june 2009
13	!!
14	!! @note use module3D_phy
15	!! @note use param_phy_mod
16	!<
17
18	module prescribe_H
19
20	use module3D_phy
21	use param_phy_mod
22	use interface_input
23
24	! pour les reculs de type ice2sea
25	! use toy_retreat_mod
26
27	implicit none
28	! real,dimension(nx,ny) :: Hp !< H value if prescribed
29	! real,dimension(nx,ny) :: Hp0 !< H value if prescribed (reference value)
30	! real,dimension(nx,ny) :: Delta_H !< Delta_H value if prescribed
31	! integer,dimension(nx,ny) :: i_delta_H !< 1 if Delta_H is prescribed on this node, else 0
32	! integer,dimension(nx,ny) :: i_Hp !< 1 if H is prescribed on this node, else 0
33	! integer,dimension(nx,ny) :: i_Hp0 !< i_hp mask reference value does not change with time
34	! integer,dimension(nx,ny) :: MK_gl0 !< mask grounding line initial
35	! integer,dimension(nx,ny) :: MK_flot0 !< mask float initial
36
37	! pour grounding line retreat, ice2sea
38	! nouvelle version interactive pour imposer des contraintes variees.
39	! sanity check, temps de depart en fonction des bassins, ....
40
41
42	! nouvelle version recul grounding line pour ice2sea
43	! ------------------------------------------------------
44
45
46
47	contains
48
49	!______________________________________________________________________________________
50	!> initialise prescribe H
51	!! calculate the initial grounding line position
52	!! @return MK_flot0 and Mk_gl0
53
54	subroutine init_prescribe_H
55
56	implicit none
57	integer :: voisin !< pour test sur des masques
58
59	if (itracebug.eq.1) call tracebug(' Entree dans routine init_prescribe_H')
60
61	! keep the mask of floating points
62	where (flot(:,:))
63	MK_flot0(:,:)= 1
64	elsewhere
65	MK_flot0(:,:)= 0
66	end where
67
68
69	! determine the initial grounding line
70
71	MK_gl0(:,:)=0
72	HP0(:,:)=H0(:,:)
73
74
75	do j=2,ny-1
76	do i=2,nx-1
77	voisin = MK_flot0(i-1,j) + MK_flot0(i+1,j) + MK_flot0(i,j-1) + MK_flot0(i,j+1)
78	if ((MK_flot0(i,j).eq.0).and.(voisin.gt.0)) then ! grounded and at least one neighbour floating
79	MK_gl0(i,j) = 1 ! tagged mask grounding line
80
81	end if
82	end do
83	end do
84
85
86	call prescribe_grid_boundary_0
87
88
89	! Dans le cas du Groenland ice2sea, mk_init = 3 -> noeuds qui ne bougent pas
90
91	if (geoplace(1:4).eq.'GI2S') then
92
93	do j = 1,ny
94	do i = 1,nx
95	if (mk_init(i,j).eq.3) then
96	i_hp0 (i,j) = 1
97	Hp0 (i,j) = H0(i,j)
98	endif
99	end do
100	end do
101	end if
102
103	end subroutine init_prescribe_H
104	!______________________________________________________________________________________
105	!> function prescribe_present_H_gl
106	!! calculate the initial grounding line position
107	!! @return i_hp(:,:) and hp(:,:)
108
109	subroutine prescribe_present_H_gl
110
111	implicit none
112
113	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_present_H_gl')
114
115	where ((MK_flot0(:,:).eq. 1).or.(MK_gl0(:,:) .eq. 1)) ! floating or grounding line
116	i_hp(:,:) = 1 ! thickness prescribed to present value
117	hp(:,:) = Hp0(:,:)
118	end where
119	if (itracebug.eq.1) call tracebug(' fin prescribe_present_H_gl')
120
121
122	end subroutine prescribe_present_H_gl
123
124	!______________________________________________________________________________________
125	!> function prescribe_present_H_gl_bmelt
126	!! calculate the initial grounding line position
127	!! only grounding line points are prescribed to present value
128	!! @return i_hp(:,:) and hp(:,:)
129
130	subroutine prescribe_present_H_gl_bmelt
131
132	implicit none
133
134	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_present_H_gl_bmelt')
135
136	! where (MK_gl0(:,:) .eq. 1) ! grounding line only !cdc pour calcule fonte basale
137	! i_hp(:,:) = 1 ! thickness prescribed to present value
138	! hp(:,:) = Hp0(:,:)
139	! end where
140	i_hp(:,:) = 0
141	if (itracebug.eq.1) call tracebug(' fin prescribe_present_H_gl_bmelt')
142
143
144	end subroutine prescribe_present_H_gl_bmelt
145
146	!______________________________________________________________________________________
147	!> function prescribe_fixed_points
148	!! fixes thickness for some points
149	!! @return i_hp(:,:) and hp(:,:)
150
151	subroutine prescribe_fixed_points
152
153	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_fixed_points')
154	where (i_hp0(:,:).eq.1) ! les points i_hp0 le sont pour tout le run
155	i_hp(:,:) = i_hp0(:,:)
156	Hp(:,:) = Hp0(:,:)
157	end where
158
159	if (itracebug.eq.1) call tracebug(' fin prescribe_fixed_points')
160
161
162	end subroutine prescribe_fixed_points
163
164	!______________________________________________________________________________________
165	!> function prescribe_paleo_gl_shelf
166	!! calculate the grounding line thickness
167	!! no ice shelves
168	!! @return i_hp(:,:) and hp(:,:)
169
170	subroutine prescribe_paleo_gl_shelf
171
172	implicit none
173
174	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_paleo_gl_shelf')
175
176
177	! noeuds qui doivent être imposés
178
179	where ((MK_flot0(:,:).eq. 1).or.(MK_gl0(:,:) .eq. 1)) ! floating or grounding line
180	i_hp(:,:) = 1 ! thickness prescribed
181	end where
182
183	! valeur imposee
184	where (MK_flot0(:,:).eq. 1) ! paleo shelf epaisseur a 1
185	hp(:,:) = 1.
186	end where
187
188
189	where (MK_gl0(:,:) .eq. 1)
190	hp(:,:) = (sealevel_2d(:,:)-Bsoc(:,:))*row/ro +1.
191	end where
192
193
194	end subroutine prescribe_paleo_gl_shelf
195
196	!______________________________________________________________________________________
197	!> function prescribe_grid_boundary
198	!! prescribe the grid boundary thickness to 0
199	!! @return i_hp(:,:) and hp(:,:)
200
201	subroutine prescribe_grid_boundary_0
202
203	implicit none
204	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_grid_boundary_0')
205
206	! prescribe thickness on the grid boundaries
207	i_hp(:,:) = 0
208
209	i_hp(1,:) = 1
210	i_hp(nx,:)= 1
211	hp(1,:) = 0
212	hp(nx,:) = 0
213
214	i_hp(:,1) = 1
215	i_hp(:,ny)= 1
216	hp(:,1) = 0
217	hp(:,ny) = 0
218
219	! valeurs de reference
220	i_hp0(1,:) = 1
221	i_hp0(nx,:) = 1
222	hp0(1,:) = 0
223	hp0(nx,:) = 0
224
225	i_hp0(:,1) = 1
226	i_hp0(:,ny) = 1
227	hp0(:,1) = 0
228	hp0(:,ny) = 0
229
230
231	end subroutine prescribe_grid_boundary_0
232	!______________________________________________________________________________________
233
234	!______________________________________________________________________________________
235	!> break ice shelves
236	!!
237	!!
238	subroutine break_all_ice_shelves
239
240	implicit none
241	if (itracebug.eq.1) call tracebug(' Entree dans routine break_all_ice_shelves ')
242
243
244	debug_3D(:,:,89)=0.
245
246	where (flot(:,:)) ! floating from the beginning and eventually from grounding line retreat
247	i_hp(:,:) = 1 ! thickness prescribed to 1 m
248	hp (:,:) = 1.
249	hp0 (:,:) = 1.
250	H(:,:) =1.
251	debug_3D(:,:,89)=1.
252
253	end where
254	where (MK_flot0(:,:).eq. 1)
255	i_hp(:,:) = 1 ! thickness prescribed to 1 m
256	hp (:,:) = 1.
257	hp0 (:,:) = 1.
258	H(:,:) =1.
259	end where
260
261
262	end subroutine break_all_ice_shelves
263
264	!
265	!______________________________________________________________________________________
266	!> break ice shelves
267	!!
268	!!
269	subroutine melt_ice_shelves
270
271	implicit none
272	integer :: nbvoisins,nbdeglac,iv,jv
273	real :: hmoy,hmin,hmax
274
275	if (itracebug.eq.1) call tracebug(' Entree dans routine melt_ice_shelves')
276
277	do j = 2,ny-1
278	do i=2, nx-1
279	if (flot(i,j)) then ! floating
280	i_hp(i,j) = 1 ! thickness prescribed
281	hmoy=0.
282	hmin=0.
283	hmax=0.
284	nbvoisins=0
285	nbdeglac=0
286	do jv=-1,1
287	do iv=1,1
288	if (flot(i+iv,j+jv)) then
289	nbvoisins=nbvoisins+1
290	hmoy=hmoy+h(i+iv,j+jv)
291	hmin=min(hmin,h(i+iv,j+jv))
292	hmax=max(hmax,h(i+iv,j+jv))
293	if (h(i+jv,j+jv).lt.10.) nbdeglac=nbdeglac+1
294	end if
295	end do
296	end do
297	hmoy=hmoy/(max(nbvoisins,1))
298
299	if(H(i,j).gt.hmoy) then ! melt only if smooth
300	hp(i,j)=H(i,j)-1.*dt
301	else if (hmax-hmin.lt.10.) then
302	hp(i,j)=H(i,j)-1.*dt
303	else if ((H(i,j).lt.50.).and.(Hmin.lt.30.)) then
304	hp(i,j)=1.
305	else if ((H(i,j).lt.50.).and.(nbdeglac.ge.4)) then
306	hp(i,j)=1.
307	endif
308	hp(i,j) = max(hp(i,j),1.)
309	end if
310	end do
311	end do
312
313	end subroutine melt_ice_shelves
314
315
316	!______________________________________________________________________________________
317	!> function prescribe_present_H_gl
318	!! calculate the initial grounding line position
319	!! @return i_hp(:,:) and hp(:,:)
320
321	subroutine prescribe_present_H_gl_copy
322
323	implicit none
324	if (itracebug.eq.1) call tracebug(' Entree dans routine prescribe_present_H_gl-copy')
325
326	do j=1,ny
327	do i=1,nx
328	if ((MK_flot0(i,j).eq. 1).or.(MK_gl0(i,j) .eq. 1)) then
329	i_hp(i,j) = 1 ! thickness prescribed to present value
330	hp(i,j) = Hp0(i,j)
331	end if
332	end do
333	end do
334
335	!!$where ((MK_flot0(:,:).eq. 1).or.(MK_gl0(:,:) .eq. 1)) ! floating or grounding line
336	!!$ i_hp(:,:) = 1 ! thickness prescribed to present value
337	!!$! hp(:,:) = 1 !Hp0(:,:)
338	!!$end where
339
340
341	end subroutine prescribe_present_H_gl_copy
342	!______________________________________________________________________________________
343
344
345	end module prescribe_H

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

Download in other formats: