SICOPOLIS V3.0
 All Classes Files Functions Variables Macros
topography1.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Subroutine : t o p o g r a p h y 1
4 !
5 !> @file
6 !!
7 !! Definition of the initial surface and bedrock topography
8 !! (including gradients) and of the horizontal grid spacings dxi, deta.
9 !! For an initial topography with a thin ice layer (thickness 2*H_MIN)
10 !! everywhere on the land area.
11 !!
12 !! @section Copyright
13 !!
14 !! Copyright 2009-2013 Ralf Greve
15 !!
16 !! @section License
17 !!
18 !! This file is part of SICOPOLIS.
19 !!
20 !! SICOPOLIS is free software: you can redistribute it and/or modify
21 !! it under the terms of the GNU General Public License as published by
22 !! the Free Software Foundation, either version 3 of the License, or
23 !! (at your option) any later version.
24 !!
25 !! SICOPOLIS is distributed in the hope that it will be useful,
26 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
27 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 !! GNU General Public License for more details.
29 !!
30 !! You should have received a copy of the GNU General Public License
31 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
32 !<
33 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
34 
35 !-------------------------------------------------------------------------------
36 !> Definition of the initial surface and bedrock topography
37 !! (including gradients) and of the horizontal grid spacings dxi, deta.
38 !! For an initial topography with a thin ice layer (thickness 2*H_MIN)
39 !! everywhere on the land area.
40 !<------------------------------------------------------------------------------
41 subroutine topography1(dxi, deta)
42 
43 use sico_types
45 
46 implicit none
47 integer(i4b) :: i, j, n
48 integer(i4b) :: ios, n_dummy
49 real(dp) :: dxi, deta
50 real(dp) :: d_dummy
51 real(dp) :: xi0, eta0
52 character :: ch_dummy
53 
54 !-------- Set topography --------
55 
56 zl0 = 0.0_dp
57 
58 open(24, iostat=ios, &
59  file=inpath//'/heino/'//mask_present_file, &
60  recl=1024, status='old')
61 
62 if (ios /= 0) stop ' topography1: Error when opening the mask file!'
63 
64 do n=1, 6; read(24,'(a)') ch_dummy; end do
65 
66 do j=jmax, 0, -1
67  read(24,2300) (maske(j,i), i=0,imax)
68 end do
69 
70 close(24, status='keep')
71 
72 2300 format(imax(i1),i1)
73 
74 !-------- Further stuff --------
75 
76 #if (GRID==0 || GRID==1)
77 
78 dxi = dx *1000.0_dp ! km -> m
79 deta = dx *1000.0_dp ! km -> m
80 
81 xi0 = x0 *1000.0_dp ! km -> m
82 eta0 = y0 *1000.0_dp ! km -> m
83 
84 #elif GRID==2
85 
86 stop ' topography1: GRID==2 not allowed for this application!'
87 
88 #endif
89 
90 do i=0, imax
91 do j=0, jmax
92 
93  zs(j,i) = zl0(j,i)
94  zb(j,i) = zl0(j,i)
95  zl(j,i) = zl0(j,i)
96 
97  if (maske(j,i) <= 1) then
98  maske(j,i) = 0
99  zs(j,i) = zs(j,i) + 2.0_dp*h_min
100  end if
101 
102  xi(i) = xi0 + real(i,dp)*dxi
103  eta(j) = eta0 + real(j,dp)*deta
104 
105  call geo_coord(phi(j,i), lambda(j,i), xi(i), eta(j))
106 
107  zm(j,i) = zb(j,i)
108  n_cts(j,i) = -1
109 
110  h_c(j,i) = zs(j,i)-zm(j,i)
111  h_t(j,i) = 0.0_dp
112 
113  dzs_dtau(j,i) = 0.0_dp
114  dzm_dtau(j,i) = 0.0_dp
115  dzb_dtau(j,i) = 0.0_dp
116  dzl_dtau(j,i) = 0.0_dp
117  dh_c_dtau(j,i) = 0.0_dp
118  dh_t_dtau(j,i) = 0.0_dp
119 
120 end do
121 end do
122 
123 !-------- Metric tensor, gradients of the topography --------
124 
125 call metric
126 
127 #if TOPOGRAD==0
128 call topograd_1(dxi, deta, 1)
129 #elif TOPOGRAD==1
130 call topograd_2(dxi, deta, 1)
131 #endif
132 
133  1000 format(a)
134 
135 !-------- Corresponding area of grid points --------
136 
137 do i=0, imax
138 do j=0, jmax
139  area(j,i) = sq_g11_g(j,i)*sq_g22_g(j,i)*dxi*deta
140 end do
141 end do
142 
143 end subroutine topography1
144 !