Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Open sidebar
Knut Klingbeil
getm
Commits
61cae53c
Commit
61cae53c
authored
Feb 19, 2019
by
Knut
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'rivers' into rigid_lid
parents
47dac7f7
64419727
Pipeline
#136
failed with stages
Changes
12
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
269 additions
and
90 deletions
+269
-90
src/2d/bdy_2d.F90
src/2d/bdy_2d.F90
+52
-16
src/2d/m2d.F90
src/2d/m2d.F90
+2
-3
src/2d/variables_2d.F90
src/2d/variables_2d.F90
+2
-3
src/3d/m3d.F90
src/3d/m3d.F90
+2
-2
src/3d/salinity.F90
src/3d/salinity.F90
+3
-3
src/3d/temperature.F90
src/3d/temperature.F90
+3
-3
src/3d/variables_3d.F90
src/3d/variables_3d.F90
+4
-4
src/3d/vertical_coordinates.F90
src/3d/vertical_coordinates.F90
+2
-2
src/getm/initialise.F90
src/getm/initialise.F90
+2
-0
src/getm/register_all_variables.F90
src/getm/register_all_variables.F90
+7
-0
src/ncdf/ncdf_meteo.F90
src/ncdf/ncdf_meteo.F90
+87
-27
src/output/output_processing.F90
src/output/output_processing.F90
+103
-27
No files found.
src/2d/bdy_2d.F90
View file @
61cae53c
...
...
@@ -388,16 +388,18 @@
select
case
(
bdy_2d_type
(
l
))
case
(
ZERO_GRADIENT
,
CLAMPED_VEL
,
FLATHER_VEL
)
do
j
=
wfj
(
n
),
wlj
(
n
)
z
(
i
,
j
)
=
z
(
i
+1
,
j
)
if
(
az
(
i
+1
,
j
)
.ne.
0
)
z
(
i
,
j
)
=
z
(
i
+1
,
j
)
end
do
case
(
SOMMERFELD
)
do
j
=
wfj
(
n
),
wlj
(
n
)
if
(
az
(
i
+1
,
j
)
.ne.
0
)
then
cfl
=
sqrt
(
g
*
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
+1
,
j
)))
*
dtm
/
DXU
z
(
i
,
j
)
=
(
&
(
_
ONE_
-
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
z
(
i
,
j
)
&
+
(
_
ONE_
+
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
zo
(
i
+1
,
j
)
&
-
(
_
ONE_
-
_
TWO_
*
cfl
*
theta
)
*
z
(
i
+1
,
j
)
&
)/(
_
ONE_
+
_
TWO_
*
cfl
*
theta
)
end
if
end
do
case
(
CLAMPED_ELEV
,
CLAMPED
)
do
j
=
wfj
(
n
),
wlj
(
n
)
...
...
@@ -407,13 +409,16 @@
end
do
case
(
FLATHER_ELEV
)
do
j
=
wfj
(
n
),
wlj
(
n
)
if
(
az
(
i
+1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
+1
,
j
))
! Note (KK): note approximation of sse at vel-time stage
a
=
ramp
*
bdy_data
(
kl
)
&
-
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
U
(
i
,
j
)
-
ramp
*
bdy_data_u
(
kl
)
*
depth
)
z
(
i
,
j
)
=
max
(
a
,
-
H
(
i
,
j
)
+
min_depth
)
a
=
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
U
(
i
,
j
)
-
ramp
*
bdy_data_u
(
kl
)
*
depth
)
else
a
=
_
ZERO_
end
if
z
(
i
,
j
)
=
max
(
ramp
*
bdy_data
(
kl
)
-
a
,
-
H
(
i
,
j
)
+
min_depth
)
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -427,16 +432,18 @@
select
case
(
bdy_2d_type
(
l
))
case
(
ZERO_GRADIENT
,
CLAMPED_VEL
,
FLATHER_VEL
)
do
i
=
nfi
(
n
),
nli
(
n
)
z
(
i
,
j
)
=
z
(
i
,
j
-1
)
if
(
az
(
i
,
j
-1
)
.ne.
0
)
z
(
i
,
j
)
=
z
(
i
,
j
-1
)
end
do
case
(
SOMMERFELD
)
do
i
=
nfi
(
n
),
nli
(
n
)
if
(
az
(
i
,
j
-1
)
.ne.
0
)
then
cfl
=
sqrt
(
g
*
_
HALF_
*
(
D
(
i
,
j
-1
)
+
D
(
i
,
j
)))
*
dtm
/
DYVJM1
z
(
i
,
j
)
=
(
&
(
_
ONE_
-
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
z
(
i
,
j
)
&
+
(
_
ONE_
+
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
zo
(
i
,
j
-1
)
&
-
(
_
ONE_
-
_
TWO_
*
cfl
*
theta
)
*
z
(
i
,
j
-1
)
&
)/(
_
ONE_
+
_
TWO_
*
cfl
*
theta
)
end
if
end
do
case
(
CLAMPED_ELEV
,
CLAMPED
)
do
i
=
nfi
(
n
),
nli
(
n
)
...
...
@@ -446,13 +453,16 @@
end
do
case
(
FLATHER_ELEV
)
do
i
=
nfi
(
n
),
nli
(
n
)
if
(
az
(
i
,
j
-1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
-1
)
+
D
(
i
,
j
))
! Note (KK): note approximation of sse at vel-time stage
a
=
ramp
*
bdy_data
(
kl
)
&
+
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
V
(
i
,
j
-1
)
-
ramp
*
bdy_data_v
(
kl
)
*
depth
)
z
(
i
,
j
)
=
max
(
a
,
-
H
(
i
,
j
)
+
min_depth
)
a
=
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
V
(
i
,
j
-1
)
-
ramp
*
bdy_data_v
(
kl
)
*
depth
)
else
a
=
_
ZERO_
end
if
z
(
i
,
j
)
=
max
(
ramp
*
bdy_data
(
kl
)
+
a
,
-
H
(
i
,
j
)
+
min_depth
)
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -466,16 +476,18 @@
select
case
(
bdy_2d_type
(
l
))
case
(
ZERO_GRADIENT
,
CLAMPED_VEL
,
FLATHER_VEL
)
do
j
=
efj
(
n
),
elj
(
n
)
z
(
i
,
j
)
=
z
(
i
-1
,
j
)
if
(
az
(
i
-1
,
j
)
.ne.
0
)
z
(
i
,
j
)
=
z
(
i
-1
,
j
)
end
do
case
(
SOMMERFELD
)
do
j
=
efj
(
n
),
elj
(
n
)
if
(
az
(
i
-1
,
j
)
.ne.
0
)
then
cfl
=
sqrt
(
g
*
_
HALF_
*
(
D
(
i
-1
,
j
)
+
D
(
i
,
j
)))
*
dtm
/
DXUIM1
z
(
i
,
j
)
=
(
&
(
_
ONE_
-
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
z
(
i
,
j
)
&
+
(
_
ONE_
+
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
zo
(
i
-1
,
j
)
&
-
(
_
ONE_
-
_
TWO_
*
cfl
*
theta
)
*
z
(
i
-1
,
j
)
&
)/(
_
ONE_
+
_
TWO_
*
cfl
*
theta
)
end
if
end
do
case
(
CLAMPED_ELEV
,
CLAMPED
)
do
j
=
efj
(
n
),
elj
(
n
)
...
...
@@ -485,13 +497,16 @@
end
do
case
(
FLATHER_ELEV
)
do
j
=
efj
(
n
),
elj
(
n
)
if
(
az
(
i
-1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
-1
,
j
)
+
D
(
i
,
j
))
! Note (KK): note approximation of sse at vel-time stage
a
=
ramp
*
bdy_data
(
kl
)
&
+
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
U
(
i
-1
,
j
)
-
ramp
*
bdy_data_u
(
kl
)
*
depth
)
z
(
i
,
j
)
=
max
(
a
,
-
H
(
i
,
j
)
+
min_depth
)
a
=
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
U
(
i
-1
,
j
)
-
ramp
*
bdy_data_u
(
kl
)
*
depth
)
else
a
=
_
ZERO_
end
if
z
(
i
,
j
)
=
max
(
ramp
*
bdy_data
(
kl
)
+
a
,
-
H
(
i
,
j
)
+
min_depth
)
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -505,16 +520,18 @@
select
case
(
bdy_2d_type
(
l
))
case
(
ZERO_GRADIENT
,
CLAMPED_VEL
,
FLATHER_VEL
)
do
i
=
sfi
(
n
),
sli
(
n
)
z
(
i
,
j
)
=
z
(
i
,
j
+1
)
if
(
az
(
i
,
j
+1
)
.ne.
0
)
z
(
i
,
j
)
=
z
(
i
,
j
+1
)
end
do
case
(
SOMMERFELD
)
do
i
=
sfi
(
n
),
sli
(
n
)
if
(
az
(
i
,
j
+1
)
.ne.
0
)
then
cfl
=
sqrt
(
g
*
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
,
j
+1
)))
*
dtm
/
DYV
z
(
i
,
j
)
=
(
&
(
_
ONE_
-
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
z
(
i
,
j
)
&
+
(
_
ONE_
+
_
TWO_
*
cfl
*
(
_
ONE_
-
theta
))
*
zo
(
i
,
j
+1
)
&
-
(
_
ONE_
-
_
TWO_
*
cfl
*
theta
)
*
z
(
i
,
j
+1
)
&
)/(
_
ONE_
+
_
TWO_
*
cfl
*
theta
)
end
if
end
do
case
(
CLAMPED_ELEV
,
CLAMPED
)
do
i
=
sfi
(
n
),
sli
(
n
)
...
...
@@ -524,13 +541,16 @@
end
do
case
(
FLATHER_ELEV
)
do
i
=
sfi
(
n
),
sli
(
n
)
if
(
az
(
i
,
j
+1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
,
j
+1
))
! Note (KK): note approximation of sse at vel-time stage
a
=
ramp
*
bdy_data
(
kl
)
&
-
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
V
(
i
,
j
)
-
ramp
*
bdy_data_v
(
kl
)
*
depth
)
z
(
i
,
j
)
=
max
(
a
,
-
H
(
i
,
j
)
+
min_depth
)
a
=
_
TWO_
/
sqrt
(
g
*
depth
)
*
(
V
(
i
,
j
)
-
ramp
*
bdy_data_v
(
kl
)
*
depth
)
else
a
=
_
ZERO_
end
if
z
(
i
,
j
)
=
max
(
ramp
*
bdy_data
(
kl
)
-
a
,
-
H
(
i
,
j
)
+
min_depth
)
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -625,21 +645,25 @@
select
case
(
bdy_2d_type
(
l
))
case
(
FLATHER_VEL
)
do
j
=
wfj
(
n
),
wlj
(
n
)
if
(
az
(
i
+1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
+1
,
j
))
! Note (KK): note approximation of sse at vel-time stage
U
(
i
,
j
)
=
ramp
*
bdy_data_u
(
kl
)
*
depth
&
-
_
HALF_
*
sqrt
(
g
*
depth
)
*
(
z
(
i
,
j
)
-
ramp
*
bdy_data
(
kl
))
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
case
(
CLAMPED_VEL
,
CLAMPED
)
do
j
=
wfj
(
n
),
wlj
(
n
)
if
(
az
(
i
+1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
+1
,
j
))
U
(
i
,
j
)
=
ramp
*
bdy_data_u
(
kl
)
*
depth
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -654,21 +678,25 @@
select
case
(
bdy_2d_type
(
l
))
case
(
FLATHER_VEL
)
do
j
=
efj
(
n
),
elj
(
n
)
if
(
az
(
i
-1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
-1
,
j
)
+
D
(
i
,
j
))
! Note (KK): note approximation of sse at vel-time stage
U
(
i
-1
,
j
)
=
ramp
*
bdy_data_u
(
kl
)
*
depth
&
+
_
HALF_
*
sqrt
(
g
*
depth
)
*
(
z
(
i
,
j
)
-
ramp
*
bdy_data
(
kl
))
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
case
(
CLAMPED_VEL
,
CLAMPED
)
do
j
=
efj
(
n
),
elj
(
n
)
if
(
az
(
i
-1
,
j
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
-1
,
j
)
+
D
(
i
,
j
))
U
(
i
-1
,
j
)
=
ramp
*
bdy_data_u
(
kl
)
*
depth
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -686,21 +714,25 @@
select
case
(
bdy_2d_type
(
l
))
case
(
FLATHER_VEL
)
do
i
=
nfi
(
n
),
nli
(
n
)
if
(
az
(
i
,
j
-1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
-1
)
+
D
(
i
,
j
))
! Note (KK): note approximation of sse at vel-time stage
V
(
i
,
j
-1
)
=
ramp
*
bdy_data_v
(
kl
)
*
depth
&
+
_
HALF_
*
sqrt
(
g
*
depth
)
*
(
z
(
i
,
j
)
-
ramp
*
bdy_data
(
kl
))
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
case
(
CLAMPED_VEL
,
CLAMPED
)
do
i
=
nfi
(
n
),
nli
(
n
)
if
(
az
(
i
,
j
-1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
-1
)
+
D
(
i
,
j
))
V
(
i
,
j
-1
)
=
ramp
*
bdy_data_v
(
kl
)
*
depth
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
@@ -715,21 +747,25 @@
select
case
(
bdy_2d_type
(
l
))
case
(
FLATHER_VEL
)
do
i
=
sfi
(
n
),
sli
(
n
)
if
(
az
(
i
,
j
+1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
,
j
+1
))
! Note (KK): note approximation of sse at vel-time stage
V
(
i
,
j
)
=
ramp
*
bdy_data_v
(
kl
)
*
depth
&
-
_
HALF_
*
sqrt
(
g
*
depth
)
*
(
z
(
i
,
j
)
-
ramp
*
bdy_data
(
kl
))
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
case
(
CLAMPED_VEL
,
CLAMPED
)
do
i
=
sfi
(
n
),
sli
(
n
)
if
(
az
(
i
,
j
+1
)
.ne.
0
)
then
! Note (KK): approximate interface depths at vel-time stage
! by spatial mean at last sse-time stage
depth
=
_
HALF_
*
(
D
(
i
,
j
)
+
D
(
i
,
j
+1
))
V
(
i
,
j
)
=
ramp
*
bdy_data_v
(
kl
)
*
depth
end
if
k
=
k
+1
kl
=
kl
+
1
end
do
...
...
src/2d/m2d.F90
View file @
61cae53c
...
...
@@ -162,7 +162,6 @@
integer
::
i
,
j
integer
::
elev_method
=
1
REALTYPE
::
elev_const
=
_
ZERO_
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
character
(
LEN
=
PATH_MAX
)
::
elev_file
=
'elev.nc'
namelist
/
m2d
/
&
elev_method
,
elev_const
,
elev_file
,
&
...
...
@@ -415,8 +414,8 @@
! This is only needed for proper flexible output
where
(
az
.eq.
0
)
z
=
-9999.
0d0
zo
=
-9999.
0d0
z
=
-9999.
_rk
zo
=
-9999.
_rk
end
where
call
depth_update
(
zo
,
z
,
D
,
Dvel
,
DU
,
DV
)
...
...
src/2d/variables_2d.F90
View file @
61cae53c
...
...
@@ -22,6 +22,7 @@
IMPLICIT
NONE
!
! !PUBLIC DATA MEMBERS:
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
REALTYPE
::
dtm
REALTYPE
,
dimension
(:,:),
pointer
::
zo
,
z
logical
::
do_numerical_analyses_2d
=
.false.
...
...
@@ -101,7 +102,6 @@
!
! !LOCAL VARIABLES:
integer
::
rc
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
!EOP
!-------------------------------------------------------------------------
!BOC
...
...
@@ -126,7 +126,7 @@
break_stat
=
0
#endif
z
=
-9999
*
_
ONE_
;
zo
=
_
ZERO_
z
=
-9999
._rk
;
zo
=
_
ZERO_
U
=
_
ZERO_
;
DU
=
_
ZERO_
;
Uint
=
_
ZERO_
;
UEx
=
_
ZERO_
V
=
_
ZERO_
;
DV
=
_
ZERO_
;
Vint
=
_
ZERO_
;
VEx
=
_
ZERO_
...
...
@@ -230,7 +230,6 @@
!
! !LOCAL VARIABLES:
logical
::
used
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
!EOP
!-----------------------------------------------------------------------
!BOC
...
...
src/3d/m3d.F90
View file @
61cae53c
...
...
@@ -396,8 +396,8 @@
num
(
i
,
j
,:)
=
1.e-15
nuh
(
i
,
j
,:)
=
1.e-15
#ifndef NO_BAROCLINIC
S
(
i
,
j
,:)
=
-9999.
0
T
(
i
,
j
,:)
=
-9999.
0
S
(
i
,
j
,:)
=
-9999.
_rk
T
(
i
,
j
,:)
=
-9999.
_rk
#endif
end
if
end
do
...
...
src/3d/salinity.F90
View file @
61cae53c
...
...
@@ -19,7 +19,7 @@
use
domain
,
only
:
imin
,
jmin
,
imax
,
jmax
,
kmax
,
H
,
az
,
dry_z
!KB use get_field, only: get_3d_field
use
variables_2d
,
only
:
fwf_int
use
variables_3d
,
only
:
S
,
hn
,
kmin
use
variables_3d
,
only
:
rk
,
S
,
hn
,
kmin
use
meteo
,
only
:
metforcing
,
met_method
,
nudge_sss
,
sss
use
meteo
,
only
:
METEO_CONST
,
METEO_FROMFILE
,
METEO_FROMEXT
use
halo_zones
,
only
:
update_3d_halo
,
wait_halo
,
D_TAG
,
H_TAG
...
...
@@ -224,8 +224,8 @@
stop
'init_salinity'
end
select
S
(:,:,
0
)
=
-9999
*
_
ONE_
forall
(
i
=
imin
:
imax
,
j
=
jmin
:
jmax
,
az
(
i
,
j
)
.eq.
0
)
S
(
i
,
j
,:)
=
-9999
*
_
ONE_
S
(:,:,
0
)
=
-9999
._rk
forall
(
i
=
imin
:
imax
,
j
=
jmin
:
jmax
,
az
(
i
,
j
)
.eq.
0
)
S
(
i
,
j
,:)
=
-9999
._rk
call
update_3d_halo
(
S
,
S
,
az
,
imin
,
jmin
,
imax
,
jmax
,
kmax
,
D_TAG
)
call
wait_halo
(
D_TAG
)
...
...
src/3d/temperature.F90
View file @
61cae53c
...
...
@@ -20,7 +20,7 @@
use
domain
,
only
:
imin
,
jmin
,
imax
,
kmax
,
jmax
,
H
,
az
,
dry_z
use
domain
,
only
:
ill
,
ihl
,
jll
,
jhl
use
domain
,
only
:
ilg
,
ihg
,
jlg
,
jhg
use
variables_3d
,
only
:
T
,
rad
,
hn
,
kmin
,
A
,
g1
,
g2
,
heatflux_net
use
variables_3d
,
only
:
rk
,
T
,
rad
,
hn
,
kmin
,
A
,
g1
,
g2
,
heatflux_net
use
meteo
,
only
:
metforcing
,
met_method
,
nudge_sst
,
sst
use
meteo
,
only
:
METEO_CONST
,
METEO_FROMFILE
,
METEO_FROMEXT
!KB use get_field, only: get_3d_field
...
...
@@ -303,8 +303,8 @@ end interface
stop
'init_temperature'
end
select
T
(:,:,
0
)
=
-9999
*
_
ONE_
forall
(
i
=
imin
:
imax
,
j
=
jmin
:
jmax
,
az
(
i
,
j
)
.eq.
0
)
T
(
i
,
j
,:)
=
-9999
*
_
ONE_
T
(:,:,
0
)
=
-9999
._rk
forall
(
i
=
imin
:
imax
,
j
=
jmin
:
jmax
,
az
(
i
,
j
)
.eq.
0
)
T
(
i
,
j
,:)
=
-9999
._rk
call
update_3d_halo
(
T
,
T
,
az
,
imin
,
jmin
,
imax
,
jmax
,
kmax
,
D_TAG
)
call
wait_halo
(
D_TAG
)
...
...
src/3d/variables_3d.F90
View file @
61cae53c
...
...
@@ -115,6 +115,7 @@
IMPLICIT
NONE
!
! !PUBLIC DATA MEMBERS:
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
REALTYPE
::
dt
,
cnpar
=
0.9
REALTYPE
::
avmback
=
_
ZERO_
,
avhback
=
_
ZERO_
logical
::
do_numerical_analyses_3d
=
.false.
...
...
@@ -175,7 +176,6 @@
!
! !LOCAL VARIABLES:
integer
::
rc
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
!EOP
!-------------------------------------------------------------------------
!BOC
...
...
@@ -236,8 +236,8 @@
#endif
! must be nonzero for gotm_fabm in case of calc_temp=F
g1
=
-9999
*
_
ONE_
g2
=
-9999
*
_
ONE_
g1
=
-9999
._rk
g2
=
-9999
._rk
#ifdef DEBUG
write
(
debug
,
*
)
'Leaving init_variables_3d()'
...
...
@@ -367,7 +367,7 @@
! Original author(s): Karsten Bolding & Jorn Bruggeman
!
! !LOCAL VARIABLES:
integer
,
parameter
::
rk
=
kind
(
_
ONE_
)
!
!EOP
!-----------------------------------------------------------------------
!BOC
...
...
src/3d/vertical_coordinates.F90
View file @
61cae53c
...
...
@@ -171,9 +171,9 @@ stop
! calculate the z-coordinate of the cell centers
! references to mean sea level
zc
(:,:,
0
)
=-
H
(:,:)
zc
(:,:,
1
)
=-
H
(:,:)
+
0.5
*
hn
(:,:,
1
)
zc
(:,:,
1
)
=-
H
(:,:)
+
_
HALF_
*
hn
(:,:,
1
)
do
k
=
2
,
kmax
zc
(:,:,
k
)
=
zc
(:,:,
k
-1
)
+
0.5
*
(
hn
(:,:,
k
-1
)
+
hn
(:,:,
k
))
zc
(:,:,
k
)
=
zc
(:,:,
k
-1
)
+
_
HALF_
*
(
hn
(:,:,
k
-1
)
+
hn
(:,:,
k
))
end
do
#ifdef SLICE_MODEL
...
...
src/getm/initialise.F90
View file @
61cae53c
...
...
@@ -372,6 +372,8 @@
end
if
end
if
call
finalize_register_all_variables
(
runtype
)
if
(
.not.
dryrun
)
then
if
(
save_initial
)
then
call
output_manager_prepare_save
(
julianday
,
int
(
secondsofday
),
0
,
int
(
MinN
-1
))
...
...
src/getm/register_all_variables.F90
View file @
61cae53c
...
...
@@ -11,6 +11,12 @@
!
! !USES:
use
field_manager
use
variables_2d
,
only
:
register_2d_variables
use
variables_3d
,
only
:
register_3d_variables
#ifdef _FABM_
use
getm_fabm
,
only
:
register_fabm_variables
#endif
use
output_processing
,
only
:
register_processed_variables
,
finalize_register_processed_variables
IMPLICIT
NONE
!
! default: all is private.
...
...
@@ -225,6 +231,7 @@
#ifdef _FABM_
call
finalize_register_fabm_variables
(
fm
)
#endif
call
finalize_register_processed_variables
(
fm
)
return
end
subroutine
finalize_register_all_variables
...
...
src/ncdf/ncdf_meteo.F90
View file @
61cae53c
...
...
@@ -148,14 +148,8 @@
"dimensions do not match"
)
end
if
il
=
ilg
;
jl
=
jlg
;
ih
=
ihg
;
jh
=
jhg
else
il
=
1
;
jl
=
1
;
ih
=
iextr
;
jh
=
jextr
end
if
start
(
1
)
=
il
;
start
(
2
)
=
jl
;
edges
(
1
)
=
ih
-
il
+1
;
edges
(
2
)
=
jh
-
jl
+1
;
edges
(
3
)
=
1
allocate
(
beta
(
E2DFIELD
),
stat
=
err
)
if
(
err
/
=
0
)
&
stop
'init_meteo_input_ncdf: Error allocating memory (beta)'
...
...
@@ -174,6 +168,7 @@
call
to_rotated_lat_lon
(
southpole
,
olon
,
olat
,
rlon
,
rlat
,
x
)
beta
=
x
end
if
il
=
1
;
jl
=
1
;
ih
=
iextr
;
jh
=
jextr
else
if
(
met_lat
(
1
)
.gt.
met_lat
(
2
))
then
LEVEL3
'Reverting lat-axis and setting grid_scan to 0'
...
...
@@ -228,8 +223,21 @@
call
getm_error
(
"init_meteo_input_ncdf()"
,
&
"Some interpolation coefficients are not valid"
)
end
if
il
=
minval
(
gridmap
(:,:,
1
),
mask
=
(
gridmap
(:,:,
1
)
.gt.
0
))
jl
=
minval
(
gridmap
(:,:,
2
),
mask
=
(
gridmap
(:,:,
2
)
.gt.
0
))
ih
=
min
(
maxval
(
gridmap
(:,:,
1
))
+1
,
iextr
)
jh
=
min
(
maxval
(
gridmap
(:,:,
2
))
+1
,
jextr
)
where
(
gridmap
(:,:,
1
)
.gt.
0
)
gridmap
(:,:,
1
)
=
gridmap
(:,:,
1
)
-
il
+
1
where
(
gridmap
(:,:,
2
)
.gt.
0
)
gridmap
(:,:,
2
)
=
gridmap
(:,:,
2
)
-
jl
+
1
end
if
start
(
1
)
=
il
;
start
(
2
)
=
jl
;
edges
(
1
)
=
ih
-
il
+1
;
edges
(
2
)
=
jh
-
jl
+1
;
edges
(
3
)
=
1
allocate
(
d_airp
(
E2DFIELD
),
stat
=
rc
)
if
(
rc
/
=
0
)
stop
'init_meteo_input_ncdf: Error allocating memory (d_airp)'
d_airp
=
-9999
*
_
ONE_
...
...
@@ -846,7 +854,7 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
!
! !LOCAL VARIABLES:
integer
::
i
,
j
,
err
REALTYPE
,
dimension
(
edges
(
1
),
edges
(
2
))
::
wrk
,
wrk_dp
REALTYPE
,
dimension
(
edges
(
1
),
edges
(
2
))
::
wrk
!
,wrk_dp
REALTYPE
::
angle
,
uu
,
vv
,
sinconv
,
cosconv
!EOP
!-----------------------------------------------------------------------
...
...
@@ -866,8 +874,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
end
if
else
!KBKwrk_dp = _ZERO_
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
airp_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,airp_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
airp_input
)
end
if
end
if
...
...
@@ -881,8 +891,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
evap_input
(
ill
:
ihl
,
jll
:
jhl
)
=
wrk
end
if
else
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
evap_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,evap_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
evap_input
)
end
if
if
(
evap_factor
.ne.
_
ONE_
)
then
evap_input
=
evap_input
*
evap_factor
...
...
@@ -899,8 +911,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
precip_input
(
ill
:
ihl
,
jll
:
jhl
)
=
wrk
end
if
else
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
precip_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,precip_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
precip_input
)
end
if
if
(
precip_factor
.ne.
_
ONE_
)
then
precip_input
=
precip_input
*
precip_factor
...
...
@@ -920,8 +934,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
end
if
else
!KBKwrk_dp = _ZERO_
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
u10_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,u10_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
u10_input
)
end
if
end
if
...
...
@@ -936,8 +952,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
end
if
else
!KBKwrk_dp = _ZERO_
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
v10_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,v10_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
v10_input
)
end
if
end
if
...
...
@@ -976,8 +994,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
end
if
else
!KBKwrk_dp = _ZERO_
call
copy_var
(
grid_scan
,
wrk
,
wrk_dp
)
call
do_grid_interpol
(
az
,
wrk_dp
,
gridmap
,
ti
,
ui
,
t2_input
)
!call copy_var(grid_scan,wrk,wrk_dp)
!call do_grid_interpol(az,wrk_dp,gridmap,ti,ui,t2_input)
call
flip_var
(
wrk
)
call
do_grid_interpol
(
az
,
wrk
,
gridmap
,
ti
,
ui
,
t2_input
)
end
if
end
if
...
...
@@ -992,8 +1012,10 @@ STDERR 'grid_north_pole_longitude ',southpole(2)
end
if
else
!KBKwrk_dp = _ZERO_