SICOPOLIS V3.3
metric_m.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Module : m e t r i c _ m
4 !
5 !> @file
6 !!
7 !! Definition of the components g11 and g22 of the metric tensor of the
8 !! applied numerical coordinates.
9 !!
10 !! @section Copyright
11 !!
12 !! Copyright 2009-2017 Ralf Greve, Roland Warner
13 !!
14 !! @section License
15 !!
16 !! This file is part of SICOPOLIS.
17 !!
18 !! SICOPOLIS is free software: you can redistribute it and/or modify
19 !! it under the terms of the GNU General Public License as published by
20 !! the Free Software Foundation, either version 3 of the License, or
21 !! (at your option) any later version.
22 !!
23 !! SICOPOLIS is distributed in the hope that it will be useful,
24 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
25 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 !! GNU General Public License for more details.
27 !!
28 !! You should have received a copy of the GNU General Public License
29 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
30 !<
31 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
32 
33 !-------------------------------------------------------------------------------
34 !> Definition of the components g11 and g22 of the metric tensor of the
35 !! applied numerical coordinates.
36 !<------------------------------------------------------------------------------
37 module metric_m
38 
39  use sico_types_m
40 
41  implicit none
42 
43  private
44  public :: metric
45 
46 contains
47 
48 !-------------------------------------------------------------------------------
49 !> Main routine of module metric_m:
50 !! Definition of the components g11 and g22 of the metric tensor of the
51 !! applied numerical coordinates.
52 !<------------------------------------------------------------------------------
53  subroutine metric()
54 
55  use sico_variables_m, only : xi, eta, &
59  phi0, pi, eps
60 
61  implicit none
62 
63  integer(i4b) :: i, j
64  real(dp) :: K
65  real(dp) :: g11_g(0:jmax,0:imax), g22_g(0:jmax,0:imax), &
66  g11_sgx(0:jmax,0:imax), g11_sgy(0:jmax,0:imax), &
67  g22_sgx(0:jmax,0:imax), g22_sgy(0:jmax,0:imax)
68 
69 #if (GRID==0) /* Stereographic projection (distortion neglected) */
70 
71 !-------- Components g11, g22 on the grid points (_g) and between
72 ! the grid points (_sg) --------
73 
74  g11_g = 1.0_dp
75  g22_g = 1.0_dp
76  g11_sgx = 1.0_dp
77  g11_sgy = 1.0_dp
78  g22_sgx = 1.0_dp
79  g22_sgy = 1.0_dp
80 
81 #elif (GRID==1) /* Stereographic projection */
82 
83  if (phi0 > eps) then ! for northern hemisphere
84  k = (cos(0.25_dp*pi-0.5_dp*phi0))**2
85  else if (phi0 < (-eps)) then ! for southern hemisphere
86  k = (cos(0.25_dp*pi+0.5_dp*phi0))**2
87  else
88  stop ' >>> metric: PHI0 must be different from zero!'
89  end if
90 
91 !-------- Components g11, g22 on the grid points (_g) --------
92 
93  do i=0, imax
94  do j=0, jmax
95  call metric_stereo(xi(i), eta(j), k, g11_g(j,i), g22_g(j,i))
96  end do
97  end do
98 
99 !-------- Components g11, g22 between the grid points (_sg) --------
100 
101  do i=0, imax-1
102  do j=0, jmax
103  call metric_stereo(0.5_dp*(xi(i)+xi(i+1)), eta(j), k, &
104  g11_sgx(j,i), g22_sgx(j,i))
105  end do
106  end do
107 
108  do i=0, imax
109  do j=0, jmax-1
110  call metric_stereo(xi(i), 0.5_dp*(eta(j)+eta(j+1)), k, &
111  g11_sgy(j,i), g22_sgy(j,i))
112  end do
113  end do
114 
115 #elif (GRID==2) /* Geographical coordinates */
116 
117 !-------- Components g11, g22 on the grid points (_g) --------
118 
119  do i=0, imax
120  do j=0, jmax
121  call metric_geogr(eta(j), g11_g(j,i), g22_g(j,i))
122  end do
123  end do
124 
125 !-------- Components g11, g22 between the grid points (_sg) --------
126 
127  do i=0, imax-1
128  do j=0, jmax
129  call metric_geogr(eta(j), g11_sgx(j,i), g22_sgx(j,i))
130  end do
131  end do
132 
133  do i=0, imax
134  do j=0, jmax-1
135  call metric_geogr(0.5_dp*(eta(j)+eta(j+1)), g11_sgy(j,i), g22_sgy(j,i))
136  end do
137  end do
138 
139 #endif
140 
141 !-------- Square roots (sq_) and inverse square roots (insq_) of
142 ! g11 and g22 --------
143 
144  do i=0, imax
145  do j=0, jmax
146  sq_g11_g(j,i) = sqrt(g11_g(j,i))
147  sq_g22_g(j,i) = sqrt(g22_g(j,i))
148  insq_g11_g(j,i) = 1.0_dp/sq_g11_g(j,i)
149  insq_g22_g(j,i) = 1.0_dp/sq_g22_g(j,i)
150  end do
151  end do
152 
153  do i=0, imax-1
154  do j=0, jmax
155  sq_g11_sgx(j,i) = sqrt(g11_sgx(j,i))
156  sq_g22_sgx(j,i) = sqrt(g22_sgx(j,i))
157  insq_g11_sgx(j,i) = 1.0_dp/sq_g11_sgx(j,i)
158  end do
159  end do
160 
161  do i=0, imax
162  do j=0, jmax-1
163  sq_g11_sgy(j,i) = sqrt(g11_sgy(j,i))
164  sq_g22_sgy(j,i) = sqrt(g22_sgy(j,i))
165  insq_g22_sgy(j,i) = 1.0_dp/sq_g22_sgy(j,i)
166  end do
167  end do
168 
169  end subroutine metric
170 
171 !-------------------------------------------------------------------------------
172 !> Components g11 and g22 of the metric tensor for the
173 !! stereographical projection.
174 !<------------------------------------------------------------------------------
175  subroutine metric_stereo(x_val, y_val, K, g11_r, g22_r)
177  use sico_variables_m, only : r
178 
179  implicit none
180 
181  real(dp), intent(in) :: x_val, y_val
182  real(dp), intent(in) :: K
183  real(dp), intent(out) :: g11_r, g22_r
184 
185  g11_r = 1.0_dp / ( k**2*(1.0_dp+(x_val**2+y_val**2)/(2.0_dp*r*k)**2)**2 )
186 
187  g22_r = g11_r
188 
189  end subroutine metric_stereo
190 
191 !-------------------------------------------------------------------------------
192 !> Components g11 and g22 of the metric tensor for geographical coordinates.
193 !<------------------------------------------------------------------------------
194  subroutine metric_geogr(phi_val, g11_r, g22_r)
196  use sico_variables_m, only : r
197 
198  implicit none
199 
200  real(dp), intent(in) :: phi_val
201  real(dp), intent(out) :: g11_r, g22_r
202 
203  g11_r = r**2*(cos(phi_val))**2
204 
205  g22_r = r**2
206 
207  end subroutine metric_geogr
208 
209 !-------------------------------------------------------------------------------
210 
211 end module metric_m
212 !
real(dp), dimension(0:jmax, 0:imax) insq_g22_sgy
insq_g22_sgy(j,i): Inverse square root of g22, at (i,j+1/2)
real(dp), parameter eps
eps: Small number
subroutine metric_stereo(x_val, y_val, K, g11_r, g22_r)
Components g11 and g22 of the metric tensor for the stereographical projection.
Definition: metric_m.F90:176
real(dp), dimension(0:jmax, 0:imax) insq_g11_sgx
insq_g11_sgx(j,i): Inverse square root of g11, at (i+1/2,j)
real(dp), dimension(0:jmax, 0:imax) insq_g22_g
insq_g22_g(j,i): Inverse square root of g22 on grid point (i,j)
real(dp), dimension(0:jmax, 0:imax) sq_g22_sgx
sq_g22_sgx(j,i): Square root of g22, at (i+1/2,j)
subroutine metric_geogr(phi_val, g11_r, g22_r)
Components g11 and g22 of the metric tensor for geographical coordinates.
Definition: metric_m.F90:195
real(dp), dimension(0:jmax, 0:imax) sq_g22_sgy
sq_g22_sgy(j,i): Square root of g22, at (i,j+1/2)
real(dp) r
R: Radius of the planet.
Declarations of kind types for SICOPOLIS.
real(dp), dimension(0:jmax, 0:imax) sq_g11_sgy
sq_g11_sgy(j,i): Square root of g11, at (i,j+1/2)
Definition of the components g11 and g22 of the metric tensor of the applied numerical coordinates...
Definition: metric_m.F90:37
real(dp) phi0
PHI0: Standard parallel of the stereographic projection.
real(dp), dimension(0:jmax, 0:imax) sq_g11_sgx
sq_g11_sgx(j,i): Square root of g11, at (i+1/2,j)
real(dp), parameter pi
pi: Constant pi
real(dp), dimension(0:jmax, 0:imax) sq_g11_g
sq_g11_g(j,i): Square root of the coefficient g11 of the metric tensor on grid point (i...
subroutine, public metric()
Main routine of module metric_m: Definition of the components g11 and g22 of the metric tensor of the...
Definition: metric_m.F90:54
real(dp), dimension(0:jmax) eta
eta(j): Coordinate eta (= y) of grid point j
real(dp), dimension(0:jmax, 0:imax) insq_g11_g
insq_g11_g(j,i): Inverse square root of g11 on grid point (i,j)
real(dp), dimension(0:imax) xi
xi(i): Coordinate xi (= x) of grid point i
Declarations of global variables for SICOPOLIS.
real(dp), dimension(0:jmax, 0:imax) sq_g22_g
sq_g22_g(j,i): Square root of the coefficient g22 of the metric tensor on grid point (i...