UFO
ufo_steric.F90
Go to the documentation of this file.
1 module steric
2 
3  implicit none
4  private
5  public :: steric_nl, steric_tl, steric_ad
6 contains
7  !==========================================================================
8  subroutine steric_nl (etas, t, s, t0, s0, eta0, z)
9  !==========================================================================
10  !
11  ! Calculates the steric height relative to the reference state t0, s0, eta0
12  !
13  ! Input:
14  ! ------
15  ! s : Absolute Salinity [g/kg]
16  ! t : Conservative Temperature [deg C]
17  ! s0 : Ref. Absolute Salinity [g/kg]
18  ! t0 : Ref. Conservative Temperature [deg C]
19  ! eta0 : Reference sea-surface height [m]
20  ! z : Depth of t,s [m]
21  !
22  ! Output:
23  ! -------
24  ! etas : steric height [m]
25  !--------------------------------------------------------------------------
26  !
27  ! z1=0 ----------- Surface
28  ! t1,s1 h1 (thickness)
29  ! z2 -----------
30  ! t2,s2 h2
31  ! z3 -----------
32  ! t3,s3
33  ! .
34  ! .
35  ! .
36  ! zN-1 -----------
37  ! tN-1,sN-1 hN-1
38  ! zN -----------
39  ! tN,sN hN
40  ! zN+1 ----------- Bottom
41  ! ///////////
42 
43  use gsw_mod_toolbox, only : gsw_rho
44  use gsw_mod_kinds
45 
46  implicit none
47 
48  real (r8), dimension(:), intent(in) :: t, s, t0, s0, eta0, z
49  real (r8), intent(out) :: etas(1)
50  real (r8) :: rho0(1), rho(1), h
51  real (r8) :: p(1), lat=0.0
52 
53  integer :: k, n
54 
55  n=size(t,1)
56  etas=eta0
57  do k=1,n
58  h=z(k+1)-z(k)
59  p = z(k)+h/2.0 ! assume p~z
60  rho0 = gsw_rho(s0(k),t0(k),p)
61  rho = gsw_rho(s(k),t(k),p)
62  etas = etas + h*(rho-rho0)/rho0
63  end do
64 
65  end subroutine steric_nl
66 
67  !==========================================================================
68  subroutine steric_tl (detas, dt, ds, t0, s0, z)
69  !==========================================================================
70  !
71  ! Tangent of stericnl relative to the reference state t0, s0
72  !
73  ! Input:
74  ! ------
75  ! ds : Absolute Salinity [g/kg]
76  ! dt : Conservative Temperature [deg C]
77  ! s0 : Ref. Absolute Salinity [g/kg]
78  ! t0 : Ref. Conservative Temperature [deg C]
79  ! z : Depth of t,s [m]
80  !
81  ! Output:
82  ! -------
83  ! detas : steric height [m]
84  !
85  ! jac : Jacobian [detas/dt1, ...,detas/dtN; [m/deg C]
86  ! detas/ds1, ...,detas/dsN] [m/(g/kg)]
87  !
88  !--------------------------------------------------------------------------
89 
90  use gsw_mod_toolbox, only : gsw_rho, gsw_rho_first_derivatives
91  use gsw_mod_kinds
92 
93  implicit none
94 
95  real (r8), dimension(:), intent(in) :: dt, ds, t0, s0, z
96  real (r8), intent(out) :: detas
97  real (r8), allocatable, dimension(:,:) :: jac
98  real (r8) :: rho0(1), rho(1), h, deriv(3)
99  real (r8) :: p(1), drhods, drhodt, drhodp
100 
101  integer :: k, n
102 
103  detas = 0.0
104  n=size(dt,1)
105  allocate(jac(2,n)) !jac(1,:)=deta/dt; jac(2,:)=deta/ds at t0, s0
106  do k=1,n
107  h=z(k+1)-z(k)
108  p = z(k)+h/2.0 ! assume p~z
109  rho0 = gsw_rho(s0(k),t0(k),p)
110  call gsw_rho_first_derivatives(s0(k),t0(k),p(1),drhods, drhodt, drhodp)
111  jac(1,k)=h*drhodt/rho0(1)
112  jac(2,k)=h*drhods/rho0(1)
113  detas = detas + jac(1,k)*dt(k) + jac(2,k)*ds(k)
114  end do
115  deallocate(jac)
116  end subroutine steric_tl
117 
118  !==========================================================================
119  subroutine steric_ad (detas, dt_ad, ds_ad, t0, s0, z)
120  !==========================================================================
121  !
122  ! Adjoint of sterictl relative to the trajectory t0, s0
123  !
124  ! Input:
125  ! ------
126  ! detas : Steric Height [m]
127  ! s0 : Traj. for Absolute Salinity [g/kg]
128  ! t0 : Traj. for Conservative Temperature [deg C]
129  ! z : Depth of t,s [m]
130  !
131  ! Output:
132  ! -------
133  !
134  ! ds_ad : Adjoint var for Absolute Salinity [g/kg]
135  ! dt_ad : Adjoint var for Conservative Temperature [deg C]
136  !
137  !--------------------------------------------------------------------------
138 
139  use gsw_mod_toolbox, only : gsw_rho, gsw_rho_first_derivatives
140  use gsw_mod_kinds
141 
142  implicit none
143 
144  real (r8), dimension(:), intent(in) :: t0, s0, z
145  real (r8), intent(in) :: detas
146  real (r8), allocatable, dimension(:,:) :: jac
147  real (r8), dimension(:), intent(out) :: dt_ad, ds_ad
148 
149  real (r8) :: rho0(1), rho(1), h, deriv(3)
150  real (r8) :: p(1), drhods, drhodt, drhodp
151 
152  integer :: k, n
153 
154  n=size(dt_ad,1)
155  allocate(jac(2,n)) !jac(1,:)=deta/dt; jac(2,:)=deta/ds at t0, s0
156  dt_ad = 0.0
157  ds_ad = 0.0
158  do k=1,n
159  h=z(k+1)-z(k)
160  p = z(k)+h/2.0 ! assume p~z
161  rho0 = gsw_rho(s0(k),t0(k),p)
162  call gsw_rho_first_derivatives(s0(k),t0(k),p(1),drhods, drhodt, drhodp)
163  jac(1,k)=h*drhodt/rho0(1)
164  jac(2,k)=h*drhods/rho0(1)
165  dt_ad(k) = dt_ad(k) + jac(1,k)*detas
166  ds_ad(k) = ds_ad(k) + jac(2,k)*detas
167  end do
168  deallocate(jac)
169  end subroutine steric_ad
170 
171 end module steric
steric::steric_ad
subroutine, public steric_ad(detas, dt_ad, ds_ad, t0, s0, z)
Definition: ufo_steric.F90:120
steric::steric_nl
subroutine, public steric_nl(etas, t, s, t0, s0, eta0, z)
Definition: ufo_steric.F90:9
steric::steric_tl
subroutine, public steric_tl(detas, dt, ds, t0, s0, z)
Definition: ufo_steric.F90:69