model_specific.f90

Go to the documentation of this file.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Time-stamp: <2016-04-13 15:10:55 pbrowne>
!!!
!!!    This file must be adapted to the specific model in use.
!!!    Copyright (C) 2014  Philip A. Browne
!!!
!!!    This program is free software: you can redistribute it and/or modify
!!!    it under the terms of the GNU General Public License as published by
!!!    the Free Software Foundation, either version 3 of the License, or
!!!    (at your option) any later version.
!!!
!!!    This program is distributed in the hope that it will be useful,
!!!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!!!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!!    GNU General Public License for more details.
!!!
!!!    You should have received a copy of the GNU General Public License
!!!    along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!!
!!!    Email: p.browne @ reading.ac.uk
!!!    Mail:  School of Mathematical and Physical Sciences,
!!!           University of Reading,
!!!       Reading, UK
!!!       RG6 6BB
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

subroutine configure_model
  use pf_control
  use timestep_data
  use sizes
  implicit none
  !this is for lorenz 96
  state_dim = 40
  obs_dim = 20
  call timestep_data_set_total(pf%time_bwn_obs*pf%time_obs)
  print*,'#################################'
  print*,'######### SANITY CHECK ##########'
  print*,'#################################'
  print*,'## STATE DIMENSION = ',state_dim
  print*,'##  OBS  DIMENSION = ',obs_dim
  print*,'## TOTAL TIMESTEPS = ',tsdata%total_timesteps
  print*,'#################################'
end subroutine configure_model

subroutine reconfigure_model
end subroutine reconfigure_model




subroutine solve_r(obsDim,nrhs,y,v,t)
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(obsdim,nrhs), intent(in) :: y
  real(kind=rk), dimension(obsdim,nrhs), intent(out) :: v
  integer, intent(in) :: t

  !v = y/(0.3d0**2)
  stop 'Solve_r not yet implemented'
  
end subroutine solve_r


subroutine solve_rhalf(obsdim,nrhs,y,v,t)
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(obsdim,nrhs), intent(in) :: y
  real(kind=rk), dimension(obsdim,nrhs), intent(out) :: v
  integer, intent(in) :: t

  !v = y/(0.3d0**2)
  stop 'Solve_r_half not yet implemented'
  
end subroutine solve_rhalf



subroutine solve_hqht_plus_r(obsdim,y,v,t)
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsdim
  real(kind=rk), dimension(obsdim), intent(in) :: y
  real(kind=rk), dimension(obsdim), intent(out) :: v
  integer, intent(in) :: t
  

  !v = y/(5.3d3**2+0.3d0**2)
  stop 'solve_hqht_plus_r not yet implemented'


end subroutine solve_hqht_plus_r

subroutine q(nrhs,x,Qx)

  use sizes
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(state_dim,nrhs), intent(in) :: x
  real(kind=rk), dimension(state_dim,nrhs), intent(out) :: Qx
  real(kind=rk), dimension(state_dim,nrhs) :: temp

  call qhalf(nrhs,x,temp)

  call qhalf(nrhs,temp,qx)
  

end subroutine q



subroutine qhalf(nrhs,x,Qx)
  use sizes
  use qdata
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(state_dim,nrhs), intent(in) :: x
  real(kind=rk), dimension(state_dim,nrhs), intent(out) :: qx

  !qx = 5.3d3*x
  stop 'Qhalf not yet implemented'
  
end subroutine qhalf

subroutine r(obsDim,nrhs,y,Ry,t)
  use rdata
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(obsDim,nrhs), intent(in) :: y
  real(kind=rk), dimension(obsDim,nrhs), intent(out) :: Ry
  integer, intent(in) :: t


  stop 'R not yet implemented'
  !Ry = 0.3d0**2*y

end subroutine r

subroutine rhalf(obsDim,nrhs,y,Ry,t)
  use rdata
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(obsDim,nrhs), intent(in) :: y
  real(kind=rk), dimension(obsDim,nrhs), intent(out) :: Ry
  integer, intent(in) :: t


  stop 'Rhalf not yet implemented'
  !Ry = 0.3d0*y

end subroutine rhalf


subroutine h(obsDim,nrhs,x,hx,t)
  use sizes  
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(state_dim,nrhs), intent(in) :: x
  real(kind=rk), dimension(obsDim,nrhs), intent(out) :: hx
  integer, intent(in) :: t


  stop 'H not yet implemented'
  !hx(:,:) = x(539617:566986,:)

end subroutine h

subroutine ht(obsDim,nrhs,y,x,t)
  use sizes
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: obsDim
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(obsDim,nrhs), intent(in) :: y
  real(kind=rk), dimension(state_dim,nrhs), intent(out) :: x
  integer, intent(in) :: t

  stop 'HT not yet implemented'
  !x = 0.0_rk
  !x(539617:566986,:) = y(:,:)

end subroutine ht

subroutine dist_st_ob(xp,yp,dis,t)
  use sizes
  implicit none
  integer, intent(in) :: xp
  integer, intent(in) :: yp
  real(kind=kind(1.0d0)), intent(out) :: dis
  integer, intent(in) :: t
  stop 'dist not yet implemented'
end subroutine dist_st_ob


subroutine bhalf(nrhs,x,bx)
  use sizes
  use qdata
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(state_dim,nrhs), intent(in) :: x
  real(kind=rk), dimension(state_dim,nrhs), intent(out) :: bx

  !qx = 5.3d3*x
  stop 'Bhalf not yet implemented'
  
end subroutine bhalf

subroutine solve_b(nrhs,x,v)
  use sizes
  implicit none
  integer, parameter :: rk=kind(1.0d+0)
  integer, intent(in) :: nrhs
  real(kind=rk), dimension(state_dim,nrhs), intent(in) :: x
  real(kind=rk), dimension(state_dim,nrhs), intent(out) :: v

  !v = y/(0.3d0**2)
  stop 'solve_b not yet implemented'
  
end subroutine solve_b

subroutine get_observation_data(y,t)

  use sizes
  implicit none
  integer, parameter :: rk = kind(1.0d0)
  integer, intent(in) :: t
  real(kind=rk), dimension(obs_dim), intent(out) :: y


  !This is set up to call the routine written which will
  !work to do twin experiments. If you want to use your own
  !observations you should implement your own method of reading
  !in the observations
  call default_get_observation_data(y,t)
end subroutine get_observation_data