Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90	(revision 5841)
@@ -0,0 +1,154 @@
+MODULE gastransfer
+   !!======================================================================
+   !!                         ***  MODULE trcdms_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2015-06  (A. Yool)             added for UKESM1 project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+
+      PUBLIC   gas_transfer  ! called by trcbio_medusa.F90 module
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id: trcbio.F90 1146 2008-06-25 11:42:56Z rblod $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+      subroutine gas_transfer(wind, N, eqn, kw660)
+! --------------------------------------------------------------------
+!  Gas transfer velocity
+! --------------------------------------------------------------------
+!
+! Title  : Calculates gas transfer velocity
+! Author : Andrew Yool
+! Date   : 15/10/04
+! 
+! This subroutine uses near-surface wind speed to calculate gas
+! transfer velocity for use in CO2 and O2 exchange calculations.
+!
+! Note that the parameterisation of Wanninkhof quoted here is a
+! truncation of the original equation.  It excludes a chemical
+! enhancement function (based on temperature), although such
+! temperature dependence is reported negligible by Etcheto & 
+! Merlivat (1988).
+!
+! Note also that in calculating scalar wind, the variance of the
+! wind over the period of a timestep is ignored.  Some authors,
+! for instance OCMIP-2, favour including some reference to the
+! variability of wind.  However, their wind fields are averaged
+! over relatively long time periods, and so this issue may be
+! safely (!) ignored here.
+! 
+! AXY (12/06/2015)
+! UPDATED: revised formulation from Wanninkhof (2014) update to
+! original 1992 paper. Full reference is:
+!
+! Wanninkhof, R. (2014). Relationship between wind speed and gas 
+! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+! 12, 351-362, doi:10.4319/lom.2014.12.351
+! 
+! Subroutine inputs are (in order) : 
+!     wind      wind velocity at 10 m (m/s)
+!     N         size of input array (value 1 at this time)
+!     eqn       choice of parameterisation:
+!               1 = Liss & Merlivat (1986)    [approximated]
+!               2 = Wanninkhof (1992)         [sans enhancement]
+!               3 = Nightingale et al. (2000) [good]
+!               4 = Nightingale et al. (2000) [better]
+!               5 = Nightingale et al. (2000) [best]
+!               6 = OCMIP-2                   [sans variability]
+!               7 = Wanninkhof (2014)         [assumes 6h avg winds]
+! (*) k         gas transfer velocity (m/s)
+! 
+! Where (*) is the function output and (+) is a diagnostic output.
+!
+      implicit none
+
+      INTEGER, INTENT(in) :: N, eqn
+! Input variables
+!     real(kind=wp), INTENT(in),  DIMENSION(N) :: wind
+      real(wp), INTENT(in)  :: wind
+!
+! Output variables
+!     real(kind=wp), INTENT(out), DIMENSION(N) :: kw660
+      real(wp), INTENT(out) :: kw660
+!
+!     INTEGER :: eqn
+!
+! Coefficients for various parameterisations
+      real(wp) :: a(7)
+      real(wp) :: b(7)
+!
+!     real(wp), DIMENSION(N) :: tmp_k
+      real(wp) :: tmp_k
+!
+! Values of coefficients
+      data a(1) / 0.166 /  ! Liss & Merlivat (1986)    [approximated]
+      data a(2) / 0.3   /  ! Wanninkhof (1992)         [sans enhancement]
+      data a(3) / 0.23  /  ! Nightingale et al. (2000) [good]
+      data a(4) / 0.23  /  ! Nightingale et al. (2000) [better]
+      data a(5) / 0.222 /  ! Nightingale et al. (2000) [best]
+      data a(6) / 0.337 /  ! OCMIP-2                   [sans variability]
+      data a(7) / 0.251 /  ! Wanninkhof (2014)         [assumes 6h avg winds]
+!
+      data b(1) / 0.133 /
+      data b(2) / 0.0   /
+      data b(3) / 0.0   /
+      data b(4) / 0.1   /
+      data b(5) / 0.333 /
+      data b(6) / 0.0   /
+      data b(7) / 0.0   /
+!
+! Which parameterisation is to be used?
+!     eqn = 7
+!
+! Calculate gas transfer velocity (cm/h)
+      tmp_k = (a(eqn) * wind**2) + (b(eqn) * wind)
+!
+! Convert tmp_k from cm/h to m/s
+      kw660 = tmp_k / (100. * 3600.)
+!
+      return
+
+    end subroutine gas_transfer
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE gas_transfer(wind, N, eqn, kw660)
+      USE par_kind
+
+      REAL(wp), INTENT( in )    :: wind
+      REAL(wp), INTENT( in )    :: kw660
+      INTEGER, INTENT(in) :: N, eqn
+
+      WRITE(*,*) 'gas_transfer: You should not have seen this print! error?', kt
+
+   END SUBROUTINE gas_transfer
+#endif
+
+   !!======================================================================
+END MODULE gastransfer
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90	(revision 5841)
@@ -0,0 +1,242 @@
+MODULE mocsy_gasflux
+
+CONTAINS
+
+! --------------------------------------------------------------------
+!  Schmidt CO2 number
+! --------------------------------------------------------------------
+!
+! Title  : Calculates Schmidt number for ocean uptake of CO2
+! Author : Andrew Yool
+! Date   : 14/10/04
+!
+! This function calculates the Schmidt number for CO2 using sea surface
+! temperature.  The code is based upon that developed as part of the
+! OCMIP-2 project (1998-2000).  The coefficients used are taken from
+! Wanninkhof (1992, JGR, 97, 7373-7382).
+!
+! AXY (12/06/2015)
+! UPDATED: coefficients used below are now those from Wanninkhof (2014)
+! update to original 1992 paper. Full reference is:
+!
+! Winninkhof, R. (2014). Relationship between wind speed and gas 
+! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+! 12, 351-362, doi:10.4319/lom.2014.12.351
+!
+! Check answer for the function at 20 degrees C is 668.
+!
+! Function inputs are (in order) :
+!     t            temperature (degrees C)
+! (*) co2_schmidt  carbon dioxide Schmidt number
+!
+! Where (*) is the function output.
+!
+      subroutine schmidt_co2(pt, N, co2_schmidt)
+
+      USE mocsy_singledouble
+
+      implicit none
+!
+      INTEGER, INTENT(in) :: N
+      real(kind=wp), INTENT(in),  DIMENSION(N) :: pt
+      real(kind=wp), INTENT(out), DIMENSION(N) :: co2_schmidt
+!
+      real(kind=wp)              :: a0, a1, a2, a3, a4
+!
+!     data a0 /    2073.1 /
+!     data a1 /   -125.62 /
+!     data a2 /    3.6276 /
+!     data a3 / -0.043219 /
+!
+      data a0 /    2116.8 /
+      data a1 /   -136.25 /
+      data a2 /    4.7353 /
+      data a3 / -0.092307 /
+      data a4 / 0.0007555 /
+!
+! Wanninkhof (1992)
+!     co2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3))
+!
+! Wanninkhof (2014) adds in an extra term
+      co2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*(a3 + pt*a4)))
+!
+      return
+
+      end subroutine schmidt_co2
+
+! --------------------------------------------------------------------
+!  Surface K0
+! --------------------------------------------------------------------
+!
+! Title  : Calculates surface K0 from surface T & S
+! Author : Andrew Yool
+! Date   : 18/06/15
+!
+! This function is derived from code included in the MOCSY package
+! produced by Jim Orr.
+!
+      subroutine surface_K0(ptmp, saln, N, K0)
+
+      USE mocsy_singledouble
+
+      implicit none
+!
+      INTEGER, INTENT(in) :: N
+      real(kind=wp), INTENT(in),  DIMENSION(N) :: ptmp, saln
+      real(kind=wp), INTENT(out), DIMENSION(N) :: K0
+!
+      real(kind=wp), DIMENSION(N) :: tk, invtk, tmp
+      real(kind=wp)               :: a0, a1, a2, a3, a4
+!
+      tk    = ptmp + 273.15d0
+      invtk = 1.0d0 / tk
+      tmp = (9345.17d0*invtk) - 60.2409d0 + (23.3585d0 * LOG(tk/100.0d0))
+      K0 = EXP( tmp + saln*(0.023517d0 - (0.00023656d0*tk) + (0.0047036e-4_wp*tk*tk)) )
+!
+      return
+
+      end subroutine surface_K0
+
+! --------------------------------------------------------------------
+!  Calculate xCO2
+! --------------------------------------------------------------------
+!
+!>    Compute xCO2 from arrays of pCO2atm, in situ T, S, & atm pressure
+SUBROUTINE pCO2atm2xCO2(pCO2atm, temp, salt, Patm, N, xCO2)
+  !    Purpose:
+  !    Compute xCO2 from arrays of pCO2atm, in situ T, S, & atm pressure
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> atmospheric partial pressure of CO2 [uatm] 
+  ! AXY (22/06/15): amended this next line to "in" as that's what it should be!
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pCO2atm
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> mole fraction of CO2 [ppm]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: xCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dpCO2atm, dPatm
+  REAL(kind=wp), DIMENSION(N) :: pH20
+  REAL(kind=wp) :: dxCO2
+
+  INTEGER :: i
+
+  call vapress(temp, salt, N, pH20)
+
+  DO i = 1,N
+     dpCO2atm  = DBLE(pCO2atm(i))
+     dPatm     = DBLE(Patm(i))
+     dxCO2     = dpCO2atm / (dPatm - pH20(i))
+     xCO2(i) = REAL(dxCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE pCO2atm2xCO2
+
+! --------------------------------------------------------------------
+!  Calculate pCO2atm
+! --------------------------------------------------------------------
+!
+!>    Compute pCO2atm from arrays of xCO2, in situ T, S, & atm pressure
+SUBROUTINE x2pCO2atm(xCO2, temp, salt, Patm, N, pCO2atm)
+  !    Purpose:
+  !    Compute pCO2atm from arrays of xCO2, in situ T, S, & atm pressure
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> mole fraction of CO2 [ppm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: xCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> oceanic partial pressure of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pCO2atm
+
+! LOCAL variables:
+  REAL(kind=wp) :: dxCO2, dPatm
+  REAL(kind=wp), DIMENSION(N) :: pH20
+  REAL(kind=wp) :: dpCO2atm
+
+  INTEGER :: i
+
+! Compute vapor pressure of seawater [in atm]
+  call vapress(temp, salt, N, pH20)
+
+  DO i = 1,N
+     dxCO2     = DBLE(xCO2(i))
+     dPatm     = DBLE(Patm(i))
+     dpCO2atm = (dPatm - pH20(i)) * dxCO2
+     pCO2atm(i) = REAL(dpCO2atm)
+  END DO
+
+  RETURN
+END SUBROUTINE x2pCO2atm
+
+! --------------------------------------------------------------------
+!  Calculate seawater vapor pressure
+! --------------------------------------------------------------------
+!
+!>    Compute vapor pressure of seawater (atm) following preocedure from Weiss & Price (1980)
+SUBROUTINE vapress(temp, salt, N, vpsw)
+  !    Purpose:
+  !    Compute vapor pressure of seawater (atm) following preocedure from Weiss & Price (1980)
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> vapor pressure of seawater [atm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: vpsw
+
+! LOCAL variables:
+  REAL(kind=wp) :: tk, dsalt
+
+  INTEGER :: i
+
+  DO i = 1,N
+     dsalt = DBLE(salt(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     vpsw(i) = exp(24.4543d0 - 67.4509d0*(100.0d0/tk) - 4.8489d0*log(tk/100) - 0.000544d0*dsalt)
+  END DO
+
+  RETURN
+END SUBROUTINE vapress
+
+END MODULE mocsy_gasflux
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90	(revision 5841)
@@ -0,0 +1,2063 @@
+MODULE mocsy_mainmod
+
+      USE in_out_manager  ! I/O manager
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+!  SW_ADTG
+! ----------------------------------------------------------------------
+!
+!> \file sw_adtg.f90
+!! \BRIEF 
+!> Module with sw_adtg function - compute adiabatic temp. gradient from S,T,P
+!>  Function to calculate adiabatic temperature gradient as per UNESCO 1983 routines.
+FUNCTION sw_adtg  (s,t,p)
+
+  !     ==================================================================
+  !     Calculates adiabatic temperature gradient as per UNESCO 1983 routines.
+  !     Armin Koehl akoehl@ucsd.edu
+  !     ==================================================================
+  USE mocsy_singledouble
+  IMPLICIT NONE
+  !> salinity [psu (PSU-78)]
+  REAL(kind=wp) :: s
+  !> temperature [degree C (IPTS-68)]
+  REAL(kind=wp) :: t
+  !> pressure [db]
+  REAL(kind=wp) :: p
+
+  REAL(kind=wp) :: a0,a1,a2,a3,b0,b1,c0,c1,c2,c3,d0,d1,e0,e1,e2
+  REAL(kind=wp) :: sref
+
+  REAL(kind=wp) :: sw_adtg
+
+  sref = 35.d0
+  a0 =  3.5803d-5
+  a1 = +8.5258d-6
+  a2 = -6.836d-8
+  a3 =  6.6228d-10
+
+  b0 = +1.8932d-6
+  b1 = -4.2393d-8
+
+  c0 = +1.8741d-8
+  c1 = -6.7795d-10
+  c2 = +8.733d-12
+  c3 = -5.4481d-14
+
+  d0 = -1.1351d-10
+  d1 =  2.7759d-12
+
+  e0 = -4.6206d-13
+  e1 = +1.8676d-14
+  e2 = -2.1687d-16
+
+  sw_adtg =  a0 + (a1 + (a2 + a3*T)*T)*T &
+       + (b0 + b1*T)*(S-sref) &
+       + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P &
+       + (  e0 + (e1 + e2*T)*T )*P*P
+
+END FUNCTION sw_adtg
+
+! ----------------------------------------------------------------------
+!  SW_ADTG
+! ----------------------------------------------------------------------
+!
+!> \file sw_ptmp.f90
+!! \BRIEF 
+!> Module with sw_ptmp function - compute potential T from in-situ T
+!> Function to calculate potential temperature [C] from in-situ temperature
+FUNCTION sw_ptmp  (s,t,p,pr)
+
+  !     ==================================================================
+  !     Calculates potential temperature [C] from in-situ Temperature [C]
+  !     From UNESCO 1983 report.
+  !     Armin Koehl akoehl@ucsd.edu
+  !     ==================================================================
+
+  !     Input arguments:
+  !     -------------------------------------
+  !     s  = salinity            [psu      (PSS-78) ]
+  !     t  = temperature         [degree C (IPTS-68)]
+  !     p  = pressure            [db]
+  !     pr = reference pressure  [db]
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input arguments
+  !> salinity [psu (PSS-78)]
+  REAL(kind=wp) :: s
+  !> temperature [degree C (IPTS-68)]
+  REAL(kind=wp) :: t
+  !> pressure [db]
+  REAL(kind=wp) :: p
+  !> reference pressure  [db]  
+  REAL(kind=wp) :: pr
+
+! local arguments
+  REAL(kind=wp) :: del_P ,del_th, th, q
+  REAL(kind=wp) :: onehalf, two, three
+  PARAMETER (onehalf = 0.5d0, two = 2.d0, three = 3.d0 )
+
+! REAL(kind=wp) :: sw_adtg
+! EXTERNAL sw_adtg
+
+! Output 
+  REAL(kind=wp) :: sw_ptmp
+
+  ! theta1
+  del_P  = PR - P
+  del_th = del_P*sw_adtg(S,T,P)
+  th     = T + onehalf*del_th
+  q      = del_th
+
+  ! theta2
+  del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)
+  th     = th + (1.d0 - 1.d0/SQRT(two))*(del_th - q)
+  q      = (two-SQRT(two))*del_th + (-two+three/SQRT(two))*q
+
+  ! theta3
+  del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)
+  th     = th + (1.d0 + 1.d0/SQRT(two))*(del_th - q)
+  q      = (two + SQRT(two))*del_th + (-two-three/SQRT(two))*q
+
+  ! theta4
+  del_th = del_P*sw_adtg(S,th,P+del_P)
+  sw_ptmp     = th + (del_th - two*q)/(two*three)
+
+  RETURN
+END FUNCTION sw_ptmp
+
+
+! ----------------------------------------------------------------------
+!  SW_TEMP
+! ----------------------------------------------------------------------
+!
+!> \file sw_temp.f90
+!! \BRIEF 
+!> Module with sw_temp function - compute in-situ T from potential T
+!> Function to compute in-situ temperature [C] from potential temperature [C]
+FUNCTION sw_temp( s, t, p, pr )
+  !     =============================================================
+  !     SW_TEMP
+  !     Computes in-situ temperature [C] from potential temperature [C]
+  !     Routine available in seawater.f (used for MIT GCM)
+  !     Downloaded seawater.f (on 17 April 2009) from
+  !     http://ecco2.jpl.nasa.gov/data1/beaufort/MITgcm/bin/
+  !     =============================================================
+
+  !     REFERENCES:
+  !     Fofonoff, P. and Millard, R.C. Jr
+  !     Unesco 1983. Algorithms for computation of fundamental properties of
+  !     seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp.
+  !     Eqn.(31) p.39
+
+  !     Bryden, H. 1973.
+  !     "New Polynomials for thermal expansion, adiabatic temperature gradient
+  !     and potential temperature of sea water."
+  !     DEEP-SEA RES., 1973, Vol20,401-408.
+  !     =============================================================
+
+  !     Simple modifications: J. C. Orr, 16 April 2009
+  !     - combined fortran code from MITgcm site & simplification in
+  !       CSIRO code (matlab equivalent) from Phil Morgan
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !     Input arguments:
+  !     -----------------------------------------------
+  !     s  = salinity              [psu      (PSS-78) ]
+  !     t  = potential temperature [degree C (IPTS-68)]
+  !     p  = pressure              [db]
+  !     pr = reference pressure    [db]
+
+  !> salinity [psu (PSS-78)]
+  REAL(kind=wp) ::   s
+  !> potential temperature [degree C (IPTS-68)]
+  REAL(kind=wp) ::   t
+  !> pressure [db]
+  REAL(kind=wp) ::   p
+  !> reference pressure [db]
+  REAL(kind=wp) ::   pr
+
+  REAL(kind=wp) ::  ds, dt, dp, dpr
+  REAL(kind=wp) :: dsw_temp
+
+  REAL(kind=wp) ::   sw_temp
+! EXTERNAL sw_ptmp
+! REAL(kind=wp) ::   sw_ptmp
+
+  ds = DBLE(s)
+  dt = DBLE(t)
+  dp = DBLE(p)
+  dpr = DBLE(pr)
+
+  !    Simple solution
+  !    (see https://svn.mpl.ird.fr/us191/oceano/tags/V0/lib/matlab/seawater/sw_temp.m)
+  !    Carry out inverse calculation by swapping P_ref (pr) and Pressure (p)
+  !    in routine that is normally used to compute potential temp from temp
+  dsw_temp = sw_ptmp(ds, dt, dpr, dp)
+  sw_temp = REAL(dsw_temp)
+
+  !    The above simplification works extremely well (compared to Table in 1983 report)
+  !    whereas the sw_temp routine from MIT GCM site does not seem to work right
+
+  RETURN
+END FUNCTION sw_temp
+
+! ----------------------------------------------------------------------
+!  TPOT
+! ----------------------------------------------------------------------
+!
+!> \file tpot.f90
+!! \BRIEF 
+!>    Module with tpot subroutine - compute potential T from in situ T,S,P
+!>    Compute potential temperature from arrays of in situ temp, salinity, and pressure.
+!!    This subroutine is needed because sw_ptmp is a function (using scalars not arrays)
+SUBROUTINE tpot(salt, tempis, press, pressref, N, tempot)
+  !    Purpose:
+  !    Compute potential temperature from arrays of in situ temp, salinity, and pressure.
+  !    Needed because sw_ptmp is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempis
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: press
+!f2py optional , depend(salt) :: n=len(salt)
+  !> pressure reference level [db]
+  REAL(kind=wp), INTENT(in) :: pressref
+
+! OUTPUT variables:
+  !> potential temperature [C] for pressref
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempot
+
+  REAL(kind=wp) :: dsalt, dtempis, dpress, dpressref
+  REAL(kind=wp) :: dtempot
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dsalt     = DBLE(salt(i))
+     dtempis   = DBLE(tempis(i))
+     dpress    = DBLE(press(i))
+     dpressref = DBLE(pressref)
+
+     dtempot   = sw_ptmp(dsalt, dtempis, dpress, dpressref)
+
+     tempot(i) = REAL(dtempot)
+  END DO
+
+  RETURN
+END SUBROUTINE tpot
+
+! ----------------------------------------------------------------------
+!  TIS
+! ----------------------------------------------------------------------
+!
+!> \file tis.f90
+!! \BRIEF 
+!>    Module with tis subroutine - compute in situ T from S,T,P
+!>    Compute in situ temperature from arrays of potential temp, salinity, and pressure.
+!!    This subroutine is needed because sw_temp is a function (using scalars not arrays)
+SUBROUTINE tis(salt, tempot, press, pressref, N, tempis)
+  !    Purpose:
+  !    Compute in situ temperature from arrays of in situ temp, salinity, and pressure.
+  !    Needed because sw_temp is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> potential temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempot
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: press
+!f2py optional , depend(salt) :: n=len(salt)
+  !> pressure reference level [db]
+  REAL(kind=wp), INTENT(in) :: pressref
+
+! OUTPUT variables:
+  !> in situ temperature [C] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempis
+
+! REAL(kind=wp) :: dsalt, dtempis, dpress, dpressref
+! REAL(kind=wp) :: dtempot
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_temp
+! REAL(kind=wp) :: sw_temp
+! EXTERNAL sw_temp
+
+  DO i = 1,N
+    !dsalt     = DBLE(salt(i))
+    !dtempot   = DBLE(tempot(i))
+    !dpress    = DBLE(press(i))
+    !dpressref = DBLE(pressref)
+    !dtempis   = sw_temp(dsalt, dtempot, dpress, dpressref)
+    !tempis(i) = REAL(dtempis)
+
+     tempis   = sw_temp(salt(i), tempot(i), press(i), pressref)
+  END DO
+
+  RETURN
+END SUBROUTINE tis
+
+! ----------------------------------------------------------------------
+!  P80
+! ----------------------------------------------------------------------
+!
+!> \file p80.f90
+!! \BRIEF 
+!> Module with p80 function - compute pressure from depth
+!>     Function to compute pressure from depth using Saunder's (1981) formula with eos80.
+FUNCTION p80(dpth,xlat)
+
+  !     Compute Pressure from depth using Saunder's (1981) formula with eos80.
+
+  !     Reference:
+  !     Saunders, Peter M. (1981) Practical conversion of pressure
+  !     to depth, J. Phys. Ooceanogr., 11, 573-574, (1981)
+
+  !     Coded by:
+  !     R. Millard
+  !     March 9, 1983
+  !     check value: p80=7500.004 dbars at lat=30 deg., depth=7321.45 meters
+
+  !     Modified (slight format changes + added ref. details):
+  !     J. Orr, 16 April 2009
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input variables:
+  !> depth [m]
+  REAL(kind=wp), INTENT(in) :: dpth
+  !> latitude [degrees]
+  REAL(kind=wp), INTENT(in) :: xlat
+
+! Output variable:
+  !> pressure [db]
+  REAL(kind=wp) :: p80
+
+! Local variables:
+  REAL(kind=wp) :: pi
+  REAL(kind=wp) :: plat, d, c1
+
+  pi=3.141592654
+
+  plat = ABS(xlat*pi/180.)
+  d  = SIN(plat)
+  c1 = 5.92e-3+d**2 * 5.25e-3
+
+  p80 = ((1-c1)-SQRT(((1-c1)**2)-(8.84e-6*dpth))) / 4.42e-6
+
+  RETURN
+END FUNCTION p80
+
+! ----------------------------------------------------------------------
+!  RHO
+! ----------------------------------------------------------------------
+!
+!> \file rho.f90
+!! \BRIEF 
+!> Module with rho function - computes in situ density from S, T, P
+!> Function to compute in situ density from salinity (psu), in situ temperature (C), & pressure (bar)
+FUNCTION rho(salt, temp, pbar)
+
+  ! Compute in situ density from salinity (psu), in situ temperature (C), & pressure (bar)
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> salinity [psu]
+  REAL(kind=wp) :: salt
+  !> in situ temperature (C)
+  REAL(kind=wp) :: temp
+  !> pressure (bar) [Note units: this is NOT in decibars]
+  REAL(kind=wp) :: pbar
+
+  REAL(kind=wp) :: s, t, p
+! REAL(kind=wp) :: t68
+  REAL(kind=wp) :: X
+  REAL(kind=wp) :: rhow, rho0
+  REAL(kind=wp) :: a, b, c
+  REAL(kind=wp) :: Ksbmw, Ksbm0, Ksbm
+  REAL(kind=wp) :: drho
+
+  REAL(kind=wp) :: rho
+
+  !     Input arguments:
+  !     -------------------------------------
+  !     s  = salinity            [psu      (PSS-78) ]
+  !     t  = in situ temperature [degree C (IPTS-68)]
+  !     p  = pressure            [bar] !!!!  (not in [db]
+
+  s = DBLE(salt)
+  t = DBLE(temp)
+  p = DBLE(pbar)
+
+! Convert the temperature on today's "ITS 90" scale to older IPTS 68 scale
+! (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+! According to Best-Practices guide, line above should be commented & 2 lines below should be uncommented
+! Guide's answer of rho (s=35, t=25, p=0) = 1023.343 is for temperature given on ITPS-68 scale
+! t68 = (T - 0.0002) / 0.99975
+! X = t68
+! Finally, don't do the ITS-90 to IPTS-68 conversion (T input var now already on IPTS-68 scale)
+  X = T
+
+! Density of pure water
+  rhow = 999.842594d0 + 6.793952e-2_wp*X          &
+       -9.095290e-3_wp*X*X + 1.001685e-4_wp*X**3  &
+       -1.120083e-6_wp*X**4 + 6.536332e-9_wp*X**5
+
+! Density of seawater at 1 atm, P=0
+  A = 8.24493e-1_wp - 4.0899e-3_wp*X                         &
+       + 7.6438e-5_wp*X*X - 8.2467e-7_wp*X**3 + 5.3875e-9_wp*X**4
+  B = -5.72466e-3_wp + 1.0227e-4_wp*X - 1.6546e-6_wp*X*X
+  C = 4.8314e-4_wp
+
+  rho0 = rhow + A*S + B*S*SQRT(S) + C*S**2.0d0
+
+! Secant bulk modulus of pure water
+! The secant bulk modulus is the average change in pressure
+! divided by the total change in volume per unit of initial volume.
+  Ksbmw = 19652.21d0 + 148.4206d0*X - 2.327105d0*X*X &
+       + 1.360477e-2_wp*X**3 - 5.155288e-5_wp*X**4
+
+! Secant bulk modulus of seawater at 1 atm
+  Ksbm0 = Ksbmw + S*( 54.6746d0 - 0.603459d0*X + 1.09987e-2_wp*X**2 &
+       - 6.1670e-5_wp*X**3) &
+       + S*SQRT(S)*( 7.944e-2_wp + 1.6483e-2_wp*X - 5.3009e-4_wp*X**2)
+
+! Secant bulk modulus of seawater at S,T,P
+  Ksbm = Ksbm0 &
+       + P*(3.239908d0 + 1.43713e-3_wp*X + 1.16092e-4_wp*X**2 - 5.77905e-7_wp*X**3) &
+       + P*S*(2.2838e-3_wp - 1.0981e-5_wp*X - 1.6078e-6_wp*X**2) &
+       + P*S*SQRT(S)*1.91075e-4_wp &
+       + P*P*(8.50935e-5_wp - 6.12293e-6_wp*X + 5.2787e-8_wp*X**2) &
+       + P*P*S*(-9.9348e-7_wp + 2.0816e-8_wp*X + 9.1697e-10_wp*X**2)
+
+! Density of seawater at S,T,P
+  drho = rho0/(1.0d0 - P/Ksbm)
+  rho = REAL(drho)
+
+  RETURN
+END FUNCTION rho
+
+! ----------------------------------------------------------------------
+!  RHOINSITU
+! ----------------------------------------------------------------------
+!
+!> \file rhoinsitu.f90
+!! \BRIEF 
+!> Module with rhoinsitu subroutine - compute in situ density from S, Tis, P
+!>     Compute in situ density from salinity (psu), in situ temperature (C), & pressure (db).
+!!     This subroutine is needed because rho is a function (using scalars not arrays)
+SUBROUTINE rhoinsitu(salt, tempis, pdbar, N, rhois)
+
+  !     Purpose:
+  !     Compute in situ density from salinity (psu), in situ temperature (C), & pressure (db)
+  !     Needed because rho is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  INTEGER :: N
+
+! INPUT variables
+  ! salt   = salinity [psu]
+  ! tempis = in situ temperature [C]
+  ! pdbar  = pressure [db]
+
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempis
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pdbar
+!f2py optional , depend(salt) :: n=len(salt)
+
+! OUTPUT variables:
+  ! rhois  = in situ density
+
+  !> in situ density [kg/m3]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: rhois
+
+! Local variables
+  INTEGER :: i
+
+! REAL(kind=wp) ::  rho
+! EXTERNAL rho
+
+  DO i = 1,N
+     rhois(i) = rho(salt(i), tempis(i), pdbar(i)/10.)
+  END DO
+
+  RETURN
+END SUBROUTINE rhoinsitu
+
+! ----------------------------------------------------------------------
+!  DEPTH2PRESS
+! ----------------------------------------------------------------------
+!
+!> \file depth2press.f90
+!! \BRIEF 
+!> Module with depth2press subroutine - converts depth to pressure
+!! with Saunders (1981) formula
+!>     Compute pressure [db] from depth [m] & latitude [degrees north].
+!!     This subroutine is needed because p80 is a function (using scalars not arrays)
+SUBROUTINE depth2press(depth, lat, pdbar, N)
+
+  !     Purpose:
+  !     Compute pressure [db] from depth [m] & latitude [degrees north].
+  !     Needed because p80 is a function 
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> depth [m]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: depth
+  !> latitude [degrees]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: lat
+!f2py optional , depend(depth) :: n=len(depth)
+
+! OUTPUT variables:
+  !> pressure [db]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pdbar
+
+  !     Local variables
+  INTEGER :: i
+
+! REAL(kind=wp) ::  p80
+! EXTERNAL p80
+
+  DO i = 1,N
+     pdbar(i) = p80(depth(i), lat(i))
+  END DO
+
+  RETURN
+END SUBROUTINE depth2press
+
+! ----------------------------------------------------------------------
+!  CONSTANTS
+! ----------------------------------------------------------------------
+!
+!> \file constants.f90
+!! \BRIEF 
+!> Module with contants subroutine - computes carbonate system constants
+!! from S,T,P 
+!> Compute thermodynamic constants
+!! FROM temperature, salinity, and pressure (1D arrays)
+SUBROUTINE constants(K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa,  &
+                     K1p, K2p, K3p, Ksi,                      &
+                     St, Ft, Bt,                              &
+                     temp, sal, Patm,                         &
+                     depth, lat, N,                           &
+                     optT, optP, optB, optK1K2, optKf, optGAS)
+
+  !   Purpose:
+  !     Compute thermodynamic constants
+  !     FROM: temperature, salinity, and pressure (1D arrays)
+
+  !     INPUT variables:
+  !     ================
+  !     Patm    = atmospheric pressure [atm]
+  !     depth   = depth [m]     (with optP='m', i.e., for a z-coordinate model vertical grid is depth, not pressure)
+  !             = pressure [db] (with optP='db')
+  !     lat     = latitude [degrees] (needed to convert depth to pressure, i.e., when optP='m')
+  !             = dummy array (unused when optP='db')
+  !     temp    = potential temperature [degrees C] (with optT='Tpot', i.e., models carry tempot, not temp)
+  !             = in situ   temperature [degrees C] (with optT='Tinsitu', e.g., for data)
+  !     sal     = salinity in [psu]
+  !     ---------
+  !     optT: choose in situ vs. potential temperature as input
+  !     ---------
+  !     NOTE: Carbonate chem calculations require IN-SITU temperature (not potential Temperature)
+  !       -> 'Tpot' means input is pot. Temperature (in situ Temp "tempis" is computed)
+  !       -> 'Tinsitu' means input is already in-situ Temperature, not pot. Temp ("tempis" not computed)
+  !     ---------
+  !     optP: choose depth (m) vs pressure (db) as input
+  !     ---------
+  !       -> 'm'  means "depth" input is in "m" (thus in situ Pressure "p" [db] is computed)
+  !       -> 'db' means "depth" input is already in situ pressure [db], not m (p = depth)
+  !     ---------
+  !     optB:
+  !     ---------
+  !       -> 'u74' means use classic formulation of Uppström (1974) for total Boron
+  !       -> 'l10' means use newer   formulation of Lee et al. (2010) for total Boron
+  !     ---------
+  !     optK1K2:
+  !     ---------
+  !       -> 'l'   means use Lueker et al. (2000) formulations for K1 & K2 (recommended by Dickson et al. 2007)
+  !                **** BUT this should only be used when 2 < T < 35 and 19 < S < 43
+  !       -> 'm10' means use Millero (2010) formulation for K1 & K2 (see Dickson et al., 2007)
+  !                **** Valid for 0 < T < 50°C and 1 < S < 50 psu
+  !     -----------
+  !     optKf:
+  !     ----------
+  !       -> 'pf' means use Perez & Fraga (1987) formulation for Kf (recommended by Dickson et al., 2007)
+  !               **** BUT Valid for  9 < T < 33°C and 10 < S < 40.
+  !       -> 'dg' means use Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2
+  !     ---------
+  !       PRESSURE corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi
+  !     St, Ft, Bt
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input variables
+  !>     number of records
+  INTEGER, INTENT(in) :: N
+  !> in <b>situ temperature</b> (when optT='Tinsitu', typical data) 
+  !! OR <b>potential temperature</b> (when optT='Tpot', typical models) [degree C]
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: temp
+  !> depth in <b>meters</b> (when optP='m') or <b>decibars</b> (when optP='db')
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: depth
+  !> latitude <b>[degrees north]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: lat
+  !> salinity <b>[psu]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sal
+!f2py optional , depend(sal) :: n=len(sal)
+
+  !> atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+
+  !> for temp input, choose \b 'Tinsitu' for in situ Temp or 
+  !! \b 'Tpot' for potential temperature (in situ Temp is computed, needed for models)
+  CHARACTER(7), INTENT(in) :: optT
+  !> for depth input, choose \b "db" for decibars (in situ pressure) or \b "m" for meters (pressure is computed, needed for models)
+  CHARACTER(2), INTENT(in) :: optP
+  !> for total boron, choose either \b 'u74' (Uppstrom, 1974) or \b 'l10' (Lee et al., 2010).
+  !! The 'l10' formulation is based on 139 measurements (instead of 20),
+  !! uses a more accurate method, and
+  !! generally increases total boron in seawater by 4% 
+!f2py character*3 optional, intent(in) :: optB='l10'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optB
+  !> for Kf, choose either \b 'pf' (Perez & Fraga, 1987) or \b 'dg' (Dickson & Riley, 1979)
+!f2py character*2 optional, intent(in) :: optKf='pf'
+  CHARACTER(2), OPTIONAL, INTENT(in) :: optKf
+  !> for K1,K2 choose either \b 'l' (Lueker et al., 2000) or \b 'm10' (Millero, 2010) 
+!f2py character*3 optional, intent(in) :: optK1K2='l'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optK1K2
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Ouput variables
+  !> solubility of CO2 in seawater (Weiss, 1974), also known as K0
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K0
+  !> K1 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K1
+  !> K2 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K2
+  !> equilibrium constant for dissociation of boric acid 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kb
+  !> equilibrium constant for the dissociation of water (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kw
+  !> equilibrium constant for the dissociation of bisulfate (Dickson, 1990)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ks
+  !> equilibrium constant for the dissociation of hydrogen fluoride 
+  !! either from Dickson and Riley (1979) or from Perez and Fraga (1987), depending on optKf
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kf
+  !> solubility product for calcite (Mucci, 1983)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kspc
+  !> solubility product for aragonite (Mucci, 1983)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kspa
+  !> 1st dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K1p
+  !> 2nd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K2p
+  !> 3rd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K3p
+  !> equilibrium constant for the dissociation of silicic acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ksi
+  !> total sulfate (Morris & Riley, 1966)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: St
+  !> total fluoride  (Riley, 1965)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ft
+  !> total boron
+  !! from either Uppstrom (1974) or Lee et al. (2010), depending on optB
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Bt
+
+! Local variables
+  REAL(kind=wp) :: ssal
+  REAL(kind=wp) :: p
+  REAL(kind=wp) :: tempot, tempis68, tempot68
+  REAL(kind=wp) :: tempis
+  REAL(kind=wp) :: is, invtk, dlogtk, is2, s2, sqrtis
+  REAL(kind=wp) :: Ks_0p, Kf_0p
+  REAL(kind=wp) :: total2free, free2SWS, total2SWS, SWS2total
+  REAL(kind=wp) :: total2free_0p, free2SWS_0p, total2SWS_0p
+! REAL(kind=wp) :: free2SWS, free2SWS_0p
+
+  REAL(kind=wp) :: dtempot, dtempot68
+  REAL(kind=wp) :: R
+
+  REAL(kind=wp) :: pK1o, ma1, mb1, mc1, pK1
+  REAL(kind=wp) :: pK2o, ma2, mb2, mc2, pK2
+
+  REAL(kind=wp), DIMENSION(12) :: a0, a1, a2, b0, b1, b2
+  REAL(kind=wp), DIMENSION(12) :: deltav, deltak, lnkpok0
+  REAL(kind=wp) :: tmp, nK0we74
+
+  INTEGER :: i, icount, ipc
+
+  REAL(kind=wp) :: t, tk, tk0, prb
+  REAL(kind=wp) :: s, sqrts, s15, scl
+
+  REAL(kind=wp) :: Phydro_atm, Patmd, Ptot, Rgas_atm, vbarCO2
+
+! Arrays to pass optional arguments into or use defaults (Dickson et al., 2007)
+  CHARACTER(3) :: opB
+  CHARACTER(2) :: opKf
+  CHARACTER(3) :: opK1K2
+  CHARACTER(7) :: opGAS
+
+  ! CONSTANTS
+  ! =========
+  ! Constants in formulation for Pressure effect on K's (Millero, 95)
+  ! with corrected coefficients for Kb, Kw, Ksi, etc.
+
+  ! index: 1) K1 , 2) K2, 3) Kb, 4) Kw, 5) Ks, 6) Kf, 7) Kspc, 8) Kspa,
+  !            9) K1P, 10) K2P, 11) K3P, 12) Ksi
+
+  DATA a0 /-25.5_wp, -15.82_wp, -29.48_wp, -20.02_wp, &
+          -18.03_wp,  -9.78_wp, -48.76_wp, -45.96_wp, &
+          -14.51_wp, -23.12_wp, -26.57_wp, -29.48_wp/
+  DATA a1 /0.1271_wp, -0.0219_wp, 0.1622_wp, 0.1119_wp, &
+           0.0466_wp, -0.0090_wp, 0.5304_wp, 0.5304_wp, &
+           0.1211_wp, 0.1758_wp, 0.2020_wp, 0.1622_wp/
+  DATA a2 /     0.0_wp,       0.0_wp, -2.608e-3_wp, -1.409e-3_wp, &
+           0.316e-3_wp, -0.942e-3_wp,  0.0_wp,       0.0_wp, &
+          -0.321e-3_wp, -2.647e-3_wp, -3.042e-3_wp, -2.6080e-3_wp/
+  DATA b0 /-3.08e-3_wp, 1.13e-3_wp,  -2.84e-3_wp,   -5.13e-3_wp, &
+           -4.53e-3_wp, -3.91e-3_wp, -11.76e-3_wp, -11.76e-3_wp, &
+           -2.67e-3_wp, -5.15e-3_wp,  -4.08e-3_wp,  -2.84e-3_wp/
+  DATA b1 /0.0877e-3_wp, -0.1475e-3_wp, 0.0_wp,       0.0794e-3_wp, &
+           0.09e-3_wp,    0.054e-3_wp,  0.3692e-3_wp, 0.3692e-3_wp, &
+           0.0427e-3_wp,  0.09e-3_wp,   0.0714e-3_wp, 0.0_wp/
+  DATA b2 /12*0.0_wp/
+
+! Set defaults for optional arguments (in Fortran 90)
+! Note:  Optional arguments with f2py (python) are set above with 
+!        the !f2py statements that precede each type declaraion
+  IF (PRESENT(optB)) THEN
+    opB = optB
+  ELSE
+    opB = 'l10'
+  ENDIF
+  IF (PRESENT(optKf)) THEN
+    opKf = optKf
+  ELSE
+    opKf = 'pf'
+  ENDIF
+  IF (PRESENT(optK1K2)) THEN
+    opK1K2 = optK1K2
+  ELSE
+    opK1K2 = 'l'
+  ENDIF
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+  R = 83.14472_wp
+
+  icount = 0
+  DO i = 1, N
+     icount = icount + 1
+!    ===============================================================
+!    Convert model depth -> press; convert model Theta -> T in situ
+!    ===============================================================
+!    * Model temperature tracer is usually "potential temperature"
+!    * Model vertical grid is usually in meters
+!    BUT carbonate chem routines require pressure & in-situ T
+!    Thus before computing chemistry, if appropriate,
+!    convert these 2 model vars (input to this routine)
+!     - depth [m] => convert to pressure [db]
+!     - potential temperature (C) => convert to in-situ T (C)
+!    -------------------------------------------------------
+!    1)  Compute pressure [db] from depth [m] and latitude [degrees] (if input is m, for models)
+     IF (trim(optP) == 'm' ) THEN
+!       Compute pressure [db] from depth [m] and latitude [degrees]
+        p = p80(depth(i), lat(i))
+     ELSEIF (trim(optP) == 'db' ) THEN
+!       In this case (where optP = 'db'), p is input & output (no depth->pressure conversion needed)
+        p = depth(i)
+     ELSE
+        PRINT *,"optP must be 'm' or 'db'"
+        STOP
+     ENDIF
+
+!    2) Convert potential T to in-situ T (if input is Tpot, i.e. case for models):
+     IF (trim(optT) == 'Tpot' .OR. trim(optT) == 'tpot') THEN
+        tempot = temp(i)
+!       This is the case for most models and some data
+!       a) Convert the pot. temp on today's "ITS 90" scale to older IPTS 68 scale
+!          (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+        tempot68 = (tempot - 0.0002) / 0.99975
+!       b) Compute "in-situ Temperature" from "Potential Temperature" (both on IPTS 68)
+        tempis68 = sw_temp(sal(i), tempot68, p, 0.0_wp )
+!       c) Convert the in-situ temp on older IPTS 68 scale to modern scale (ITS 90)
+        tempis = 0.99975*tempis68 + 0.0002
+!       Note: parts (a) and (c) above are tiny corrections;
+!             part  (b) is a big correction for deep waters (but zero at surface)
+     ELSEIF (trim(optT) == 'Tinsitu' .OR. trim(optT) == 'tinsitu') THEN
+!       When optT = 'Tinsitu', tempis is input & output (no tempot needed)
+        tempis    = temp(i)
+        tempis68  = (temp(i) - 0.0002) / 0.99975
+!       dtempot68 = sw_ptmp(DBLE(sal(i)), DBLE(tempis68), DBLE(p), 0.0_wp)
+        dtempot68 = sw_ptmp(sal(i), tempis68, p, 0.0_wp)
+        dtempot   = 0.99975*dtempot68 + 0.0002
+     ELSE
+        PRINT *,"optT must be either 'Tpot' or 'Tinsitu'"
+        PRINT *,"you specified optT =", trim(optT) 
+        STOP
+     ENDIF
+
+!    Compute constants:
+     IF (temp(i) >= -5. .AND. temp(i) < 1.0e+2) THEN
+!       Test to indicate if any of input variables are unreasonable
+        IF (      sal(i) < 0.  .OR.  sal(i) > 1e+3) THEN
+           PRINT *, 'i, icount, temp, sal =', i, icount, temp(i), sal(i)
+        ENDIF
+!       Zero out negative salinity (prev case for OCMIP2 model w/ slightly negative S in some coastal cells)
+        IF (sal(i) < 0.0) THEN
+           ssal = 0.0
+        ELSE
+           ssal = sal(i)
+        ENDIF
+
+!       Absolute temperature (Kelvin) and related values
+        t = DBLE(tempis)
+        tk = 273.15d0 + t
+        invtk=1.0d0/tk
+        dlogtk=LOG(tk)
+
+!       Atmospheric pressure
+        Patmd = DBLE(Patm(i))
+
+!       Hydrostatic pressure (prb is in bars)
+        prb = DBLE(p) / 10.0d0
+
+!       Salinity and simply related values
+        s = DBLE(ssal)
+        s2=s*s
+        sqrts=SQRT(s)
+        s15=s**1.5d0
+        scl=s/1.80655d0
+
+!       Ionic strength:
+        is = 19.924d0*s/(1000.0d0 - 1.005d0*s)
+        is2 = is*is
+        sqrtis = SQRT(is)
+
+!       Total concentrations for sulfate, fluoride, and boron
+
+!       Sulfate: Morris & Riley (1966)
+        St(i) = 0.14d0 * scl/96.062d0
+
+!       Fluoride:  Riley (1965)
+        Ft(i) = 0.000067d0 * scl/18.9984d0
+
+!       Boron:
+        IF (trim(opB) == 'l10') THEN
+!          New formulation from Lee et al (2010)
+           Bt(i) = 0.0002414d0 * scl/10.811d0
+        ELSEIF (trim(opB) == 'u74') THEN
+!          Classic formulation from Uppström (1974)
+           Bt(i) = 0.000232d0  * scl/10.811d0
+        ELSE
+           PRINT *,"optB must be 'l10' or 'u74'"
+           STOP
+        ENDIF
+
+!       K0 (K Henry)
+!       CO2(g) <-> CO2(aq.)
+!       K0  = [CO2]/ fCO2
+!       Weiss (1974)   [mol/kg/atm]
+        IF     (trim(opGAS) == 'Pzero'   .OR. trim(opGAS) == 'pzero') THEN
+           tk0 = tk                   !in situ temperature (K) for K0 calculation
+           Ptot = Patmd               !total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Ppot'    .OR. trim(opGAS) == 'ppot') THEN
+           tk0 = dtempot + 273.15d0   !potential temperature (K) for K0 calculation as needed for potential fCO2 & pCO2
+           Ptot = Patmd               !total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+           tk0 = tk                     !in situ temperature (K) for K0 calculation
+           Phydro_atm = prb / 1.01325d0 !convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+           Ptot = Patmd + Phydro_atm    !total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+        ELSE
+           PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+           STOP
+        ENDIF
+        tmp = 9345.17d0/tk0 - 60.2409d0 + 23.3585d0 * LOG(tk0/100.0d0)
+        nK0we74 = tmp + s*(0.023517d0 - 0.00023656d0*tk0 + 0.0047036e-4_wp*tk0*tk0)
+        K0(i) = EXP(nK0we74)
+
+!       K1 = [H][HCO3]/[H2CO3]
+!       K2 = [H][CO3]/[HCO3]
+        IF (trim(opK1K2) == 'l') THEN
+!         Mehrbach et al. (1973) refit, by Lueker et al. (2000) (total pH scale)
+          K1(i) = 10.0d0**(-1.0d0*(3633.86d0*invtk - 61.2172d0 + 9.6777d0*dlogtk  &
+                  - 0.011555d0*s + 0.0001152d0*s2))
+          K2(i) = 10.0d0**(-1*(471.78d0*invtk + 25.9290d0 - 3.16967d0*dlogtk      &
+                  - 0.01781d0*s + 0.0001122d0*s2))
+        ELSEIF (trim(opK1K2) == 'm10') THEN
+!         Millero (2010, Mar. Fresh Wat. Res.) (total pH scale)
+!         pK1o = 6320.813d0*invtk + 19.568224d0*dlogtk -126.34048d0
+!         ma1 = 13.4051d0*sqrts + 0.03185d0*s - (5.218e-5)*s2
+!         mb1 = -531.095d0*sqrts - 5.7789d0*s
+!         mc1 = -2.0663d0*sqrts
+!         pK1 = pK1o + ma1 + mb1*invtk + mc1*dlogtk
+!         K1(i) = 10.0d0**(-pK1) 
+
+!         pK2o = 5143.692d0*invtk + 14.613358d0*dlogtk -90.18333d0
+!         ma2 = 21.5724d0*sqrts + 0.1212d0*s - (3.714e-4)*s2
+!         mb2 = -798.292d0*sqrts - 18.951d0*s
+!         mc2 = -3.403d0*sqrts
+!         pK2 = pK2o + ma2 + mb2*invtk + mc2*dlogtk
+!         K2(i) = 10.0d0**(-pK2)
+
+!         Millero (2010, Mar. Fresh Wat. Res.) (seawater pH scale)
+          pK1o = 6320.813d0*invtk + 19.568224d0*dlogtk -126.34048d0
+          ma1 = 13.4038d0*sqrts + 0.03206d0*s - (5.242e-5)*s2
+          mb1 = -530.659d0*sqrts - 5.8210d0*s
+          mc1 = -2.0664d0*sqrts
+          pK1 = pK1o + ma1 + mb1*invtk + mc1*dlogtk
+          K1(i) = 10.0d0**(-pK1) 
+
+          pK2o = 5143.692d0*invtk + 14.613358d0*dlogtk -90.18333d0
+          ma2 = 21.3728d0*sqrts + 0.1218d0*s - (3.688e-4)*s2
+          mb2 = -788.289d0*sqrts - 19.189d0*s
+          mc2 = -3.374d0*sqrts
+          pK2 = pK2o + ma2 + mb2*invtk + mc2*dlogtk
+          K2(i) = 10.0d0**(-pK2)
+        ELSE
+           PRINT *, "optK1K2 must be either 'l' or 'm10'"
+           STOP
+        ENDIF
+
+!       Kb = [H][BO2]/[HBO2]
+!       (total scale)
+!       Millero p.669 (1995) using data from Dickson (1990)
+        Kb(i) = EXP((-8966.90d0 - 2890.53d0*sqrts - 77.942d0*s +  &
+                1.728d0*s15 - 0.0996d0*s2)*invtk +              &
+                (148.0248d0 + 137.1942d0*sqrts + 1.62142d0*s) +   &
+                (-24.4344d0 - 25.085d0*sqrts - 0.2474d0*s) *      &
+                dlogtk + 0.053105d0*sqrts*tk)
+
+!       K1p = [H][H2PO4]/[H3PO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.20 with footnote using data from Millero (1974)
+!       Millero (1995), p.670, eq. 65
+!       Use Millero equation's 115.540 constant instead of 115.525 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K1p(i) = EXP(-4576.752d0*invtk + 115.540d0 - 18.453d0*dlogtk +  &
+                 (-106.736d0*invtk + 0.69171d0) * sqrts +             &
+                 (-0.65643d0*invtk - 0.01844d0) * s)
+
+!       K2p = [H][HPO4]/[H2PO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.23 with footnote using data from Millero (1974))
+!       Millero (1995), p.670, eq. 66
+!       Use Millero equation's 172.1033 constant instead of 172.0833 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K2p(i) = EXP(-8814.715d0*invtk + 172.1033d0 - 27.927d0*dlogtk +  &
+                 (-160.340d0*invtk + 1.3566d0)*sqrts +                 &
+                 (0.37335d0*invtk - 0.05778d0)*s)
+
+!       K3p = [H][PO4]/[HPO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.26 with footnote using data from Millero (1974)
+!       Millero (1995), p.670, eq. 67
+!       Use Millero equation's 18.126 constant instead of 18.141 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K3p(i) = EXP(-3070.75d0*invtk - 18.126d0 +            &
+                 (17.27039d0*invtk + 2.81197d0) *             &
+                 sqrts + (-44.99486d0*invtk - 0.09984d0) * s)
+
+!       Ksi = [H][SiO(OH)3]/[Si(OH)4]
+!       (seawater scale)
+!       Millero (1995), p.671, eq. 72
+!       Use Millero equation's 117.400 constant instead of 117.385 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        Ksi(i) = EXP(-8904.2d0*invtk  + 117.400d0 - 19.334d0*dlogtk +  &
+                 (-458.79d0*invtk + 3.5913d0) * sqrtis +             &
+                 (188.74d0*invtk - 1.5998d0) * is +                  &
+                 (-12.1652d0*invtk + 0.07871d0) * is2 +              &
+                 LOG(1.0 - 0.001005d0*s))
+
+!       Kw = [H][OH]
+!       (seawater scale)
+!       Millero (1995) p.670, eq. 63 from composite data
+!       Use Millero equation's 148.9802 constant instead of 148.9652 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        Kw(i) = EXP(-13847.26d0*invtk + 148.9802d0 - 23.6521d0*dlogtk +  &
+               (118.67d0*invtk - 5.977d0 + 1.0495d0 * dlogtk) *          &
+               sqrts - 0.01615d0 * s)
+
+!       Ks = [H][SO4]/[HSO4]
+!       (free scale)
+!       Dickson (1990, J. chem. Thermodynamics 22, 113)
+        Ks_0p = EXP(-4276.1d0*invtk + 141.328d0 - 23.093d0*dlogtk          &
+                + (-13856.d0*invtk + 324.57d0 - 47.986d0*dlogtk) * sqrtis  &
+                + (35474.d0*invtk - 771.54 + 114.723d0*dlogtk) * is      &
+                - 2698.d0*invtk*is**1.5 + 1776.d0*invtk*is2              &
+                + LOG(1.0d0 - 0.001005d0*s))
+
+!       Kf = [H][F]/[HF]
+!       (total scale)
+        IF (trim(opKf) == 'dg') THEN
+!          Dickson and Riley (1979) -- change pH scale to total (following Dickson & Goyet, 1994)
+           Kf_0p = EXP(1590.2d0*invtk - 12.641d0 + 1.525d0*sqrtis +  &
+                   LOG(1.0d0 - 0.001005d0*s) +                     &
+                   LOG(1.0d0 + St(i)/Ks_0p))
+        ELSEIF (trim(opKf) == 'pf') THEN
+!          Perez and Fraga (1987) - Already on Total scale (no need for last line above)
+!          Formulation as given in Dickson et al. (2007)
+           Kf_0p = EXP(874.d0*invtk - 9.68d0 + 0.111d0*sqrts)
+        ELSE
+           PRINT *, "optKf must be either 'dg' or 'pf'"
+           STOP
+        ENDIF
+
+!       Kspc (calcite) - apparent solubility product of calcite
+!       (no scale)
+!       Kspc = [Ca2+] [CO32-] when soln is in equilibrium w/ calcite
+!       Mucci 1983 mol/kg-soln
+        Kspc(i) = 10d0**(-171.9065d0 - 0.077993d0*tk + 2839.319d0/tk    &
+                 + 71.595d0*LOG10(tk)                             &
+                 + (-0.77712d0 + 0.0028426d0*tk + 178.34d0/tk)*sqrts  &
+                 -0.07711d0*s + 0.0041249d0*s15 )
+
+
+!       Kspa (aragonite) - apparent solubility product of aragonite
+!       (no scale)
+!       Kspa = [Ca2+] [CO32-] when soln is in equilibrium w/ aragonite
+!       Mucci 1983 mol/kg-soln
+        Kspa(i) = 10.d0**(-171.945d0 - 0.077993d0*tk + 2903.293d0/tk &
+             +71.595d0*LOG10(tk) &
+             +(-0.068393d0 + 0.0017276d0*tk + 88.135d0/tk)*sqrts &
+             -0.10018d0*s + 0.0059415d0*s15 )
+
+!       Pressure effect on K0 based on Weiss (1974, equation 5)
+        Rgas_atm = 82.05736_wp      ! (cm3 * atm) / (mol * K)  CODATA (2006)
+        vbarCO2 = 32.3_wp           ! partial molal volume (cm3 / mol) from Weiss (1974, Appendix, paragraph 3)
+        K0(i) = K0(i) * exp( ((1-Ptot)*vbarCO2)/(Rgas_atm*tk0) )   ! Weiss (1974, equation 5)
+
+!       Pressure effect on all other K's (based on Millero, (1995)
+!           index: K1(1), K2(2), Kb(3), Kw(4), Ks(5), Kf(6), Kspc(7), Kspa(8),
+!                  K1p(9), K2p(10), K3p(11), Ksi(12)
+        DO ipc = 1, 12
+           deltav(ipc)  =  a0(ipc) + a1(ipc) *t + a2(ipc) *t*t
+           deltak(ipc)   = (b0(ipc)  + b1(ipc) *t + b2(ipc) *t*t)
+           lnkpok0(ipc)  = (-(deltav(ipc)) &
+                +(0.5d0*deltak(ipc) * prb) &
+                )                         * prb/(R*tk)
+        END DO
+
+!       Pressure correction on Ks (Free scale)
+        Ks(i) = Ks_0p*EXP(lnkpok0(5))
+!       Conversion factor total -> free scale
+        total2free     = 1.d0/(1.d0 + St(i)/Ks(i))   ! Kfree = Ktotal*total2free
+!       Conversion factor total -> free scale at pressure zero
+        total2free_0p  = 1.d0/(1.d0 + St(i)/Ks_0p)   ! Kfree = Ktotal*total2free
+
+!       Pressure correction on Kf
+!       Kf must be on FREE scale before correction
+        Kf_0p = Kf_0p * total2free_0p   !Convert from Total to Free scale (pressure 0)
+        Kf(i) = Kf_0p * EXP(lnkpok0(6)) !Pressure correction (on Free scale)
+        Kf(i) = Kf(i)/total2free        !Convert back from Free to Total scale
+
+!       Convert between seawater and total hydrogen (pH) scales
+        free2SWS  = 1.d0 + St(i)/Ks(i) + Ft(i)/(Kf(i)*total2free)  ! using Kf on free scale
+        total2SWS = total2free * free2SWS                          ! KSWS = Ktotal*total2SWS
+        SWS2total = 1.d0 / total2SWS
+!       Conversion at pressure zero
+        free2SWS_0p  = 1.d0 + St(i)/Ks_0p + Ft(i)/(Kf_0p)  ! using Kf on free scale
+        total2SWS_0p = total2free_0p * free2SWS_0p         ! KSWS = Ktotal*total2SWS
+
+!       Convert from Total to Seawater scale before pressure correction
+!       Must change to SEAWATER scale: K1, K2, Kb
+        IF (trim(optK1K2) == 'l') THEN
+          K1(i)  = K1(i)*total2SWS_0p
+          K2(i)  = K2(i)*total2SWS_0p
+          !This conversion is unnecessary for the K1,K2 from Millero (2010),
+          !since we use here the formulation already on the seawater scale
+        ENDIF
+        Kb(i)  = Kb(i)*total2SWS_0p
+
+!       Already on SEAWATER scale: K1p, K2p, K3p, Kb, Ksi, Kw
+
+!       Other contants (keep on another scale):
+!          - K0         (independent of pH scale, already pressure corrected)
+!          - Ks         (already on Free scale;   already pressure corrected)
+!          - Kf         (already on Total scale;  already pressure corrected)
+!          - Kspc, Kspa (independent of pH scale; pressure-corrected below)
+
+!       Perform actual pressure correction (on seawater scale)
+        K1(i)   = K1(i)*EXP(lnkpok0(1))
+        K2(i)   = K2(i)*EXP(lnkpok0(2))
+        Kb(i)   = Kb(i)*EXP(lnkpok0(3))
+        Kw(i)   = Kw(i)*EXP(lnkpok0(4))
+        Kspc(i) = Kspc(i)*EXP(lnkpok0(7))
+        Kspa(i) = Kspa(i)*EXP(lnkpok0(8))
+        K1p(i)  = K1p(i)*EXP(lnkpok0(9))
+        K2p(i)  = K2p(i)*EXP(lnkpok0(10))
+        K3p(i)  = K3p(i)*EXP(lnkpok0(11))
+        Ksi(i)  = Ksi(i)*EXP(lnkpok0(12))
+
+!       Convert back to original total scale:
+        K1(i)  = K1(i) *SWS2total
+        K2(i)  = K2(i) *SWS2total
+        K1p(i) = K1p(i)*SWS2total
+        K2p(i) = K2p(i)*SWS2total
+        K3p(i) = K3p(i)*SWS2total
+        Kb(i)  = Kb(i) *SWS2total
+        Ksi(i) = Ksi(i)*SWS2total
+        Kw(i)  = Kw(i) *SWS2total
+
+     ELSE
+
+        K0(i)   = 1.e20_wp
+        K1(i)   = 1.e20_wp
+        K2(i)   = 1.e20_wp
+        Kb(i)   = 1.e20_wp
+        Kw(i)   = 1.e20_wp
+        Ks(i)   = 1.e20_wp
+        Kf(i)   = 1.e20_wp
+        Kspc(i) = 1.e20_wp
+        Kspa(i) = 1.e20_wp
+        K1p(i)  = 1.e20_wp
+        K2p(i)  = 1.e20_wp
+        K3p(i)  = 1.e20_wp
+        Ksi(i)  = 1.e20_wp
+        Bt(i)   = 1.e20_wp
+        Ft(i)   = 1.e20_wp
+        St(i)   = 1.e20_wp
+
+     ENDIF
+
+  END DO
+
+  RETURN
+END SUBROUTINE constants
+
+! ----------------------------------------------------------------------
+!  VARSOLVER
+! ----------------------------------------------------------------------
+!
+!> \file varsolver.f90
+!! \BRIEF 
+!> Module with varsolver subroutine - solve for pH and other carbonate system variables
+!>    Solve for pH and other carbonate system variables (with input from vars routine)
+SUBROUTINE varsolver(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC,             &
+                    temp, salt, ta, tc, pt, sit,                                 &
+                    Bt, St, Ft,                                                  &
+                    K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,  & 
+                    Patm, Phydro_bar, rhodum, optGAS                             )
+
+  !   Purpose: Solve for pH and other carbonate system variables (with input from vars routine)
+
+  !     INPUT variables:
+  !     ================
+  !     temp    = in situ temperature [degrees C]
+  !     ta      = total alkalinity                     in [eq/m^3] or [eq/kg]   based on optCON in calling routine (vars)
+  !     tc      = dissolved inorganic carbon           in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     pt      = total dissolved inorganic phosphorus in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     sit     = total dissolved inorganic silicon    in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     Bt      = total dissolved inorganic boron      computed in calling routine (vars)
+  !     St      = total dissolved inorganic sulfur     computed in calling routine (vars)
+  !     Ft      = total dissolved inorganic fluorine   computed in calling routine (vars)
+  !     K's     = K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi 
+  !     Patm    = atmospheric pressure [atm]
+  !     Phydro_bar = hydrostatic pressure [bar]
+  !     rhodum  = density factor as computed in calling routine  (vars)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2 (default optGAS = 'Pinsitu')
+  !     ---------
+  !       PRESSURE & T corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     ph   = pH on total scale
+  !     pco2 = CO2 partial pressure (uatm)
+  !     fco2 = CO2 fugacity (uatm)
+  !     co2  = aqueous CO2 concentration in [mol/kg] or [mol/m^3] determined by rhodum (depends on optCON in calling routine)
+  !     hco3 = bicarbonate (HCO3-) concentration in [mol/kg] or [mol/m^3] determined by rhodum
+  !     co3  = carbonate (CO3--) concentration in [mol/kg] or [mol/m^3] determined by rhodum
+  !     OmegaA = Omega for aragonite, i.e., the aragonite saturation state
+  !     OmegaC = Omega for calcite, i.e., the   calcite saturation state
+
+  USE mocsy_singledouble
+  USE mocsy_phsolvers
+
+  IMPLICIT NONE
+
+! Input variables
+  !> <b>in situ temperature</b> [degrees C]
+  REAL(kind=wp), INTENT(in) :: temp
+  !> <b>salinity</b> [on the practical salinity scale, dimensionless]
+  REAL(kind=wp), INTENT(in) :: salt
+  !> total alkalinity in <b>[eq/m^3]</b> OR in <b>[eq/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: ta
+  !> dissolved inorganic carbon in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: tc
+  !> phosphate concentration in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: pt
+  !> total dissolved inorganic silicon concentration in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: sit
+  !> total boron from either Uppstrom (1974) or Lee et al. (2010), depending on optB in calling routine
+  REAL(kind=wp), INTENT(in) :: Bt
+  !> total sulfate (Morris & Riley, 1966)
+  REAL(kind=wp), INTENT(in) :: St
+  !> total fluoride  (Riley, 1965)
+  REAL(kind=wp), INTENT(in) :: Ft
+  !> solubility of CO2 in seawater (Weiss, 1974), also known as K0
+  REAL(kind=wp), INTENT(in) :: K0
+  !> K1 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(in) :: K1
+  !> K2 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(in) :: K2
+  !> equilibrium constant for dissociation of boric acid 
+  REAL(kind=wp), INTENT(in) :: Kb
+  !> equilibrium constant for the dissociation of water (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: Kw
+  !> equilibrium constant for the dissociation of bisulfate (Dickson, 1990)
+  REAL(kind=wp), INTENT(in) :: Ks
+  !> equilibrium constant for the dissociation of hydrogen fluoride 
+  !! from Dickson and Riley (1979) or Perez and Fraga (1987), depending on optKf
+  REAL(kind=wp), INTENT(in) :: Kf
+  !> solubility product for calcite (Mucci, 1983)
+  REAL(kind=wp), INTENT(in) :: Kspc
+  !> solubility product for aragonite (Mucci, 1983)
+  REAL(kind=wp), INTENT(in) :: Kspa
+  !> 1st dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K1p
+  !> 2nd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K2p
+  !> 3rd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K3p
+  !> equilibrium constant for the dissociation of silicic acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: Ksi
+  !> total atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in) :: Patm
+  !> total hydrostatic pressure <b>[bar]</b>
+  REAL(kind=wp), INTENT(in) :: Phydro_bar
+  !> density factor as computed incalling routine  (vars)
+  REAL(kind=wp), INTENT(in) :: rhodum
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Output variables:
+  !> pH on the <b>total scale</b>
+  REAL(kind=wp), INTENT(out) :: ph
+  !> CO2 partial pressure <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out) :: pco2
+  !> CO2 fugacity <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out) :: fco2
+  !> aqueous CO2* concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg</b>] depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: co2
+  !> bicarbonate ion (HCO3-) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: hco3
+  !> carbonate ion (CO3--) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: co3
+  !> Omega for aragonite, i.e., the aragonite saturation state
+  REAL(kind=wp), INTENT(out) :: OmegaA
+  !> Omega for calcite, i.e., the calcite saturation state
+  REAL(kind=wp), INTENT(out) :: OmegaC
+
+! Local variables
+  REAL(kind=wp) :: Phydro_atm, Ptot
+  REAL(kind=wp) :: Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: tk, tk0
+  real(kind=wp) :: temp68, tempot, tempot68
+  REAL(kind=wp) :: Hinit, H
+  REAL(kind=wp) :: HSO4, HF, HSI, HPO4
+  REAL(kind=wp) :: ab, aw, ac
+  REAL(kind=wp) :: cu, cb, cc
+  REAL(kind=wp) :: Ca
+! Array to pass optional arguments
+  CHARACTER(7) :: opGAS
+
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+! Compute pH from constants and total concentrations
+! - use SolveSAPHE v1.0.1 routines from Munhoven (2013, GMD) modified to use mocsy's Ks instead of its own
+! 1) Compute best starting point for H+ calculation
+  call ahini_for_at(ta, tc, Bt, K1, K2, Kb, Hinit)
+! 2) Solve for H+ using above result as the initial H+ value
+  H = solve_at_general(ta, tc, Bt,                                         & 
+                       pt,     sit,                                        &
+                       St, Ft,                                             &
+                       K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,     &
+                       Hinit)
+! 3) Calculate pH from from H+ concentration (mol/kg)
+  IF (H > 0.d0) THEN
+     pH = -1.*LOG10(H)
+  ELSE
+     pH = 1.e20_wp
+  ENDIF
+
+! Compute carbonate Alk (Ac) by difference: from total Alk and other Alk components
+  HSO4 = St/(1.0d0 + Ks/(H/(1.0d0 + St/Ks)))
+  HF = 1.0d0/(1.0d0 + Kf/H)
+  HSI = 1.0d0/(1.0d0 + H/Ksi)
+  HPO4 = (K1p*K2p*(H + 2.*K3p) - H**3) /                &
+  (H**3 + K1p*H**2 + K1p*K2p*H + K1p*K2p*K3p)
+  ab = Bt/(1.0d0 + H/Kb)
+  aw = Kw/H - H/(1.0d0 + St/Ks)
+  ac = ta + hso4 - sit*hsi - ab - aw + Ft*hf - pt*hpo4
+
+! Calculate CO2*, HCO3-, & CO32- (in mol/kg soln) from Ct, Ac, H+, K1, & K2
+  cu = (2.0d0 * tc - ac) / (2.0d0 + K1 / H)
+  cb = K1 * cu / H
+  cc = K2 * cb / H
+
+! When optCON = 'mol/m3' in calling routine (vars), then:
+! convert output var concentrations from mol/kg to mol/m^3
+! e.g., for case when drho = 1028, multiply by [1.028 kg/L  x  1000 L/m^3])
+  co2  = cu * rhodum
+  hco3 = cb * rhodum
+  co3  = cc * rhodum
+
+! Determine CO2 fugacity [uatm]
+! NOTE: equation just below requires CO2* in mol/kg
+  fCO2 = cu * 1.e6_wp/K0
+
+! Determine CO2 partial pressure from CO2 fugacity [uatm]
+  tk = 273.15d0 + temp
+  !Compute EITHER "potential pCO2" OR "in situ pCO2" (T and P used for calculations will differ)
+  IF     (trim(opGAS) == 'Pzero'   .OR. trim(opGAS) == 'pzero') THEN
+     tk0 = tk                 !in situ temperature (K) for K0 calculation
+     Ptot = Patm              !total pressure (in atm) = atmospheric pressure ONLY
+  ELSEIF (trim(opGAS) == 'Ppot' .OR. trim(opGAS) == 'ppot') THEN
+     !Use potential temperature and atmospheric pressure (water parcel adiabatically brought back to surface)
+     !temp68 = (temp - 0.0002d0) / 0.99975d0          !temp = in situ T; temp68 is same converted to ITPS-68 scale
+     !tempot68 = sw_ptmp(salt, temp68, Phydro_bar*10d0, 0.0d0) !potential temperature (C)
+     !tempot   = 0.99975*tempot68 + 0.0002
+     !tk0 = tempot + 273.15d0  !potential temperature (K) for fugacity coeff. calc as needed for potential fCO2 & pCO2
+     tempot = sw_ptmp(salt, temp, Phydro_bar*10._wp, 0.0_wp) !potential temperature (C)
+     tk0 = tempot + 273.15d0  !potential temperature (K) for fugacity coeff. calc as needed for potential fCO2 & pCO2
+     Ptot = Patm              !total pressure (in atm) = atmospheric pressure ONLY
+  ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+     !Use in situ temperature and total pressure 
+     tk0 = tk                             !in situ temperature (K) for fugacity coefficient calculation
+     Phydro_atm = Phydro_bar / 1.01325d0  !convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+     Ptot = Patm + Phydro_atm            !total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+  ELSE
+     PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+     STOP
+  ENDIF
+
+! Now that we have T and P in the right form, continue with calculation of fugacity coefficient (and pCO2)
+  Rgas_atm = 82.05736_wp      ! (cm3 * atm) / (mol * K)  CODATA (2006)
+! To compute fugcoeff, we need 3 other terms (B, Del, xc2) in addition to 3 others above (tk, Ptot, Rgas_atm)
+  B = -1636.75d0 + 12.0408d0*tk0 - 0.0327957d0*(tk0*tk0) + 0.0000316528d0*(tk0*tk0*tk0)
+  Del = 57.7d0 - 0.118d0*tk0
+! "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+! x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+! Let's assume that xCO2 = fCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+  xCO2approx = fCO2 * 1.e-6_wp
+  IF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+!    xCO2approx = 400.0e-6_wp      !a simple test (gives about same result as seacarb for pCO2insitu)
+!    approximate surface xCO2 ~ surface fCO2 (i.e., in situ fCO2 d by exponential pressure correction)
+     xCO2approx = xCO2approx * exp( ((1-Ptot)*32.3_wp)/(82.05736_wp*tk0) )   ! of K0 press. correction, see Weiss (1974, equation 5)
+  ENDIF
+  xc2 = (1.0d0 - xCO2approx)**2 
+  fugcoeff = exp( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk0) )
+  pCO2 = fCO2 / fugcoeff
+
+! Determine Omega Calcite et Aragonite
+! OmegaA = ((0.01028d0*salt/35.0d0)*cc) / Kspa
+! OmegaC = ((0.01028d0*salt/35.0d0)*cc) / Kspc
+! - see comments from Munhoven on the best value "0.02128" which differs slightly from the best practices guide (0.02127)
+  Ca = (0.02128d0/40.078d0) * salt/1.80655d0
+  OmegaA = (Ca*cc) / Kspa
+  OmegaC = (Ca*cc) / Kspc
+
+  RETURN
+END SUBROUTINE varsolver
+
+! ----------------------------------------------------------------------
+!  VARS
+! ----------------------------------------------------------------------
+!
+!> \file vars.f90
+!! \BRIEF 
+!> Module with vars subroutine - compute carbonate system vars from DIC,Alk,T,S,P,nuts
+!>    Computes standard carbonate system variables (pH, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R)
+!!    as 1D arrays FROM
+!!    temperature, salinity, pressure,
+!!    total alkalinity (ALK), dissolved inorganic carbon (DIC),
+!!    silica and phosphate concentrations (all 1-D arrays)
+SUBROUTINE vars(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC, BetaD, rhoSW, p, tempis,  &
+                temp, sal, alk, dic, sil, phos, Patm, depth, lat, N,                      &
+                optCON, optT, optP, optB, optK1K2, optKf, optGAS                          )
+
+  !   Purpose:
+  !     Computes other standard carbonate system variables (pH, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R)
+  !     as 1D arrays
+  !     FROM:
+  !     temperature, salinity, pressure,
+  !     total alkalinity (ALK), dissolved inorganic carbon (DIC),
+  !     silica and phosphate concentrations (all 1-D arrays)
+
+  !     INPUT variables:
+  !     ================
+  !     Patm    = atmospheric pressure [atm]
+  !     depth   = depth [m]     (with optP='m', i.e., for a z-coordinate model vertical grid is depth, not pressure)
+  !             = pressure [db] (with optP='db')
+  !     lat     = latitude [degrees] (needed to convert depth to pressure, i.e., when optP='m')
+  !             = dummy array (unused when optP='db')
+  !     temp    = potential temperature [degrees C] (with optT='Tpot', i.e., models carry tempot, not in situ temp)
+  !             = in situ   temperature [degrees C] (with optT='Tinsitu', e.g., for data)
+  !     sal     = salinity in [psu]
+  !     alk     = total alkalinity in [eq/m^3] with optCON = 'mol/m3'
+  !             =               [eq/kg]  with optCON = 'mol/kg'
+  !     dic     = dissolved inorganic carbon [mol/m^3] with optCON = 'mol/m3'
+  !             =                            [mol/kg]  with optCON = 'mol/kg'
+  !     sil     = silica    [mol/m^3] with optCON = 'mol/m3'
+  !             =           [mol/kg]  with optCON = 'mol/kg'
+  !     phos    = phosphate [mol/m^3] with optCON = 'mol/m3'
+  !             =           [mol/kg]  with optCON = 'mol/kg'
+  !     INPUT options:
+  !     ==============
+  !     -----------
+  !     optCON: choose input & output concentration units - mol/kg (data) vs. mol/m^3 (models)
+  !     -----------
+  !       -> 'mol/kg' for DIC, ALK, sil, & phos given on mokal scale, i.e., in mol/kg  (std DATA units)
+  !       -> 'mol/m3' for DIC, ALK, sil, & phos given in mol/m^3 (std MODEL units)
+  !     -----------
+  !     optT: choose in situ vs. potential temperature as input
+  !     ---------
+  !     NOTE: Carbonate chem calculations require IN-SITU temperature (not potential Temperature)
+  !       -> 'Tpot' means input is pot. Temperature (in situ Temp "tempis" is computed)
+  !       -> 'Tinsitu' means input is already in-situ Temperature, not pot. Temp ("tempis" not computed)
+  !     ---------
+  !     optP: choose depth (m) vs pressure (db) as input
+  !     ---------
+  !       -> 'm'  means "depth" input is in "m" (thus in situ Pressure "p" [db] is computed)
+  !       -> 'db' means "depth" input is already in situ pressure [db], not m (thus p = depth)
+  !     ---------
+  !     optB: choose total boron formulation - Uppström (1974) vs. Lee et al. (2010)
+  !     ---------
+  !       -> 'u74' means use classic formulation of Uppström (1974) for total Boron
+  !       -> 'l10' means use newer   formulation of Lee et al. (2010) for total Boron
+  !     ---------
+  !     optK1K2:
+  !     ---------
+  !       -> 'l'   means use Lueker et al. (2000) formulations for K1 & K2 (recommended by Dickson et al. 2007)
+  !                **** BUT this should only be used when 2 < T < 35 and 19 < S < 43
+  !       -> 'm10' means use Millero (2010) formulation for K1 & K2 (see Dickson et al., 2007)
+  !                **** Valid for 0 < T < 50°C and 1 < S < 50 psu
+  !     ----------
+  !     optKf:
+  !     ----------
+  !       -> 'pf' means use Perez & Fraga (1987) formulation for Kf (recommended by Dickson et al., 2007)
+  !               **** BUT Valid for  9 < T < 33°C and 10 < S < 40.
+  !       -> 'dg' means use Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2
+  !     ---------
+  !       PRESSURE corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     ph   = pH on total scale
+  !     pco2 = CO2 partial pressure (uatm)
+  !     fco2 = CO2 fugacity (uatm)
+  !     co2  = aqueous CO2 concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     hco3 = bicarbonate (HCO3-) concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     co3  = carbonate (CO3--) concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     OmegaA = Omega for aragonite, i.e., the aragonite saturation state
+  !     OmegaC = Omega for calcite, i.e., the   calcite saturation state
+  !     BetaD = Revelle factor   dpCO2/pCO2 / dDIC/DIC
+  !     rhoSW  = in-situ density of seawater; rhoSW = f(s, t, p)
+  !     p = pressure [decibars]; p = f(depth, latitude) if computed from depth [m] OR p = depth if [db]
+  !     tempis  = in-situ temperature [degrees C]
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+! Input variables
+  !>     number of records
+  INTEGER, INTENT(in) :: N
+  !> either <b>in situ temperature</b> (when optT='Tinsitu', typical data) 
+  !! OR <b>potential temperature</b> (when optT='Tpot', typical models) <b>[degree C]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: temp
+  !> salinity <b>[psu]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sal
+  !> total alkalinity in <b>[eq/m^3]</b> (when optCON = 'mol/m3') OR in <b>[eq/kg]</b>  (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: alk
+  !> dissolved inorganic carbon in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: dic
+  !> SiO2 concentration in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sil
+  !> phosphate concentration in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: phos
+!f2py optional , depend(sal) :: n=len(sal)
+  !> atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> depth in \b meters (when optP='m') or \b decibars (when optP='db')
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: depth
+  !> latitude <b>[degrees north]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: lat
+
+  !> choose either \b 'mol/kg' (std DATA units) or \b 'mol/m3' (std MODEL units) to select 
+  !! concentration units for input (for alk, dic, sil, phos) & output (co2, hco3, co3)
+  CHARACTER(6), INTENT(in) :: optCON
+  !> choose \b 'Tinsitu' for in situ temperature or \b 'Tpot' for potential temperature (in situ Temp is computed, needed for models)
+  CHARACTER(7), INTENT(in) :: optT
+  !> for depth input, choose \b "db" for decibars (in situ pressure) or \b "m" for meters (pressure is computed, needed for models)
+  CHARACTER(2), INTENT(in) :: optP
+  !> for total boron, choose either \b 'u74' (Uppstrom, 1974) or \b 'l10' (Lee et al., 2010).
+  !! The 'l10' formulation is based on 139 measurements (instead of 20), 
+  !! uses a more accurate method, and
+  !! generally increases total boron in seawater by 4% 
+!f2py character*3 optional, intent(in) :: optB='l10'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optB
+  !> for Kf, choose either \b 'pf' (Perez & Fraga, 1987) or \b 'dg' (Dickson & Riley, 1979)
+!f2py character*2 optional, intent(in) :: optKf='pf'
+  CHARACTER(2), OPTIONAL, INTENT(in) :: optKf
+  !> for K1,K2 choose either \b 'l' (Lueker et al., 2000) or \b 'm10' (Millero, 2010) 
+!f2py character*3 optional, intent(in) :: optK1K2='l'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optK1K2
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Output variables:
+  !> pH on the <b>total scale</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: ph
+  !> CO2 partial pressure <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pco2
+  !> CO2 fugacity <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: fco2
+  !> aqueous CO2* concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg</b>] depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: co2
+  !> bicarbonate ion (HCO3-) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: hco3
+  !> carbonate ion (CO3--) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: co3
+  !> Omega for aragonite, i.e., the aragonite saturation state
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaA
+  !> Omega for calcite, i.e., the calcite saturation state
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaC
+  !> Revelle factor, i.e., dpCO2/pCO2 / dDIC/DIC
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: BetaD
+  !> in-situ density of seawater; rhoSW = f(s, t, p) in <b>[kg/m3]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: rhoSW
+  !> pressure <b>[decibars]</b>; p = f(depth, latitude) if computed from depth [m] (when optP='m') OR p = depth [db] (when optP='db')
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: p
+  !> in-situ temperature \b <b>[degrees C]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempis
+
+! Local variables
+  REAL(kind=wp) :: ssal, salk, sdic, ssil, sphos
+
+  REAL(kind=wp) :: tempot, tempis68, tempot68
+! REAL(kind=wp) :: dtempot, dtempot68
+  REAL(kind=wp) :: drho
+
+  REAL(kind=wp) :: K0, K1, K2, Kb, Kw, Ks, Kf, Kspc
+  REAL(kind=wp) :: Kspa, K1p, K2p, K3p, Ksi
+  REAL(kind=wp) :: St, Ft, Bt
+
+  REAL(kind=wp), DIMENSION(1) :: aK0, aK1, aK2, aKb, aKw, aKs, aKf, aKspc
+  REAL(kind=wp), DIMENSION(1) :: aKspa, aK1p, aK2p, aK3p, aKsi
+  REAL(kind=wp), DIMENSION(1) :: aSt, aFt, aBt
+
+  REAL(kind=wp) :: Patmd, Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: Phydro_atm
+
+  INTEGER :: i, icount
+
+  REAL(kind=wp) :: t, tk, prb
+  REAL(kind=wp) :: s
+  REAL(kind=wp) :: tc, ta
+  REAL(kind=wp) :: sit, pt
+  REAL(kind=wp) :: Hinit
+  REAL(kind=wp) :: ah1
+
+  REAL(kind=wp) :: HSO4, HF, HSI, HPO4
+  REAL(kind=wp) :: ab, aw, ac, ah2, erel
+
+  REAL(kind=wp) :: cu, cb, cc
+
+  REAL(kind=wp), DIMENSION(2) :: dicdel, pco2del
+  REAL(kind=wp) :: dx, Rf
+  REAL(kind=wp) :: dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC
+
+  INTEGER :: kcomp
+  INTEGER :: j, minusplus
+
+! Arrays to pass optional arguments into or use defaults (Dickson et al., 2007)
+  CHARACTER(3) :: opB
+  CHARACTER(2) :: opKf
+  CHARACTER(3) :: opK1K2
+  CHARACTER(7) :: opGAS
+
+! Set defaults for optional arguments (in Fortran 90)
+! Note:  Optional arguments with f2py (python) are set above with 
+!        the !f2py statements that precede each type declaraion
+  IF (PRESENT(optB)) THEN
+!   print *,"optB present:"
+!   print *,"optB = ", optB 
+    opB = optB
+  ELSE
+!   Default is Lee et al (2010) for total boron
+!   print *,"optB NOT present:"
+    opB = 'l10'
+!   print *,"opB = ", opB 
+  ENDIF
+  IF (PRESENT(optKf)) THEN
+!   print *,"optKf = ", optKf
+    opKf = optKf
+  ELSE
+!   print *,"optKf NOT present:"
+!   Default is Perez & Fraga (1987) for Kf
+    opKf = 'pf'
+!   print *,"opKf = ", opKf
+  ENDIF
+  IF (PRESENT(optK1K2)) THEN
+!   print *,"optK1K2 = ", optK1K2
+    opK1K2 = optK1K2
+  ELSE
+!   print *,"optK1K2 NOT present:"
+!   Default is Lueker et al. 2000) for K1 & K2
+    opK1K2 = 'l'
+!   print *,"opK1K2 = ", opK1K2
+  ENDIF
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+  icount = 0
+  DO i = 1, N
+     icount = icount + 1
+!    ===============================================================
+!    Convert model depth -> press; convert model Theta -> T in situ
+!    ===============================================================
+!    * Model temperature tracer is usually "potential temperature"
+!    * Model vertical grid is usually in meters
+!    BUT carbonate chem routines require pressure & in-situ T
+!    Thus before computing chemistry, if appropriate,
+!    convert these 2 model vars (input to this routine)
+!    - depth [m] => convert to pressure [db]
+!    - potential temperature (C) => convert to in-situ T (C)
+!    -------------------------------------------------------
+!    1)  Compute pressure [db] from depth [m] and latitude [degrees] (if input is m, for models)
+     !print *,"optP =", optP, "end"
+     IF (trim(optP) == 'm' ) THEN
+!       Compute pressure [db] from depth [m] and latitude [degrees]
+        p(i) = p80(depth(i), lat(i))
+     ELSEIF (trim(optP) == 'db') THEN
+!       In this case (where optP = 'db'), p is input & output (no depth->pressure conversion needed)
+        p(i) = depth(i)
+     ELSE
+        !print *,"optP =", optP, "end"
+        PRINT *,"optP must be either 'm' or 'db'"
+        STOP
+     ENDIF
+
+!    2) Convert potential T to in-situ T (if input is Tpot, i.e. case for models):
+     IF (trim(optT) == 'Tpot' .OR. trim(optT) == 'tpot') THEN
+        tempot = temp(i)
+!       This is the case for most models and some data
+!       a) Convert the pot. temp on today's "ITS 90" scale to older IPTS 68 scale
+!          (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+        tempot68 = (tempot - 0.0002) / 0.99975
+!       b) Compute "in-situ Temperature" from "Potential Temperature" (both on IPTS 68)
+        tempis68 = sw_temp(sal(i), tempot68, p(i), 0.0_wp )
+!       c) Convert the in-situ temp on older IPTS 68 scale to modern scale (ITS 90)
+        tempis(i) = 0.99975*tempis68 + 0.0002
+!       Note: parts (a) and (c) above are tiny corrections;
+!             part  (b) is a big correction for deep waters (but zero at surface)
+     ELSEIF (trim(optT) == 'Tinsitu' .OR. trim(optT) == 'tinsitu') THEN
+!       When optT = 'Tinsitu', tempis is input & output (no tempot needed)
+        tempis(i) = temp(i)
+        tempis68  = (temp(i) - 0.0002) / 0.99975
+!       dtempot68 = sw_ptmp(DBLE(sal(i)), DBLE(tempis68), DBLE(p), 0.0d0)
+!       dtempot   = 0.99975*dtempot68 + 0.0002
+     ELSE
+        PRINT *,"optT must be either 'Tpot' or 'Tinsitu'"
+        PRINT *,"you specified optT =", trim(optT) 
+        STOP
+     ENDIF
+
+!    ================================================================
+!    Carbonate chemistry computations
+!    ================================================================
+     IF (dic(i) > 0. .AND. dic(i) < 1.0e+4) THEN
+!       Test to indicate if any of input variables are unreasonable
+        IF (       sal(i) < 0.   &
+             .OR.  alk(i) < 0.   &
+             .OR.  dic(i) < 0.   &
+             .OR.  sil(i) < 0.   &
+             .OR. phos(i) < 0.   &
+             .OR.  sal(i) > 1e+3 &
+             .OR.  alk(i) > 1e+3 &
+             .OR.  dic(i) > 1e+3 &
+             .OR.  sil(i) > 1e+3 &
+             .OR. phos(i) > 1e+3) THEN
+           PRINT *, 'i, icount, tempot, sal,    alk,    dic,    sil,    phos =', &
+                     i, icount, tempot, sal(i), alk(i), dic(i), sil(i), phos(i)
+        ENDIF
+!       Zero out any negative salinity, phosphate, silica, dic, and alk
+        IF (sal(i) < 0.0) THEN
+           ssal = 0.0
+        ELSE
+           ssal = sal(i)
+        ENDIF
+        IF (phos(i) < 0.0) THEN
+           sphos = 0.0
+        ELSE
+           sphos = phos(i)
+        ENDIF
+        IF (sil(i) < 0.0) THEN
+           ssil = 0.0
+        ELSE
+           ssil = sil(i)
+        ENDIF
+        IF (dic(i) < 0.0) THEN
+          sdic = 0.0
+        ELSE
+          sdic = dic(i)
+        ENDIF
+        IF (alk(i) < 0.0) THEN
+          salk = 0.0
+        ELSE
+          salk = alk(i)
+        ENDIF
+
+!       Absolute temperature (Kelvin) & related variables
+        t  = DBLE(tempis(i))
+        tk = 273.15d0 + t
+
+!       Atmospheric pressure
+        Patmd = DBLE(Patm(i))
+!       Hydrostatic pressure (prb is in bars)
+        prb = DBLE(p(i)) / 10.0d0
+        Phydro_atm = prb / 1.01325d0  ! convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+!       Total pressure [atm]
+        IF     (trim(opGAS) == 'Pzero'     .OR. trim(opGAS) == 'pzero') THEN
+           Ptot = Patmd               ! total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Ppot'    .OR. trim(opGAS) == 'ppot') THEN
+           Ptot = Patmd               ! total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+           Ptot = Patmd + Phydro_atm   ! total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+        ELSE
+           PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+           STOP
+        ENDIF
+
+!       Salinity (equivalent array in double precision)
+        s = DBLE(ssal)
+
+!       Get all equilibrium constants and total concentrations of SO4, F, B
+        CALL constants(aK0, aK1, aK2, aKb, aKw, aKs, aKf, aKspc, aKspa,  &
+                       aK1p, aK2p, aK3p, aKsi,                           &
+                       aSt, aFt, aBt,                                    &
+                       temp(i), sal(i), Patm(i),                         &
+                       depth(i), lat(i), 1,                              &
+                       optT, optP, opB, opK1K2, opKf, opGAS              )
+
+!       Unlike f77, in F90 we can't assign an array (dimen=1) to a scalar in a routine argument
+!       Thus, set scalar constants equal to array (dimension=1) values required as arguments
+        K0 = aK0(1) ; K1 = aK1(1) ; K2 = aK2(1) ; Kb = aKb(1) ; Kw = aKw(1) 
+        Ks = aKs(1) ; Kf = aKs(1) ; Kspc = aKspc(1) ; Kspa = aKspa(1) 
+        K1p = aK1p(1) ; K2p = aK2p(1) ; K3p = aK3p(1) ; Ksi = aKsi(1)
+        St = aSt(1) ; Ft = aFt(1) ; Bt = aBt(1)
+
+!       Compute in-situ density [kg/m^3]
+        rhoSW(i) =  rho(ssal, tempis68, prb)
+
+!       Either convert units of DIC and ALK (MODEL case) or not (DATA case)
+        IF     (trim(optCON) == 'mol/kg') THEN
+!          No conversion:
+!          print *,'DIC and ALK already given in mol/kg (std DATA units)'
+           drho = 1.
+        ELSEIF (trim(optCON) == 'mol/m3') THEN
+!          Do conversion:
+!          print *,"DIC and ALK given in mol/m^3 (std MODEL units)"
+           drho = DBLE(rhoSW(i))
+        ELSE
+           PRINT *,"optCON must be either 'mol/kg' or 'mol/m3'"
+           STOP
+        ENDIF
+
+        tc  = DBLE(sdic)/drho
+        ta  = DBLE(salk)/drho
+        sit = DBLE(ssil)/drho
+        pt  = DBLE(sphos)/drho
+
+!       Solve for pH and all other variables
+!       ------------------------------------
+        CALL varsolver(dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC,     &
+                      t, s, ta, tc, pt, sit,                                       &
+                      Bt, St, Ft,                                                  &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,  & 
+                      Patmd, prb, drho, opGAS                                     )
+
+!       Convert all output variables from double to single precision
+        pH(i)     = REAL(dph)
+        co2(i)    = REAL(dco2)
+        hco3(i)   = REAL(dhco3)
+        co3(i)    = REAL(dco3)
+        fCO2(i)   = REAL(dfCO2)
+        pCO2(i)   = REAL(dpCO2)
+        OmegaA(i) = REAL(dOmegaA)
+        OmegaC(i) = REAL(dOmegaC)
+
+!       Compute Revelle factor numerically (derivative using centered-difference scheme)
+        DO j=1,2
+           minusplus = (-1)**j
+           dx = 0.1 * 1e-6         ! Numerical tests found for DIC that optimal dx = 0.1 umol/kg (0.1e-6 mol/kg)
+           dicdel(j) = tc + DBLE(minusplus)*dx/2.0d0
+            CALL varsolver(dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC, &
+               t, s, ta, dicdel(j), pt, sit,                                       &
+               Bt, St, Ft,                                                         &
+               K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,         & 
+               Patmd, prb, drho, optGAS                                            )
+            pco2del(j) = dpco2
+        END DO
+       !Classic finite centered difference formula for derivative (2nd order accurate)
+        Rf = (pco2del(2) - pco2del(1)) / (dicdel(2) - dicdel(1))       ! dpCO2/dDIC
+       !Rf = (pco2del(2) - pco2del(1)) / (dx)                          ! dpCO2/dDIC (same as just above)
+        Rf = Rf * tc / dpco2                                           ! R = (dpCO2/dDIC) * (DIC/pCO2)
+
+        BetaD(i) = REAL(Rf)
+
+     ELSE
+
+        ph(i)     = 1.e20_wp
+        pco2(i)   = 1.e20_wp
+        fco2(i)   = 1.e20_wp
+        co2(i)    = 1.e20_wp
+        hco3(i)   = 1.e20_wp
+        co3(i)    = 1.e20_wp
+        OmegaA(i) = 1.e20_wp
+        OmegaC(i) = 1.e20_wp
+        BetaD(i)  = 1.e20_wp
+        rhoSW(i)  = 1.e20_wp
+        p(i)      = 1.e20_wp
+        tempis(i) = 1.e20_wp
+
+     ENDIF
+
+  END DO
+
+  RETURN
+END SUBROUTINE vars
+
+! ----------------------------------------------------------------------
+!  P2FCO2
+! ----------------------------------------------------------------------
+!
+!> \file p2fCO2.f90
+!! \BRIEF 
+!>    Module with p2fCO2 subroutine - compute fCO2 from pCO2, in situ T, atm pressure, hydrostatic pressure
+!>    Compute fCO2 from arrays of pCO2, in situ temp, atm pressure, & hydrostatic pressure
+SUBROUTINE p2fCO2(pCO2, temp, Patm, p, N, fCO2)
+  !    Purpose:
+  !    Compute fCO2 from arrays of pCO2, in situ temp, atm pressure, & hydrostatic pressure
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, INTENT(in) :: N
+
+! INPUT variables
+  !> oceanic partial pressure of CO2 [uatm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> hydrostatic pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: p
+!f2py optional , depend(pCO2) :: n=len(pCO2)
+
+! OUTPUT variables:
+  !> fugacity of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: fCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dpCO2, dtemp, tk, dPatm, prb
+  REAL(kind=wp) :: Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: dfCO2
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dpCO2     = DBLE(pCO2(i))
+     dtemp     = DBLE(temp(i))
+     dPatm     = DBLE(Patm(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     prb = DBLE(p(i)) / 10.0d0         !Pressure effect (prb is in bars)
+     Ptot = dPatm + prb/1.01325d0      !Total pressure (atmospheric + hydrostatic) [atm]
+     Rgas_atm = 82.05736_wp            !R in (cm3 * atm) / (mol * K)  from CODATA (2006)
+!    To compute fugcoeff, we need 3 other terms (B, Del, xc2) as well as 3 others above (tk, Ptot, Rgas_atm)
+     B = -1636.75d0 + 12.0408d0*tk - 0.0327957d0*(tk*tk) + 0.0000316528d0*(tk*tk*tk)
+     Del = 57.7d0 - 0.118d0*tk
+!    "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+!    x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+!    Let's assume that xCO2 = pCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+     xCO2approx = dpCO2 * 1.e-6_wp
+     xc2 = (1.0d0 - xCO2approx)**2 
+     fugcoeff = EXP( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk) )
+     dfCO2 = dpCO2 * fugcoeff
+     fCO2(i) = REAL(dfCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE p2fCO2
+
+! ----------------------------------------------------------------------
+!  P2FCO2
+! ----------------------------------------------------------------------
+!
+!> \file f2pCO2.f90
+!! \BRIEF 
+!>    Module with f2pCO2 subroutine - compute pCO2 from fCO2, in situ T, atm pressure, hydrostatic pressure
+!>    Compute pCO2 from arrays of fCO2, in situ temp, atm pressure, & hydrostatic pressure
+SUBROUTINE f2pCO2(fCO2, temp, Patm, p, N, pCO2)
+  !    Purpose:
+  !    Compute pCO2 from arrays of fCO2, in situ temp, atm pressure, & hydrostatic pressure
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> oceanic fugacity of CO2 [uatm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: fCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> hydrostatic pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: p
+!f2py optional , depend(pCO2) :: n=len(pCO2)
+
+! OUTPUT variables:
+  !> oceanic partial pressure of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dfCO2, dtemp, tk, dPatm, prb
+  REAL(kind=wp) :: Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: dpCO2
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dfCO2     = DBLE(fCO2(i))
+     dtemp     = DBLE(temp(i))
+     dPatm     = DBLE(Patm(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     prb = DBLE(p(i)) / 10.0d0         !Pressure effect (prb is in bars)
+     Ptot = dPatm + prb/1.01325d0      !Total pressure (atmospheric + hydrostatic) [atm]
+     Rgas_atm = 82.05736_wp            !R in (cm3 * atm) / (mol * K)  from CODATA (2006)
+!    To compute fugcoeff, we need 3 other terms (B, Del, xc2) as well as 3 others above (tk, Ptot, Rgas_atm)
+     B = -1636.75d0 + 12.0408d0*tk - 0.0327957d0*(tk*tk) + 0.0000316528d0*(tk*tk*tk)
+     Del = 57.7d0 - 0.118d0*tk
+!    "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+!    x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+!    Let's assume that xCO2 = fCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+     xCO2approx = dfCO2 * 1.e-6_wp
+     xc2 = (1.0d0 - xCO2approx)**2 
+     fugcoeff = exp( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk) )
+     dpCO2 = dfCO2 / fugcoeff
+     pCO2(i) = REAL(dpCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE f2pCO2
+
+END MODULE mocsy_mainmod
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90	(revision 5841)
@@ -0,0 +1,860 @@
+!> \file mocsy_phsolvers.f90
+!! \BRIEF 
+!> Module with routines needed to solve pH-total alkalinity equation (Munhoven, 2013, GMD)
+MODULE mocsy_phsolvers
+!   Module of fastest solvers from Munhoven (2013, Geosci. Model Dev., 6, 1367-1388)
+!   ! Taken from SolveSAPHE (mod_phsolvers.F90) & adapted very slightly for use with mocsy
+!   ! SolveSaphe is distributed under the GNU Lesser General Public License
+!   ! mocsy is distributed under the MIT License
+!
+! Modifications J. C. Orr, LSCE/IPSL, CEA-CNRS-UVSQ, France, 11 Sep 2014:
+! 1) kept only the 3 fastest solvers (atgen, atsec, atfast) and routines which they call
+! 2) reduced vertical white space: deleted many blank lines & comment lines that served as divisions
+! 3) converted name from .F90 to .f90, deleting a few optional preprocesse if statements
+! 4) read in mocsy computed equilibrium constants (as arguments) instead of USE MOD_CHEMCONST
+! 5) converted routine names from upper case to lower case
+! 6) commented out arguments and equations for NH4 and H2S acid systems
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! General parameters
+REAL(KIND=wp), PARAMETER :: pp_rdel_ah_target = 1.E-8_wp
+REAL(KIND=wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp
+
+! Maximum number of iterations for each method
+INTEGER, PARAMETER :: jp_maxniter_atgen    = 50
+INTEGER, PARAMETER :: jp_maxniter_atsec    = 50
+INTEGER, PARAMETER :: jp_maxniter_atfast   = 50
+
+! Bookkeeping variables for each method
+! - SOLVE_AT_GENERAL
+INTEGER :: niter_atgen    = jp_maxniter_atgen
+
+! - SOLVE_AT_GENERAL_SEC
+INTEGER :: niter_atsec    = jp_maxniter_atsec
+
+! - SOLVE_AT_FAST (variant of SOLVE_AT_GENERAL w/o bracketing
+INTEGER :: niter_atfast   = jp_maxniter_atfast
+
+! Keep the following functions private to avoid conflicts with
+! other modules that provide similar ones.
+!PRIVATE AHINI_FOR_AT
+
+CONTAINS
+!===============================================================================
+SUBROUTINE anw_infsup(p_dictot, p_bortot,                                     &
+                      p_po4tot, p_siltot,                                     &
+                      p_so4tot, p_flutot,                                     &
+                      p_alknw_inf, p_alknw_sup)
+
+! Subroutine returns the lower and upper bounds of "non-water-selfionization"
+! contributions to total alkalinity (the infimum and the supremum), i.e
+! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! Argument variables
+REAL(KIND=wp), INTENT(IN)  :: p_dictot
+REAL(KIND=wp), INTENT(IN)  :: p_bortot
+REAL(KIND=wp), INTENT(IN)  :: p_po4tot
+REAL(KIND=wp), INTENT(IN)  :: p_siltot
+!REAL(KIND=wp), INTENT(IN)  :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)  :: p_h2stot
+REAL(KIND=wp), INTENT(IN)  :: p_so4tot
+REAL(KIND=wp), INTENT(IN)  :: p_flutot
+REAL(KIND=wp), INTENT(OUT) :: p_alknw_inf
+REAL(KIND=wp), INTENT(OUT) :: p_alknw_sup
+
+p_alknw_inf =  -p_po4tot - p_so4tot - p_flutot
+p_alknw_sup =   p_dictot + p_dictot + p_bortot &
+              + p_po4tot + p_po4tot + p_siltot !&
+!             + p_nh4tot + p_h2stot
+
+RETURN
+END SUBROUTINE anw_infsup
+
+!===============================================================================
+
+FUNCTION equation_at(p_alktot, p_h,       p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                      &
+                     p_so4tot, p_flutot,                                      &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                     p_deriveqn)
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: equation_at
+
+! Argument variables
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_h
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_deriveqn
+
+! Local variables 
+!-----------------
+REAL(KIND=wp) :: znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic
+REAL(KIND=wp) :: znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor
+REAL(KIND=wp) :: znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4
+REAL(KIND=wp) :: znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil
+REAL(KIND=wp) :: znumer_nh4, zdnumer_nh4, zdenom_nh4, zalk_nh4, zdalk_nh4
+REAL(KIND=wp) :: znumer_h2s, zdnumer_h2s, zdenom_h2s, zalk_h2s, zdalk_h2s
+REAL(KIND=wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4
+REAL(KIND=wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu
+REAL(KIND=wp) ::                                      zalk_wat, zdalk_wat
+REAL(KIND=wp) :: aphscale
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+! H2CO3 - HCO3 - CO3 : n=2, m=0
+znumer_dic = 2._wp*K1*K2 + p_h*       K1
+zdenom_dic =       K1*K2 + p_h*(      K1 + p_h)
+zalk_dic   = p_dictot * (znumer_dic/zdenom_dic)
+
+! B(OH)3 - B(OH)4 : n=1, m=0
+znumer_bor =       Kb
+zdenom_bor =       Kb + p_h
+zalk_bor   = p_bortot * (znumer_bor/zdenom_bor)
+
+! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
+znumer_po4 = 3._wp*K1p*K2p*K3p + p_h*(2._wp*K1p*K2p + p_h* K1p)
+zdenom_po4 =       K1p*K2p*K3p + p_h*(      K1p*K2p + p_h*(K1p + p_h))
+zalk_po4   = p_po4tot * (znumer_po4/zdenom_po4 - 1._wp) ! Zero level of H3PO4 = 1
+
+! H4SiO4 - H3SiO4 : n=1, m=0
+znumer_sil =       Ksi
+zdenom_sil =       Ksi + p_h
+zalk_sil   = p_siltot * (znumer_sil/zdenom_sil)
+
+! NH4 - NH3 : n=1, m=0
+!znumer_nh4 =       api1_nh4
+!zdenom_nh4 =       api1_nh4 + p_h
+!zalk_nh4   = p_nh4tot * (znumer_nh4/zdenom_nh4)
+! Note: api1_nh4 = Knh4
+
+! H2S - HS : n=1, m=0
+!znumer_h2s =       api1_h2s
+!zdenom_h2s =       api1_h2s + p_h
+!zalk_h2s   = p_h2stot * (znumer_h2s/zdenom_h2s)
+! Note: api1_h2s = Kh2s
+
+! HSO4 - SO4 : n=1, m=1
+znumer_so4 =       Ks
+zdenom_so4 =       Ks + p_h
+zalk_so4   = p_so4tot * (znumer_so4/zdenom_so4 - 1._wp)
+
+! HF - F : n=1, m=1
+znumer_flu =       Kf
+zdenom_flu =       Kf + p_h
+zalk_flu   = p_flutot * (znumer_flu/zdenom_flu - 1._wp)
+
+! H2O - OH
+zalk_wat   = Kw/p_h - p_h/aphscale
+
+equation_at =    zalk_dic + zalk_bor + zalk_po4 + zalk_sil &
+               + zalk_so4 + zalk_flu                       &
+               + zalk_wat - p_alktot
+
+IF(PRESENT(p_deriveqn)) THEN
+   ! H2CO3 - HCO3 - CO3 : n=2
+   zdnumer_dic = K1*K1*K2 + p_h*(4._wp*K1*K2               &
+                          + p_h*       K1    )
+   zdalk_dic   = -p_dictot*(zdnumer_dic/zdenom_dic**2)
+
+   ! B(OH)3 - B(OH)4 : n=1
+   zdnumer_bor = Kb
+   zdalk_bor   = -p_bortot*(zdnumer_bor/zdenom_bor**2)
+
+   ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3
+   zdnumer_po4 = K1p*K2p*K1p*K2p*K3p + p_h*(4._wp*K1p*K1p*K2p*K3p                &
+                                     + p_h*(9._wp*K1p*K2p*K3p + K1p*K1p*K2p      &
+                                     + p_h*(4._wp*K1p*K2p                        &
+                                     + p_h*       K1p)))
+   zdalk_po4   = -p_po4tot * (zdnumer_po4/zdenom_po4**2)
+
+   ! H4SiO4 - H3SiO4 : n=1
+   zdnumer_sil = Ksi
+   zdalk_sil   = -p_siltot * (zdnumer_sil/zdenom_sil**2)
+
+!  ! NH4 - NH3 : n=1
+!  zdnumer_nh4 = Knh4
+!  zdalk_nh4   = -p_nh4tot * (zdnumer_nh4/zdenom_nh4**2)
+
+!  ! H2S - HS : n=1
+!  zdnumer_h2s = api1_h2s
+!  zdalk_h2s   = -p_h2stot * (zdnumer_h2s/zdenom_h2s**2)
+
+   ! HSO4 - SO4 : n=1
+   zdnumer_so4 = Ks
+   zdalk_so4   = -p_so4tot * (zdnumer_so4/zdenom_so4**2)
+
+   ! HF - F : n=1
+   zdnumer_flu = Kf
+   zdalk_flu   = -p_flutot * (zdnumer_flu/zdenom_flu**2)
+
+!  p_deriveqn =   zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+!               + zdalk_nh4 + zdalk_h2s + zdalk_so4 + zdalk_flu &
+!               - Kw/p_h**2 - 1._wp/aphscale
+   p_deriveqn =   zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+                                        + zdalk_so4 + zdalk_flu &
+                - Kw/p_h**2 - 1._wp/aphscale
+ENDIF
+RETURN
+END FUNCTION equation_at
+
+!===============================================================================
+
+SUBROUTINE ahini_for_at(p_alkcb, p_dictot, p_bortot, K1, K2, Kb, p_hini)
+
+! Subroutine returns the root for the 2nd order approximation of the
+! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic polynomial)
+! around the local minimum, if it exists.
+
+! Returns * 1E-03_wp if p_alkcb <= 0
+!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot
+!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot
+!                    and the 2nd order approximation does not have a solution
+
+!USE MOD_CHEMCONST, ONLY : api1_dic, api2_dic, api1_bor
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! Argument variables 
+!--------------------
+REAL(KIND=wp), INTENT(IN)   ::  p_alkcb, p_dictot, p_bortot
+REAL(KIND=wp), INTENT(IN)   ::  K1, K2, Kb
+REAL(KIND=wp), INTENT(OUT)  ::  p_hini
+
+! Local variables 
+!-----------------
+REAL(KIND=wp)  ::  zca, zba
+REAL(KIND=wp)  ::  zd, zsqrtd, zhmin
+REAL(KIND=wp)  ::  za2, za1, za0
+
+IF (p_alkcb <= 0._wp) THEN
+  p_hini = 1.e-3_wp
+ELSEIF (p_alkcb >= (2._wp*p_dictot + p_bortot)) THEN
+  p_hini = 1.e-10_wp
+ELSE
+  zca = p_dictot/p_alkcb
+  zba = p_bortot/p_alkcb
+
+  ! Coefficients of the cubic polynomial
+  za2 = Kb*(1._wp - zba) + K1*(1._wp-zca)
+  za1 = K1*Kb*(1._wp - zba - zca) + K1*K2*(1._wp - (zca+zca))
+  za0 = K1*K2*Kb*(1._wp - zba - (zca+zca))
+                                        ! Taylor expansion around the minimum
+  zd = za2*za2 - 3._wp*za1              ! Discriminant of the quadratic equation
+                                        ! for the minimum close to the root
+
+  IF(zd > 0._wp) THEN                   ! If the discriminant is positive
+    zsqrtd = SQRT(zd)
+    IF(za2 < 0) THEN
+      zhmin = (-za2 + zsqrtd)/3._wp
+    ELSE
+      zhmin = -za1/(za2 + zsqrtd)
+    ENDIF
+    p_hini = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
+  ELSE
+    p_hini = 1.e-7_wp
+  ENDIF
+
+ENDIF
+RETURN
+END SUBROUTINE ahini_for_at
+
+!===============================================================================
+
+FUNCTION solve_at_general(p_alktot, p_dictot, p_bortot,                       &
+                          p_po4tot, p_siltot,                                 &
+                          p_so4tot, p_flutot,                                 &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,     &
+                          p_hini,   p_val)
+
+! Universal pH solver that converges from any given initial value,
+! determines upper an lower bounds for the solution if required
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_GENERAL
+
+! Argument variables 
+!--------------------
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables 
+!-----------------
+REAL(KIND=wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+REAL(KIND=wp)  ::  zalknw_inf, zalknw_sup
+REAL(KIND=wp)  ::  zh_min, zh_max
+REAL(KIND=wp)  ::  zdelta, zh_delta
+REAL(KIND=wp)  ::  zeqn, zdeqndh, zeqn_absmin
+REAL(KIND=wp)  ::  aphscale
+LOGICAL        :: l_exitnow
+REAL(KIND=wp), PARAMETER :: pz_exp_threshold = 1.0_wp
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL ahini_for_at(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+
+ CALL anw_infsup(p_dictot, p_bortot,                                           &
+                 p_po4tot, p_siltot,                                           &
+                 p_so4tot, p_flutot,                                           &
+                 zalknw_inf, zalknw_sup)
+
+zdelta = (p_alktot-zalknw_inf)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot >= zalknw_inf) THEN
+   zh_min = 2._wp*Kw /( p_alktot-zalknw_inf + SQRT(zdelta) )
+ELSE
+   zh_min = aphscale*(-(p_alktot-zalknw_inf) + SQRT(zdelta) ) / 2._wp
+ENDIF
+
+zdelta = (p_alktot-zalknw_sup)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot <= zalknw_sup) THEN
+   zh_max = aphscale*(-(p_alktot-zalknw_sup) + SQRT(zdelta) ) / 2._wp
+ELSE
+   zh_max = 2._wp*Kw /( p_alktot-zalknw_sup + SQRT(zdelta) )
+ENDIF
+
+zh = MAX(MIN(zh_max, zh_ini), zh_min)
+niter_atgen        = 0                 ! Reset counters of iterations
+zeqn_absmin        = HUGE(1._wp)
+
+DO
+   IF(niter_atgen >= jp_maxniter_atgen) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zh_prev = zh
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                      P_DERIVEQN = zdeqndh)
+
+   ! Adapt bracketing interval
+   IF(zeqn > 0._wp) THEN
+      zh_min = zh_prev
+   ELSEIF(zeqn < 0._wp) THEN
+      zh_max = zh_prev
+   ELSE
+      ! zh is the root; unlikely but, one never knows
+      EXIT
+   ENDIF
+
+   ! Now determine the next iterate zh
+   niter_atgen = niter_atgen + 1
+
+   IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin) THEN
+      ! if the function evaluation at the current point is
+      ! not decreasing faster than with a bisection step (at least linearly)
+      ! in absolute value take one bisection step on [ph_min, ph_max]
+      ! ph_new = (ph_min + ph_max)/2d0
+      !
+      ! In terms of [H]_new:
+      ! [H]_new = 10**(-ph_new)
+      !         = 10**(-(ph_min + ph_max)/2d0)
+      !         = SQRT(10**(-(ph_min + phmax)))
+      !         = SQRT(zh_max * zh_min)
+      zh = SQRT(zh_max * zh_min)
+      zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
+   ELSE
+      ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
+      !           = -zdeqndh * LOG(10) * [H]
+      ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
+      !
+      ! pH_new = pH_old + \deltapH
+      !
+      ! [H]_new = 10**(-pH_new)
+      !         = 10**(-pH_old - \Delta pH)
+      !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
+      !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
+      !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
+
+      zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+
+      IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+         zh          = zh_prev*EXP(zh_lnfactor)
+      ELSE
+         zh_delta    = zh_lnfactor*zh_prev
+         zh          = zh_prev + zh_delta
+      ENDIF
+
+      IF( zh < zh_min ) THEN
+         ! if [H]_new < [H]_min
+         ! i.e., if ph_new > ph_max then
+         ! take one bisection step on [ph_prev, ph_max]
+         ! ph_new = (ph_prev + ph_max)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_max)/2d0)
+         !         = SQRT(10**(-(ph_prev + phmax)))
+         !         = SQRT([H]_old*10**(-ph_max))
+         !         = SQRT([H]_old * zh_min)
+         zh                = SQRT(zh_prev * zh_min)
+         zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+      ENDIF
+
+      IF( zh > zh_max ) THEN
+         ! if [H]_new > [H]_max
+         ! i.e., if ph_new < ph_min, then
+         ! take one bisection step on [ph_min, ph_prev]
+         ! ph_new = (ph_prev + ph_min)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_min)/2d0)
+         !         = SQRT(10**(-(ph_prev + ph_min)))
+         !         = SQRT([H]_old*10**(-ph_min))
+         !         = SQRT([H]_old * zhmax)
+         zh                = SQRT(zh_prev * zh_max)
+         zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+      ENDIF
+   ENDIF
+
+   zeqn_absmin = MIN( ABS(zeqn), zeqn_absmin)
+
+   ! Stop iterations once |\delta{[H]}/[H]| < rdel
+   ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+   ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+   ! Alternatively:
+   ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+   !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+   !             < 1/LOG(10) * rdel
+
+   ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+   ! rdel <-- pp_rdel_ah_target
+
+   l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+solve_at_general = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)    
+   ELSE
+      p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+RETURN
+END FUNCTION solve_at_general
+
+!===============================================================================
+
+FUNCTION solve_at_general_sec(p_alktot, p_dictot, p_bortot,                   &
+                              p_po4tot, p_siltot,                             &
+                              p_so4tot, p_flutot,                             &
+                              K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi, &
+                              p_hini,   p_val) 
+
+! Universal pH solver that converges from any given initial value,
+! determines upper an lower bounds for the solution if required
+
+!USE MOD_CHEMCONST, ONLY: api1_wat, aphscale
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_GENERAL_SEC
+
+! Argument variables 
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables
+REAL(KIND=wp)  ::  zh_ini, zh, zh_1, zh_2, zh_delta
+REAL(KIND=wp)  ::  zalknw_inf, zalknw_sup
+REAL(KIND=wp)  ::  zh_min, zh_max
+REAL(KIND=wp)  ::  zeqn, zeqn_1, zeqn_2, zeqn_absmin
+REAL(KIND=wp)  ::  zdelta
+REAL(KIND=wp)  ::  aphscale
+LOGICAL        ::  l_exitnow
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL ahini_for_at(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+
+ CALL anw_infsup(p_dictot, p_bortot,                                      &
+                 p_po4tot, p_siltot,                                      &
+                 p_so4tot, p_flutot,                                      &
+                 zalknw_inf, zalknw_sup)
+
+zdelta = (p_alktot-zalknw_inf)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot >= zalknw_inf) THEN
+   zh_min = 2._wp*Kw /( p_alktot-zalknw_inf + SQRT(zdelta) )
+ELSE
+   zh_min = aphscale*(-(p_alktot-zalknw_inf) + SQRT(zdelta) ) / 2._wp
+ENDIF
+
+zdelta = (p_alktot-zalknw_sup)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot <= zalknw_sup) THEN
+   zh_max = aphscale*(-(p_alktot-zalknw_sup) + SQRT(zdelta) ) / 2._wp
+ELSE
+   zh_max = 2._wp*Kw /( p_alktot-zalknw_sup + SQRT(zdelta) )
+ENDIF
+
+zh = MAX(MIN(zh_max, zh_ini), zh_min)
+niter_atsec        = 0                 ! Reset counters of iterations
+
+! Prepare the secant iterations: two initial (zh, zeqn) pairs are required
+! We have the starting value, that needs to be completed by the evaluation
+! of the equation value it produces.
+
+! Complete the initial value with its equation evaluation
+! (will take the role of the $n-2$ iterate at the first secant evaluation)
+
+niter_atsec = 0                        ! zh_2 is the initial value;
+
+zh_2   = zh
+zeqn_2 = equation_at(p_alktot, zh_2,     p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                     &
+                     p_so4tot, p_flutot,                                     &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+zeqn_absmin        = ABS(zeqn_2)
+
+! Adapt bracketing interval and heuristically set zh_1
+IF(zeqn_2 < 0._wp) THEN
+                                       ! If zeqn_2 < 0, then we adjust zh_max:
+                                       ! we can be sure that zh_min < zh_2 < zh_max.
+   zh_max = zh_2
+                                       ! for zh_1, try 25% (0.1 pH units) below the current zh_max,
+                                       ! but stay above SQRT(zh_min*zh_max), which would be equivalent
+                                       ! to a bisection step on [pH@zh_min, pH@zh_max]
+   zh_1   = MAX(zh_max/1.25_wp, SQRT(zh_min*zh_max))
+ELSEIF(zeqn_2 > 0._wp) THEN
+                                       ! If zeqn_2 < 0, then we adjust zh_min:
+                                       ! we can be sure that zh_min < zh_2 < zh_max.
+   zh_min = zh_2
+                                       ! for zh_1, try 25% (0.1 pH units) above the current zh_min,
+                                       ! but stay below SQRT(zh_min*zh_max) which would be equivalent
+                                       ! to a bisection step on [pH@zh_min, pH@zh_max]
+   zh_1   = MIN(zh_min*1.25_wp, SQRT(zh_min*zh_max))
+ELSE ! we have got the root; unlikely, but one never knows
+   solve_at_general_sec = zh_2
+   IF(PRESENT(p_val)) p_val = zeqn_2
+   RETURN
+ENDIF
+
+! We now have the first pair completed (zh_2, zeqn_2).
+! Define the second one (zh_1, zeqn_1), which is also the first iterate.
+! zh_1 has already been set above
+niter_atsec = 1                        ! Update counter of iterations
+
+zeqn_1 = equation_at(p_alktot, zh_1,       p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                       &
+                     p_so4tot, p_flutot,                                       &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+! Adapt bracketing interval: we know that zh_1 <= zh <= zh_max (if zeqn_1 > 0)
+! or zh_min <= zh <= zh_1 (if zeqn_1 < 0), so this can always be done
+IF(zeqn_1 > 0._wp) THEN
+   zh_min = zh_1
+ELSEIF(zeqn_1 < 0._wp) THEN
+   zh_max = zh_1
+ELSE ! zh_1 is the root
+   solve_at_general_sec = zh_1
+   IF(PRESENT(p_val)) p_val = zeqn_1
+ENDIF
+
+IF(ABS(zeqn_1) > zeqn_absmin) THEN     ! Swap zh_2 and zh_1 if ABS(zeqn_2) < ABS(zeqn_1)
+                                       ! so that zh_2 and zh_1 lead to decreasing equation
+                                       ! values (in absolute value)
+   zh     = zh_1
+   zeqn   = zeqn_1
+   zh_1   = zh_2
+   zeqn_1 = zeqn_2
+   zh_2   = zh
+   zeqn_2 = zeqn
+ELSE
+   zeqn_absmin = ABS(zeqn_1)
+ENDIF
+
+! Pre-calculate the first secant iterate (this is the second iterate)
+niter_atsec = 2
+
+zh_delta = -zeqn_1/((zeqn_2-zeqn_1)/(zh_2 - zh_1))
+zh = zh_1 + zh_delta
+
+! Make sure that zh_min < zh < zh_max (if not,
+! bisect around zh_1 which is the best estimate)
+IF (zh > zh_max) THEN                  ! this can only happen if zh_2 < zh_1
+                                       ! and zeqn_2 > zeqn_1 > 0
+   zh = SQRT(zh_1*zh_max)
+ENDIF
+
+IF (zh < zh_min) THEN                  ! this can only happen if zh_2 > zh_1
+                                       ! and zeqn_2 < zeqn_1 < 0
+   zh = SQRT(zh_1*zh_min)
+ENDIF
+
+DO
+   IF(niter_atsec >= jp_maxniter_atsec) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+   ! Adapt bracketing interval: since initially, zh_min <= zh <= zh_max
+   ! we are sure that zh will improve either bracket, depending on the sign
+   ! of zeqn
+   IF(zeqn > 0._wp) THEN
+     zh_min = zh
+   ELSEIF(zeqn < 0._wp) THEN
+     zh_max = zh
+   ELSE
+     ! zh is the root
+     EXIT
+   ENDIF
+
+   ! start calculation of next iterate
+   niter_atsec = niter_atsec + 1
+
+   zh_2   = zh_1
+   zeqn_2 = zeqn_1
+   zh_1   = zh
+   zeqn_1 = zeqn
+
+   IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin) THEN
+      ! if the function evaluation at the current point
+      ! is not decreasing faster in absolute value than
+      ! we may expect for a bisection step, then take
+      ! one bisection step on [ph_min, ph_max]
+      ! ph_new = (ph_min + ph_max)/2d0
+      ! In terms of [H]_new:
+      ! [H]_new = 10**(-ph_new)
+      !         = 10**(-(ph_min + ph_max)/2d0)
+      !         = SQRT(10**(-(ph_min + phmax)))
+      !         = SQRT(zh_max * zh_min)
+      zh                = SQRT(zh_max * zh_min)
+      zh_delta           = zh - zh_1
+   ELSE
+      ! \Delta H = -zeqn_1*(h_2 - h_1)/(zeqn_2 - zeqn_1) 
+      ! H_new = H_1 + \Delta H
+      zh_delta = -zeqn_1/((zeqn_2-zeqn_1)/(zh_2 - zh_1))
+      zh       = zh_1 + zh_delta
+
+      IF( zh < zh_min ) THEN
+         ! if [H]_new < [H]_min
+         ! i.e., if ph_new > ph_max then
+         ! take one bisection step on [ph_prev, ph_max]
+         ! ph_new = (ph_prev + ph_max)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_max)/2d0)
+         !         = SQRT(10**(-(ph_prev + phmax)))
+         !         = SQRT([H]_old*10**(-ph_max))
+         !         = SQRT([H]_old * zh_min)
+         zh                = SQRT(zh_1 * zh_min)
+         zh_delta          = zh - zh_1
+      ENDIF
+
+      IF( zh > zh_max ) THEN
+         ! if [H]_new > [H]_max
+         ! i.e., if ph_new < ph_min, then
+         ! take one bisection step on [ph_min, ph_prev]
+         ! ph_new = (ph_prev + ph_min)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_min)/2d0)
+         !         = SQRT(10**(-(ph_prev + ph_min)))
+         !         = SQRT([H]_old*10**(-ph_min))
+         !         = SQRT([H]_old * zhmax)
+         zh                 = SQRT(zh_1 * zh_max)
+         zh_delta           = zh - zh_1
+      ENDIF
+   ENDIF
+
+   zeqn_absmin = MIN(ABS(zeqn), zeqn_absmin)
+
+   ! Stop iterations once |([H]-[H_1])/[H_1]| < rdel
+   l_exitnow = (ABS(zh_delta) < pp_rdel_ah_target*zh_1)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+SOLVE_AT_GENERAL_SEC = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+   ELSE
+     p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+
+RETURN
+END FUNCTION SOLVE_AT_GENERAL_SEC
+
+!===============================================================================
+
+FUNCTION SOLVE_AT_FAST(p_alktot, p_dictot, p_bortot,                          &
+                       p_po4tot, p_siltot,                                    &
+                       p_so4tot, p_flutot,                                    & 
+                       K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,        &
+                       p_hini,   p_val)
+
+! Fast version of SOLVE_AT_GENERAL, without any bounds checking.
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_FAST
+
+! Argument variables 
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables
+REAL(KIND=wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+REAL(KIND=wp)  ::  zhdelta
+REAL(KIND=wp)  ::  zeqn, zdeqndh
+!REAL(KIND=wp)  ::  aphscale
+LOGICAL        :: l_exitnow
+REAL(KIND=wp), PARAMETER :: pz_exp_threshold = 1.0_wp
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+!aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL AHINI_FOR_AT(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+zh = zh_ini
+
+niter_atfast    = 0                 ! Reset counters of iterations
+DO
+   niter_atfast = niter_atfast + 1
+   IF(niter_atfast > jp_maxniter_atfast) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zh_prev = zh
+
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      & 
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                      P_DERIVEQN = zdeqndh)
+
+   IF(zeqn == 0._wp) EXIT               ! zh is the root
+
+   zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+   IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+      zh          = zh_prev*EXP(zh_lnfactor)
+   ELSE
+      zhdelta     = zh_lnfactor*zh_prev
+      zh          = zh_prev + zhdelta
+   ENDIF
+
+   ! Stop iterations once |\delta{[H]}/[H]| < rdel
+   ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+   ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+   ! Alternatively:
+   ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+   !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+   !             < 1/LOG(10) * rdel
+
+   ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+   ! rdel <- pp_rdel_ah_target
+
+   l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+SOLVE_AT_FAST = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+   ELSE
+      p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+
+RETURN
+END FUNCTION solve_at_fast
+!===============================================================================
+
+END MODULE mocsy_phsolvers
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90	(revision 5841)
@@ -0,0 +1,11 @@
+!> \file mocsy_singledouble.f90
+!! \BRIEF 
+!> Module that defines single and double precision - used by all other modules
+MODULE mocsy_singledouble
+! INTEGER, PARAMETER :: r4 = SELECTED_REAL_KIND(6)
+! INTEGER, PARAMETER :: r8 = SELECTED_REAL_KIND(12)
+  INTEGER, PARAMETER :: r4 = KIND(1.0)
+  INTEGER, PARAMETER :: r8 = KIND(1.0d0)
+! INTEGER, PARAMETER :: wp = KIND(1.0d0)
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307)
+END MODULE mocsy_singledouble
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90	(revision 5841)
@@ -0,0 +1,335 @@
+MODULE mocsy_wrapper
+   !!======================================================================
+   !!                         ***  MODULE mocsy_wrapper  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2015-06  (A. Yool)             added for UKESM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam && defined key_mocsy
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA carbonate chemistry
+   !!----------------------------------------------------------------------
+   !!   trc_co2_medusa        :  
+   !!----------------------------------------------------------------------
+
+   USE mocsy_mainmod
+   USE mocsy_gasflux
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mocsy_interface  ! called in trc_bio_medusa
+   PUBLIC mocsy_carbchem   ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id: trcbio.F90 1146 2008-06-25 11:42:56Z rblod $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - mocsy_interface
+!    - CALLS mocsy_carbchem
+!
+! - mocsy_carbchem
+!    - CALLS vars
+!      - CALLS p80
+!      - CALLS constants
+!      - CALLS rho
+!      - CALLS varsolver
+!        - CALLS [phsolvers routines]
+!      - CALLS varsolver (again)
+!    - CALLS x2pCO2atm
+!    - CALLS p2fCO2
+!    - CALLS schmidt_co2
+!    - CALLS surface_K0
+
+CONTAINS
+
+!=======================================================================
+!
+      SUBROUTINE mocsy_interface( temp, sal, alk, dic, sil, phos, &
+           Patm, depth, lat, kw660, xco2, N,                      &
+           ph, pco2, fco2, co2, hco3, co3, OmegaA,                &
+           OmegaC, BetaD, rhoSW, p, tempis,                       &
+           pco2atm, fco2atm, schmidtco2, kwco2, K0,               &
+           co2starair, co2flux, dpco2 )
+!
+!=======================================================================
+!
+! AXY (26/06/15): to preserve both MEDUSA's scalar variables and
+!                 MOCSY's vector variables on code traceability
+!                 grounds, this additional wrapper does a rather
+!                 superfluous conversion between the two; in the
+!                 fullness of time, this should be dispensed with
+!                 and MOCSY used in its full vector form
+!
+        USE mocsy_singledouble
+        IMPLICIT NONE
+
+!> ======================================================================
+!  VARIABLES
+!> ======================================================================
+!
+   INTEGER, INTENT(in) :: N
+!
+!  MEDUSA-side
+!  Input variables
+   REAL(kind=wp), INTENT(in)  :: temp, sal, alk, dic, sil, phos
+   REAL(kind=wp), INTENT(in)  :: Patm, depth, lat, kw660, xco2
+!
+!  Output variables
+   REAL(kind=wp), INTENT(out) :: ph, pco2, fco2, co2, hco3, co3, OmegaA
+   REAL(kind=wp), INTENT(out) :: OmegaC, BetaD, rhoSW, p, tempis
+   REAL(kind=wp), INTENT(out) :: pco2atm, fco2atm, schmidtco2, kwco2, K0
+   REAL(kind=wp), INTENT(out) :: co2starair, co2flux, dpco2
+!
+!  MOCSY-side
+!  Input variables
+   REAL(kind=wp), DIMENSION(N) :: mtemp, msal, malk, mdic, msil, mphos
+   REAL(kind=wp), DIMENSION(N) :: mPatm, mdepth, mlat, mkw660, mxco2
+!
+!  Output variables
+   REAL(kind=wp), DIMENSION(N) :: mph, mpco2, mfco2, mco2, mhco3, mco3, mOmegaA
+   REAL(kind=wp), DIMENSION(N) :: mOmegaC, mBetaD, mrhoSW, mp, mtempis
+   REAL(kind=wp), DIMENSION(N) :: mpco2atm, mfco2atm, mschmidtco2, mkwco2, mK0
+   REAL(kind=wp), DIMENSION(N) :: mco2starair, mco2flux, mdpco2
+!
+!> ----------------------------------------------------------------------
+!  Set MOCSY inputs to equal MEDUSA inputs (amend units here)
+!> ----------------------------------------------------------------------
+!
+      mtemp(1)  = temp         ! degrees C
+      msal(1)   = sal          ! PSU
+      malk(1)   = alk / 1000.  ! meq  / m3 -> eq  / m3
+      mdic(1)   = dic / 1000.  ! mmol / m3 -> mol / m3
+      msil(1)   = sil / 1000.  ! mmol / m3 -> mol / m3
+      mphos(1)  = phos / 1000. ! mmol / m3 -> mol / m3
+      mPatm(1)  = Patm         ! atm
+      mdepth(1) = depth        ! m
+      mlat(1)   = lat          ! degrees N
+      mkw660(1) = kw660        ! m / s
+      mxco2(1)  = xco2         ! ppm
+!
+!> ----------------------------------------------------------------------
+!  Call MOCSY
+!> ----------------------------------------------------------------------
+!
+      CALL mocsy_carbchem( mtemp, msal, malk, mdic, msil, mphos, & ! inputs
+      mPatm, mdepth, mlat, mkw660, mxco2, 1,                     & ! inputs
+      mph, mpco2, mfco2, mco2, mhco3, mco3, mOmegaA,             & ! outputs
+      mOmegaC, mBetaD, mrhoSW, mp, mtempis,                      & ! outputs
+      mpco2atm, mfco2atm, mschmidtco2, mkwco2, mK0,              & ! outputs
+      mco2starair, mco2flux, mdpco2 ) ! outputs
+!
+!> ----------------------------------------------------------------------
+!  Set MOCSY outputs to equal MEDUSA outputs (amend units here)
+!> ----------------------------------------------------------------------
+!
+      ph         = mph(1)                 ! standard units
+      pco2       = mpco2(1)               ! uatm
+      fco2       = mfco2(1)               ! uatm
+      co2        = mco2(1) * 1000.        ! mol / m3 -> mmol / m3
+      hco3       = mhco3(1) * 1000.       ! mol / m3 -> mmol / m3
+      co3        = mco3(1) * 1000.        ! mol / m3 -> mmol / m3
+      OmegaA     = mOmegaA(1)             ! dimensionless
+      OmegaC     = mOmegaC(1)             ! dimensionless
+      BetaD      = mBetaD(1)              ! dimensionless
+      rhoSW      = mrhoSW(1)              ! kg / m3
+      p          = mp(1)                  ! db
+      tempis     = mtempis(1)             ! degrees C
+      pco2atm    = mpco2atm(1)            ! uatm
+      fco2atm    = mfco2atm(1)            ! uatm
+      schmidtco2 = mschmidtco2(1)         ! dimensionless
+      kwco2      = mkwco2(1)              ! m / s
+      K0         = mK0(1)                 ! (mol/kg) / atm
+      co2starair = mco2starair(1) * 1000. ! mol / m3 -> mmol / m3 
+      co2flux    = mco2flux(1) * 1000.    ! mol / m2 / s -> mmol / m2 / s 
+      dpco2      = mdpco2(1)              ! uatm
+
+  RETURN
+
+  END SUBROUTINE
+
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!
+      SUBROUTINE mocsy_carbchem( temp, sal, alk, dic, sil, phos,  &
+           Patm, depth, lat, kw660, xco2, N,                      &
+           ph, pco2, fco2, co2, hco3, co3, OmegaA,                &
+           OmegaC, BetaD, rhoSW, p, tempis,                       &
+           pco2atm, fco2atm, schmidtco2, kwco2, K0,               &
+           co2starair, co2flux, dpco2 )
+!
+!=======================================================================
+! 
+! AXY (23/06/15): MOCSY introduced to MEDUSA to update carbonate
+!                 chemistry for UKESM1 project
+!
+! Orr, J. C. and Epitalon, J.-M.: Improved routines to model the 
+! ocean carbonate system: mocsy 2.0, Geosci. Model Dev., 8, 485-499, 
+! doi:10.5194/gmd-8-485-2015, 2015.
+!
+! "mocsy is a Fortran 95 package designed to compute all ocean
+! carbonate system variables from DIC and total Alk, particularly
+! from models.  It updates previous OCMIP code, avoids 3 common 
+! model approximations, and offers the best-practice constants as 
+! well as more recent options. Its results agree with those from 
+! CO2SYS-MATLAB within 0.005%."
+!
+! Where possible the code remains identical to that published by
+! Orr & Epitalon (2015; henceforth OE15); some consolidation of 
+! MOCSY files has taken place, and the resulting package is 
+! comprised of four modules:
+!                 
+! 1. mocsy_wrapped.f90
+!    - This module contains the interface between MEDUSA and the
+!      main MOCSY routines; it draws from (but is very different
+!      from) the test_mocsy.f90 routine provided by OE15
+!
+! 2. mocsy_singledouble.f90
+!    - This module contains only precision definitions; it is
+!      based on the singledouble.f90 routine provided by OE15
+!
+! 3. mocsy_phsolvers.f90
+!    - This module contains a suite of solvers derived from
+!      Munhoven (2013) and modified by OE15; it is based on the
+!      phsolver.f90 routine provided by OE15
+!
+! 4. mocsy_gasflux.f90
+!    - This module contains a series of subroutines used to 
+!      calculate the air-sea flux of CO2; it consolidates four
+!      MOCSY routines with an OCMIP-2 Schmidt number routine
+!      updated with the new parameterisations of Wanninkhof (2014)
+!
+! 5. mocsy_mainmod.f90
+!    - This module consolidates all of the remaining MOCSY 
+!      functions and subroutines from OE15 into a single file
+!      for convenience
+!
+! NOTE: it is still possible to run PML's carbonate chemistry
+! routine in MEDUSA; at present this remains the default, if
+! less-preferred, routine (i.e. is used if key_mocsy is not
+! present)
+!
+        USE mocsy_singledouble
+        IMPLICIT NONE
+
+!> ======================================================================
+!  VARIABLES
+!> ======================================================================
+!
+!  Input variables
+   REAL(kind=wp), INTENT(in),  DIMENSION(N) :: temp, sal, alk, dic, sil, phos
+   REAL(kind=wp), INTENT(in),  DIMENSION(N) :: Patm, depth, lat, kw660, xco2
+   INTEGER, INTENT(in) :: N
+!
+!  Output variables
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: ph, pco2, fco2, co2, hco3, co3, OmegaA
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaC, BetaD, rhoSW, p, tempis
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: pco2atm, fco2atm, schmidtco2, kwco2, K0
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: co2starair, co2flux, dpco2
+!
+!  Local variables
+   REAL(kind=wp), DIMENSION(N) :: depth0, co2star
+   INTEGER :: i, totdat
+!
+!  "vars" Input options
+   CHARACTER(10) :: optCON, optT, optP, optB, optKf, optK1K2
+
+!> ======================================================================
+!  CONFIGURE OPTIONS
+!> ======================================================================
+!> OPTIONS: see complete documentation in 'vars' subroutine
+!> Typical options for MODELS
+   optCON  = 'mol/m3' ! input concentrations are in MOL/M3
+   optT    = 'Tpot'   ! input temperature, variable 'temp', is POTENTIAL temp [°C]
+   optP    = 'm'      ! input variable 'depth' is in METERS
+   optB    = 'l10'    ! Lee et al. (2010) formulation for total boron
+   optK1K2 = 'l'      ! Lueker et al. (2000) formulations for K1 & K2 (best practices)
+   optKf   = 'dg'     ! Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+
+!> ======================================================================
+!  CARBONATE CHEMISTRY CALCULATIONS
+!> ======================================================================
+!> Call mocsy's main subroutine to compute carbonate system variables: 
+!> pH, pCO2, fCO2, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R
+!> FROM temperature, salinity, total alkalinity, dissolved inorganic 
+!> carbon, silica, phosphate, depth (or pressure) (1-D arrays)
+   call vars(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC, BetaD, rhoSW, p, tempis,  &  ! OUTPUT
+             temp, sal, alk, dic, sil, phos, Patm, depth, lat, N,                      &  ! INPUT
+             optCON, optT, optP)
+!            optCON, optT, optP, optB, optK1K2, optKf)                                    ! INPUT OPTIONS
+
+!> ======================================================================
+!  GAS EXCHANGE CALCULATIONS
+!> ======================================================================
+!>
+!> Only calculate gas exchange fields if depth = 0
+   if (depth(1) .eq. 0.0) then
+!
+!     Compute pCO2atm [uatm] from xCO2 [ppm], atmospheric pressure [atm], & vapor pressure of seawater
+!     pCO2atm = (Patm - pH20(i)) * xCO2,   where pH20 is the vapor pressure of seawater [atm]
+      CALL x2pCO2atm(xco2, temp, sal, Patm, N, & ! INPUT
+      pco2atm)                                   ! OUTPUT
+
+!     Compute fCO2atm [uatm] from pCO2atm [uatm] & fugacity coefficient [unitless]
+!     fCO2atm = pCO2atm * fugcoeff,   where fugcoeff= exp(Patm*(B + 2.0*xc2*Del)/(R*tk) )
+      CALL p2fCO2(pco2atm, temp, Patm, depth0, N, & ! INPUT
+      fco2atm)                                      ! OUTPUT
+
+!     Compute Schmidt number for CO2 from potential temperature
+      CALL schmidt_co2(temp, N, & ! INPUT
+      schmidtco2)                 ! OUTPUT
+
+!     Compute transfer velocity for CO2 in m/s (see equation [4] in OCMIP2 design document & OCMIP2 Abiotic HOWTO)
+      kwco2 = kw660 * (660./schmidtco2)**0.5
+
+!     Surface K0 [(mol/kg) / atm] at T, S of surface water
+      CALL surface_K0(temp, sal, N, & ! INPUT
+      K0)                             ! OUTPUT
+
+!     "Atmospheric" [CO2*], air-sea CO2 flux, sfc DIC rate of change, & Delta pCO2
+!     all "lifted" from the gasx.f90 function of MOCSY
+      co2starair = K0 * fco2atm * 1.0e-6_wp * rhoSW ! Equil. [CO2*] for atm CO2 at Patm & sfc-water T,S [mol/m3]
+      co2star    = co2                              ! Oceanic [CO2*] in [mol/m3] from vars.f90
+      co2flux    = kwco2 * (co2starair - co2star)   ! Air-sea CO2 flux [mol/(m2 * s)]
+!     co2ex      = co2flux / dz1                    ! Change in sfc DIC due to gas exchange [mol/[m3 * s)]
+      dpco2      = pco2 - pco2atm                   ! Delta pCO2 (oceanic - atmospheric pCO2) [uatm]
+!     
+   endif
+
+  RETURN
+
+  END SUBROUTINE
+
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#  else
+   !!======================================================================
+   !!  Dummy module :                         No MOCSY carbonate chemistry
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE mocsy_interface( kt )                   ! Empty routine
+
+      INTEGER, INTENT( in ) ::   kt
+
+      WRITE(*,*) 'mocsy_interface: You should not have seen this print! error?', kt
+
+   END SUBROUTINE mocsy_interface
+#endif 
+
+   !!======================================================================
+
+END MODULE mocsy_wrapper
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90	(revision 5841)
@@ -172,5 +172,8 @@
 !!
 !! UKESM diagnostics
-   INTEGER  ::  jdms      !:  include DMS diagnostics ? Jpalm (27-08-2014) 
+   INTEGER  ::  jdms         !: include DMS diagnostics ? Jpalm (27-08-2014) 
+   INTEGER  ::  jdms_input   !: use instant (0) or diel-average (1) inputs (AXY, 08/07/2015)
+   INTEGER  ::  jdms_model   !: choice of DMS model passed to atmosphere
+!!                              1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL
 !!
 !!
@@ -217,4 +220,21 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_ca   !: 2D inorganic carbon   (now)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_ca   !: 2D inorganic carbon   (after)
+!!
+!! 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chn  !: 2D avg CHN   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chn  !: 2D avg CHN   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chn  !: 2D avg CHN   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chd  !: 2D avg CHD   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chd  !: 2D avg CHD   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chd  !: 2D avg CHD   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_mld  !: 2D avg MLD   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_mld  !: 2D avg MLD   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_mld  !: 2D avg MLD   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_qsr  !: 2D avg QSR   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_qsr  !: 2D avg QSR   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_qsr  !: 2D avg QSR   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_din  !: 2D avg DIN   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_din  !: 2D avg DIN   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_din  !: 2D avg DIN   (after)
 #endif
 
@@ -415,5 +435,5 @@
       !!----------------------------------------------------------------------
       USE lib_mpp , ONLY: ctl_warn
-      INTEGER ::   ierr(6)        ! Local variables
+      INTEGER ::   ierr(7)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -439,4 +459,15 @@
          &      zb_sed_ca(jpi,jpj)   , zn_sed_ca(jpi,jpj)   ,       &
          &      za_sed_ca(jpi,jpj)   ,                           STAT=ierr(3) )
+      !* 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15)
+      ALLOCATE( zb_dms_chn(jpi,jpj)  , zn_dms_chn(jpi,jpj)  ,       &
+         &      za_dms_chn(jpi,jpj)  ,                              &
+         &      zb_dms_chd(jpi,jpj)  , zn_dms_chd(jpi,jpj)  ,       &		  
+         &      za_dms_chd(jpi,jpj)  ,                              &
+         &      zb_dms_mld(jpi,jpj)  , zn_dms_mld(jpi,jpj)  ,       &		  
+         &      za_dms_mld(jpi,jpj)  ,                              &
+         &      zb_dms_qsr(jpi,jpj)  , zn_dms_qsr(jpi,jpj)  ,       &		  
+         &      za_dms_qsr(jpi,jpj)  ,                              &
+         &      zb_dms_din(jpi,jpj)  , zn_dms_din(jpi,jpj)  ,       &		  
+         &      za_dms_din(jpi,jpj)  ,                           STAT=ierr(4) )
 # endif
       !* 2D fields of miscellaneous parameters
@@ -444,8 +475,8 @@
          &      dustmo(jpi,jpj,2)    , riv_n(jpi,jpj)       ,       &
          &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       &
-         &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(4) )
+         &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(5) )
       !* 2D and 3D fields of light parameters
       ALLOCATE( neln(jpi,jpj)        , xze(jpi,jpj)         ,       &
-         &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(5) )
+         &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(6) )
       !* 2D and 3D fields of sediment-associated parameters
       ALLOCATE( dminl(jpi,jpj)       , dmin3(jpi,jpj,jpk)   ,       &
@@ -454,5 +485,5 @@
          &      fbodf(jpi,jpj)       , fbods(jpi,jpj)       ,       &
          &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       &
-         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(6) ) 
+         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(7) ) 
 #endif
       !
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90	(revision 5841)
@@ -0,0 +1,128 @@
+MODULE trcavg_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcavg_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :    -   !  2015-07  (A. Yool) Original code
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA rolling averages
+   !!----------------------------------------------------------------------
+   !!   trc_avg_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+
+      PUBLIC   trc_avg_medusa    ! called in trc_sms_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id: trcbio.F90 1146 2008-06-25 11:42:56Z rblod $ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+!=======================================================================
+!
+      SUBROUTINE trc_avg_medusa( kt )
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates rolling averages of variables
+      !! Author : Andrew Yool
+      !! Date   : 23/07/15
+      !!
+      !! Calculates and updates rolling averages of properties such
+      !! as surface irradiance and mixed layer depth that are used
+      !! in functions that require average rather than instantaneous
+      !! values.
+      !!
+      !! This functionality was originally added to support the
+      !! calculation of surface DMS concentrations - and was done so
+      !! within the trcbio_meduse.F90 routine - but was moved to
+      !! this separate module so that its calculations could be used
+      !! to inform MEDUSA's submarine irradiance field
+      !!
+!=======================================================================
+!
+      IMPLICIT NONE
+!
+      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+! 
+!=======================================================================
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_avg_medusa'
+         CALL flush(numout)
+# endif
+      !! AXY (24/07/15): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_avg_medusa: MEDUSA rolling average'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+         IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+      !!
+      !!----------------------------------------------------------------------
+      !! Process average fields
+      !! The empirical formulae used for estimating surface DMS concentrations
+      !! require temporally averaged input fields; this block calculates these
+      !! averages based on diel averages; note that rdt 
+      !!----------------------------------------------------------------------
+      !!
+      zn_dms_chn(:,:) = ( zb_dms_chn(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpchn) * (rdt / 86400.) )
+      zb_dms_chn(:,:) = zn_dms_chn(:,:)
+      zn_dms_chd(:,:) = ( zb_dms_chd(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpchd) * (rdt / 86400.) )
+      zb_dms_chd(:,:) = zn_dms_chd(:,:)
+      zn_dms_mld(:,:) = ( zb_dms_mld(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + (        hmld(:,:) * (rdt / 86400.) )
+      zb_dms_mld(:,:) = zn_dms_mld(:,:)
+      zn_dms_qsr(:,:) = ( zb_dms_qsr(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + (         qsr(:,:) * (rdt / 86400.) )
+      zb_dms_qsr(:,:) = zn_dms_qsr(:,:)
+      zn_dms_din(:,:) = ( zb_dms_din(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpdin) * (rdt / 86400.) )
+      zb_dms_din(:,:) = zn_dms_din(:,:)
+
+  END SUBROUTINE trc_avg_medusa
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_avg_medusa( kt )                                        !! EMPTY Routine
+!      
+!
+      INTEGER, INTENT( in ) ::   kt
+!
+
+      WRITE(*,*) 'trc_avg_medusa: You should not have seen this print! error?'
+
+   END SUBROUTINE trc_avg_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcavg_medusa
+
+
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90	(revision 5841)
@@ -16,4 +16,6 @@
    !!  -   !  2013-05  (A. Yool)              updated for v3.5
    !!  -   !  2014-08  (A. Yool, J. Palm)     Add DMS module for UKESM1 model
+   !!  -   !  2015-06  (A. Yool)              Update to include MOCSY
+   !!  -   !  2015-07  (A. Yool)              Update for rolling averages
    !!----------------------------------------------------------------------
    !!
@@ -36,4 +38,17 @@
 #endif
    !!
+#if defined key_mocsy
+   !!----------------------------------------------------------------------
+   !! Updates with the addition of MOCSY include:
+   !!   - option to use PML or MOCSY carbonate chemistry (the latter is 
+   !!     preferred)
+   !!   - central calculation of gas transfer velocity, f_kw660; previously
+   !!     this was done separately for CO2 and O2 with predictable results
+   !!   - distribution of f_kw660 to both PML and MOCSY CO2 air-sea flux 
+   !!     calculations and to those for O2 air-sea flux
+   !!   - extra diagnostics included for MOCSY
+   !!----------------------------------------------------------------------
+#endif
+   !!
 #if defined key_medusa
    !!----------------------------------------------------------------------
@@ -55,5 +70,10 @@
 # endif
 # if defined key_roam
+      USE gastransfer
+#  if defined key_mocsy
+      USE mocsy_wrapper
+#  else
       USE trcco2_medusa
+#  endif
       USE trcoxy_medusa
       !! Jpalm (08/08/2014)
@@ -134,4 +154,7 @@
       REAL(wp) ::    ztmp, zsal
 # endif
+# if defined key_mocsy
+      REAL(wp) ::    zpho
+# endif
       !!
       !! integrated source and sink terms
@@ -266,4 +289,9 @@
       REAL(wp) ::    f_kw660, f_o2flux, f_o2sat
       REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg
+      !!
+      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
+      REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm
+      REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2
+      !!
       INTEGER  ::    iters
       REAL(wp) ::    f_year
@@ -305,4 +333,9 @@
 
       !!---------------------------------------------------------------------
+
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: variables defined'
+      CALL flush(numout)
+# endif 
 
       !! AXY (20/11/14): alter this to report on first MEDUSA call
@@ -486,4 +519,9 @@
 # endif
 
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked'
+      CALL flush(numout)
+# endif 
+
 # if defined key_roam
       !!----------------------------------------------------------------------
@@ -514,8 +552,7 @@
          f_pco2a = fq4
       endif
-# if defined key_axy_pi_co2
+#  if defined key_axy_pi_co2
       f_pco2a = hist_pco2(1)
-      IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  = FIXED'
-# endif
+#  endif
       !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear     =', nyear
       !! IF(lwp) WRITE(numout,*) ' MEDUSA nsec_day  =', real(nsec_day)
@@ -529,8 +566,17 @@
 # endif
 
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for carbonate chemistry'
+      IF (lwp) write (numout,*) 'trc_bio_medusa: kt = ', kt
+      IF (lwp) write (numout,*) 'trc_bio_medusa: nittrc000 = ', nittrc000
+      CALL flush(numout)
+# endif 
+
 # if defined key_roam
-      !! AXY (20/11/14): alter to call on first MEDUSA timestep
+      !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every
+      !!                 month (this is hardwired as 960 timesteps but should
+      !!                 be calculated and done properly
       !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN
-      IF( kt == nittrc000 .or. mod(kt,1920) == 0 ) THEN
+      IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN
          !!----------------------------------------------------------------------
          !! Calculate the carbonate chemistry for the whole ocean on the first
@@ -540,4 +586,5 @@
          !!
          IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt
+         CALL flush(numout)
          !! blank flags
          i2_omcal(:,:) = 0
@@ -549,6 +596,8 @@
                   !! OPEN wet point IF..THEN loop
                   if (tmask(ji,jj,jk).eq.1) then
-                     !! carbonate chemistry
+                     !! do carbonate chemistry
+                     !!
                      fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint
+                     !!
                      !! set up required state variables
                      zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon
@@ -556,4 +605,8 @@
                      ztmp = tsn(ji,jj,jk,jp_tem)        !! temperature
                      zsal = tsn(ji,jj,jk,jp_sal)        !! salinity
+#  if defined key_mocsy
+                     zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid
+                     zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield
+#  endif
 		     !!
 		     !! AXY (28/02/14): check input fields
@@ -571,7 +624,28 @@
                         ji, ',', jj, ',', jk, ') at time', kt
                      endif
+                     !!
+                     !! blank input variables not used at this stage (they relate to air-sea flux)
+                     f_kw660 = 1.0
+                     f_pp0   = 1.0
+                     !!
                      !! calculate carbonate chemistry at grid cell midpoint
-                     CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, 5.0, f_pco2a, &    ! inputs
-                     f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),            &    ! outputs
+#  if defined key_mocsy
+                     !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
+                     !!                 chemistry package
+                     CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs
+                     f_pp0, fdep2, flatx, f_kw660, f_pco2a, 1,                         &    ! inputs
+                     f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs
+                     f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs
+                     f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs
+                     f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs
+                     !!
+                     f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg
+                     f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg
+                     f_dcf  = f_rhosw
+#  else
+                     !! AXY (22/06/15): use old PML carbonate chemistry package (the
+                     !!                 MEDUSA-2 default)
+                     CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660,      &    ! inputs
+                     f_pco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),   &    ! outputs
                      f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters)      ! outputs
                      !! 
@@ -581,4 +655,6 @@
                         iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt
                      endif
+#  endif
+                     !!
                      !! store 3D outputs
                      f3_pH(ji,jj,jk)    = f_ph
@@ -588,4 +664,5 @@
                      f3_omcal(ji,jj,jk) = f_omcal(ji,jj)
                      f3_omarg(ji,jj,jk) = f_omarg(ji,jj)
+                     !!
                      !! CCD calculation: calcite
                      if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then
@@ -607,4 +684,5 @@
                         i2_omcal(ji,jj)   = 1
                      endif
+                     !!
                      !! CCD calculation: aragonite
                      if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then
@@ -633,4 +711,9 @@
 # endif
 
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for full domain calculations'
+      CALL flush(numout)
+# endif 
+
       !!----------------------------------------------------------------------
       !! MEDUSA has unified equation through the water column
@@ -656,5 +739,4 @@
             !! OPEN wet point IF..THEN loop
             if (tmask(ji,jj,jk).eq.1) then               
-
                !!======================================================================
                !! SETUP LOCAL GRID CELL
@@ -814,7 +896,4 @@
                   !!----------------------------------------------------------------------
                   !!
-                  !! a bit of set up ...
-                  ! f_uwind = zwnd_i(ji,jj)
-                  ! f_vwind = zwnd_j(ji,jj)
                   !! AXY (17/07/14): zwind_i and zwind_j do not exist in this
                   !!                 version of NEMO because it does not include
@@ -827,22 +906,32 @@
                   !!                 revisited when MEDUSA properly interacts
                   !!                 with UKESM1 physics
-                  ! f_uwind = zwind_i(ji,jj)
-                  ! f_vwind = zwind_j(ji,jj)
-                  ! f_wind  = ((f_uwind**2.0) + (f_vwind**2.0))**0.5
+                  !!
                   f_wind  = wndm(ji,jj)
-                  !! AXY (17/07/14): the current oxygen code takes in separate
-                  !!                 U and V components of the wind; to avoid
-                  !!                 the need to change this, calculate these
-                  !!                 components based on wndm; again, this is
-                  !!                 not ideal, but should suffice as a
-                  !!                 temporary measure; in the long-term all
-                  !!                 of MEDUSA's air-sea gas exchange terms
-                  !!                 will be revisited to ensure that they are
-                  !!                 valid and self-consistent; and the CO2
-                  !!                 code will be wholly replaced with a more
-                  !!                 up-to-date parameterisation
-                  f_uwind = ((f_wind**2.0) / 2.0)**0.5
-                  f_vwind = f_uwind
+                  !!
+                  !! AXY (23/06/15): as part of an effort to update the carbonate chemistry
+                  !!                 in MEDUSA, the gas transfer velocity used in the carbon
+                  !!                 and oxygen cycles has been harmonised and is calculated
+                  !!                 by the same function here; this harmonisation includes
+                  !!                 changes to the PML carbonate chemistry scheme so that
+                  !!                 it too makes use of the same gas transfer velocity; the
+                  !!                 preferred parameterisation of this is Wanninkhof (2014),
+                  !!                 option 7
+                  !!
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer'
+                     CALL flush(numout)
+#   endif
+                  CALL gas_transfer( f_wind, 1, 7, &  ! inputs
+                                     f_kw660 )        ! outputs
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer'
+                     CALL flush(numout)
+#   endif
+                  !!
+                  !! air pressure (atm); ultimately this will use air pressure at the base
+                  !! of the UKESM1 atmosphere 
+                  !!                                     
                   f_pp0   = 1.0
+                  !!
                   !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp
                   !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj)
@@ -852,10 +941,26 @@
                   !!
 #  if defined key_axy_carbchem
+#   if defined key_mocsy
+                  !!
+                  !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
+                  !!                 chemistry package; note that depth is set to
+                  !!                 zero in this call
+                  CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs
+                  f_pp0, 0.0, flatx, f_kw660, f_pco2a, 1,                          &  ! inputs
+                  f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs
+                  f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs
+                  f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs
+                  f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs
+                  !!
+                  f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg
+                  f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg
+                  f_dcf  = f_rhosw
+#   else                  
                   iters = 0
                   !!
                   !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not)
-                  CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_wind, f_pco2a, &     ! inputs
-                  f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),             &     ! outputs
-                  f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )       ! outputs
+                  CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_pco2a,  &  ! inputs
+                  f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),               &  ! outputs
+                  f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )      ! outputs
                   !!
                   !! AXY (09/01/14): removed iteration and NaN checks; these have
@@ -869,4 +974,5 @@
                      iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt
                   endif
+#   endif
 #  else
                   !! AXY (18/04/13): switch off carbonate chemistry calculations; provide
@@ -882,18 +988,34 @@
                   f_TDIC         = zdic
                   f_TALK         = zalk
-                  f_dcf          = 1.
+                  f_dcf          = 1.026
                   f_henry        = 1.
+                  !! AXY (23/06/15): add in some extra MOCSY diagnostics
+                  f_fco2w        = fpco2a
+                  f_BetaD        = 1.
+                  f_rhosw        = 1.026
+                  f_opres        = 0.
+                  f_insitut      = ztmp
+                  f_pco2atm      = fpco2a
+                  f_fco2atm      = fpco2a
+                  f_schmidtco2   = 660.
+                  f_kwco2        = 0.
+                  f_K0           = 0.
+                  f_co2starair   = fpco2a
+                  f_dpco2        = 0.
 #  endif
                   !!
-                  !! already in right units; correct for sea-ice; divide through by layer thickness
-                  f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux / fthk
+                  !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness
+                  f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk
                   !!
                   !! oxygen (O2); OCMIP-2 code
-                  CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk, &  ! inputs
-                  f_kw660, f_o2flux, f_o2sat )                                                     ! outputs
-                  !!
-                  !! mol/m3/s -> mmol/m3/d; correct for sea-ice
-                  f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 1000. * 60. * 60. * 24. 
-                  f_o2sat   = f_o2sat  * 1000.
+                  !! AXY (23/06/15): amend input list for oxygen to account for common gas
+                  !!                 transfer velocity
+                  !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs
+                  !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs
+                  CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs
+                  f_kwo2, f_o2flux, f_o2sat )                                ! outputs
+                  !!
+                  !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness
+                  f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk
                   !!
                   !! Jpalm (08-2014)
@@ -911,9 +1033,27 @@
                   !!
                   IF (jdms .eq. 1) THEN
-                  !!
-                     !! CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), &                            !! inputs
-                     !! dms_surf )                                                                 !! outputs
-                     CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), zdin, &             !! inputs
-                     dms_surf, dms_andr, dms_simo, dms_aran, dms_hall )                            !! outputs
+                     !!
+                     !! feed in correct inputs
+                     if (jdms_input .eq. 0) then
+                        !! use instantaneous inputs
+                        CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), zdin, &  ! inputs
+                        dms_andr, dms_simo, dms_aran, dms_hall )                           ! outputs
+                     else
+                        !! use diel-average inputs
+                        CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs
+                        zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj), zn_dms_din(ji,jj),   &  ! inputs
+                        dms_andr, dms_simo, dms_aran, dms_hall )                      ! outputs
+                     endif
+                     !!
+                     !! assign correct output to variable passed to atmosphere
+                     if     (jdms_model .eq. 1) then
+                        dms_surf = dms_andr
+                     elseif (jdms_model .eq. 2) then
+                        dms_surf = dms_simo
+                     elseif (jdms_model .eq. 3) then
+                        dms_surf = dms_aran
+                     elseif (jdms_model .eq. 4) then
+                        dms_surf = dms_hall
+                     endif
                   ENDIF
                   !! End DMS Loop
@@ -953,5 +1093,5 @@
                   !! alkalinity are derived from continent-scale DIC estimates (Huang et al., 
                   !! 2012) and some Arctic river alkalinity estimates (Katya?)
-                  !!      
+                  !! 
                   !! as of 19/07/12, riverine nutrients can now be spread vertically across 
                   !! several grid cells rather than just poured into the surface box; this
@@ -3317,4 +3457,12 @@
          ENDDO
       ENDDO
+      !! AXY (07/07/15): temporary hijacking
+# if defined key_roam
+      trc2d(:,:,126) = zn_dms_chn(:,:)
+      trc2d(:,:,127) = zn_dms_chd(:,:)
+      trc2d(:,:,128) = zn_dms_mld(:,:)
+      trc2d(:,:,129) = zn_dms_qsr(:,:)
+      trc2d(:,:,130) = zn_dms_din(:,:)
+# endif
 
       if (ibenthic.eq.2) then
@@ -3322,105 +3470,105 @@
          !! effectively commented out because it does not work as 
          !! anticipated; it can be deleted at a later date
-      if (jorgben.eq.1) then
-         za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt
-         za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt
-         za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt
-      endif
-      if (jinorgben.eq.1) then
-         za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt
-         za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt
-      endif
-      !!
-      !! Leap-frog scheme - only in explicit case, otherwise the time stepping
-      !! is already being done in trczdf
-      !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
-      !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc )
-      !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc)
-      !!    if (jorgben.eq.1) then
-      !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  )
-      !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) )
-      !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  )
-      !!    endif
-      !!    if (jinorgben.eq.1) then
-      !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) )
-      !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) )
-      !!    endif
-      !! ENDIF
-      !! 
-      !! Time filter and swap of arrays
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+         if (jorgben.eq.1) then
+            za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt
+            za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt
+            za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt
+         endif
+         if (jinorgben.eq.1) then
+            za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt
+            za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt
+         endif
+         !!
+         !! Leap-frog scheme - only in explicit case, otherwise the time stepping
+         !! is already being done in trczdf
+         !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
+         !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc )
+         !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc)
+         !!    if (jorgben.eq.1) then
+         !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  )
+         !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) )
+         !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  )
+         !!    endif
+         !!    if (jinorgben.eq.1) then
+         !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) )
+         !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) )
+         !!    endif
+         !! ENDIF
+         !! 
+         !! Time filter and swap of arrays
+         IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN ! centred or tvd scheme
+            IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+               if (jorgben.eq.1) then
+                  zb_sed_n(:,:)  = zn_sed_n(:,:)
+                  zn_sed_n(:,:)  = za_sed_n(:,:)
+                  za_sed_n(:,:)  = 0.0
+                  !!
+                  zb_sed_fe(:,:) = zn_sed_fe(:,:)
+                  zn_sed_fe(:,:) = za_sed_fe(:,:)
+                  za_sed_fe(:,:) = 0.0
+                  !!
+                  zb_sed_c(:,:)  = zn_sed_c(:,:)
+                  zn_sed_c(:,:)  = za_sed_c(:,:)
+                  za_sed_c(:,:)  = 0.0
+               endif
+               if (jinorgben.eq.1) then
+                  zb_sed_si(:,:) = zn_sed_si(:,:)
+                  zn_sed_si(:,:) = za_sed_si(:,:)
+                  za_sed_si(:,:) = 0.0
+                  !!
+                  zb_sed_ca(:,:) = zn_sed_ca(:,:)
+                  zn_sed_ca(:,:) = za_sed_ca(:,:)
+                  za_sed_ca(:,:) = 0.0
+               endif
+            ELSE
+               if (jorgben.eq.1) then
+                  zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) )
+                  zn_sed_n(:,:)  = za_sed_n(:,:)
+                  za_sed_n(:,:)  = 0.0
+                  !!
+                  zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:))
+                  zn_sed_fe(:,:) = za_sed_fe(:,:)
+                  za_sed_fe(:,:) = 0.0
+                  !!
+                  zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) )
+                  zn_sed_c(:,:)  = za_sed_c(:,:)
+                  za_sed_c(:,:)  = 0.0
+               endif
+               if (jinorgben.eq.1) then
+                  zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:))
+                  zn_sed_si(:,:) = za_sed_si(:,:)
+                  za_sed_si(:,:) = 0.0
+                  !!
+                  zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:))
+                  zn_sed_ca(:,:) = za_sed_ca(:,:)
+                  za_sed_ca(:,:) = 0.0
+               endif
+            ENDIF
+         ELSE                   !  case of smolar scheme or muscl
             if (jorgben.eq.1) then
-               zb_sed_n(:,:)  = zn_sed_n(:,:)
+               zb_sed_n(:,:)  = za_sed_n(:,:)
                zn_sed_n(:,:)  = za_sed_n(:,:)
                za_sed_n(:,:)  = 0.0
                !!
-               zb_sed_fe(:,:) = zn_sed_fe(:,:)
+               zb_sed_fe(:,:) = za_sed_fe(:,:)
                zn_sed_fe(:,:) = za_sed_fe(:,:)
                za_sed_fe(:,:) = 0.0
                !!
-               zb_sed_c(:,:)  = zn_sed_c(:,:)
+               zb_sed_c(:,:)  = za_sed_c(:,:)
                zn_sed_c(:,:)  = za_sed_c(:,:)
                za_sed_c(:,:)  = 0.0
             endif
             if (jinorgben.eq.1) then
-               zb_sed_si(:,:) = zn_sed_si(:,:)
+               zb_sed_si(:,:) = za_sed_si(:,:)
                zn_sed_si(:,:) = za_sed_si(:,:)
                za_sed_si(:,:) = 0.0
                !!
-               zb_sed_ca(:,:) = zn_sed_ca(:,:)
-               zn_sed_ca(:,:) = za_sed_ca(:,:)
-               za_sed_ca(:,:) = 0.0
-            endif
-         ELSE
-            if (jorgben.eq.1) then
-               zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) )
-               zn_sed_n(:,:)  = za_sed_n(:,:)
-               za_sed_n(:,:)  = 0.0
-               !!
-               zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:))
-               zn_sed_fe(:,:) = za_sed_fe(:,:)
-               za_sed_fe(:,:) = 0.0
-               !!
-               zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) )
-               zn_sed_c(:,:)  = za_sed_c(:,:)
-               za_sed_c(:,:)  = 0.0
-            endif
-            if (jinorgben.eq.1) then
-               zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:))
-               zn_sed_si(:,:) = za_sed_si(:,:)
-               za_sed_si(:,:) = 0.0
-               !!
-               zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:))
+               zb_sed_ca(:,:) = za_sed_ca(:,:)
                zn_sed_ca(:,:) = za_sed_ca(:,:)
                za_sed_ca(:,:) = 0.0
             endif
          ENDIF
-      ELSE                                                   !  case of smolar scheme or muscl
-         if (jorgben.eq.1) then
-            zb_sed_n(:,:)  = za_sed_n(:,:)
-            zn_sed_n(:,:)  = za_sed_n(:,:)
-            za_sed_n(:,:)  = 0.0
-            !!
-            zb_sed_fe(:,:) = za_sed_fe(:,:)
-            zn_sed_fe(:,:) = za_sed_fe(:,:)
-            za_sed_fe(:,:) = 0.0
-            !!
-            zb_sed_c(:,:)  = za_sed_c(:,:)
-            zn_sed_c(:,:)  = za_sed_c(:,:)
-            za_sed_c(:,:)  = 0.0
-         endif
-         if (jinorgben.eq.1) then
-            zb_sed_si(:,:) = za_sed_si(:,:)
-            zn_sed_si(:,:) = za_sed_si(:,:)
-            za_sed_si(:,:) = 0.0
-            !!
-            zb_sed_ca(:,:) = za_sed_ca(:,:)
-            zn_sed_ca(:,:) = za_sed_ca(:,:)
-            za_sed_ca(:,:) = 0.0
-         endif
-      ENDIF
       endif
-
+      
       IF( ln_diatrc ) THEN
          !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90	(revision 5841)
@@ -47,5 +47,5 @@
 !=======================================================================
 !
-      SUBROUTINE trc_co2_medusa( Temp, Sal, DIC, ALK, Depth, Wnd, pCO2a, &
+      SUBROUTINE trc_co2_medusa( Temp, Sal, DIC, ALK, Depth, xkw, pCO2a, &
       pH, pCO2w, h2co3, hco3, co3, om_cal, om_arg, co2flux, TDIC, TALK,  &
       dcf, henry, iters )
@@ -72,4 +72,6 @@
 ! 17/02/2010. Update calculation of K1, K2, Kb to make consistant with the OCMIP protocols.
 ! 29/07/2011. Merged into MEDUSA with a raft of changes to this subroutine; less elsewhere
+! 23/06/2015. Modified to take gas transfer velocity as an input (rather than wind speed); 
+!             alter CO2 flux to /s rather than /d for consistency with other schemes
 !
 ! Changes for MEDUSA include: 
@@ -85,5 +87,6 @@
       REAL(wp), INTENT( in )    :: ALK        ! meq  / m3
       REAL(wp), INTENT( in )    :: Depth      ! m
-      REAL(wp), INTENT( in )    :: Wnd        ! m / s
+!     REAL(wp), INTENT( in )    :: Wnd        ! m / s
+      REAL(wp), INTENT( in )    :: xkw        ! m / s
       REAL(wp), INTENT( in )    :: pCO2a      ! uatm
 !----------------------------------------------------------------------
@@ -95,5 +98,5 @@
       REAL(wp), INTENT( inout ) :: om_cal     ! normalised
       REAL(wp), INTENT( inout ) :: om_arg     ! normalised
-      REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / d
+      REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / s
       REAL(wp), INTENT( inout ) :: TDIC       ! umol / kg
       REAL(wp), INTENT( inout ) :: TALK       ! ueq  / kg
@@ -129,5 +132,5 @@
    !                 (i.e. surface calculations being performed)
    if (Depth .eq. 0.0) then
-      call Air_sea_exchange( Temp, Wnd, pCO2w, pCO2a, henry, dcf, &         ! inputs
+      call Air_sea_exchange( Temp, xkw, pCO2w, pCO2a, henry, dcf, &         ! inputs
          co2flux )                                                          ! output
    else
@@ -145,5 +148,5 @@
       IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zdic    =', DIC
       IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zalk    =', ALK
-      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_wind  =', Wnd
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_kw660 =', xkw
       IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_ph    =', ph
       IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_pco2w =', pCO2w
@@ -162,5 +165,5 @@
       &        ' DIC', DIC, ' ALK', ALK
       if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
-      &        ' WND', Wnd, ' PH ', ph
+      &        ' XKW', xkw, ' PH ', ph
       if (lwp) write (numout,'(a,a,i6)') 'CO2FLUX-NAN', &
       &        ' ITERS', iters
@@ -196,5 +199,5 @@
 !  WRITE(*,'(A27,F10.3)') "    Omega calcite       (~) = ", om_cal
 !  WRITE(*,'(A27,F10.3)') "    Omega aragonite     (~) = ", om_arg
-!  WRITE(*,'(A27,F10.3)') "    air sea flux(mmol/m2/d) = ", flux
+!  WRITE(*,'(A27,F10.3)') "    air sea flux(mmol/m2/s) = ", flux
 !  WRITE(*,*) " "
 
@@ -287,5 +290,5 @@
 !=======================================================================
 !
-      SUBROUTINE Air_sea_exchange( T, Wnd, pco2w, pco2a, henry, dcf, &
+      SUBROUTINE Air_sea_exchange( T, xkw, pco2w, pco2a, henry, dcf, &
       flux )
 !      
@@ -302,5 +305,6 @@
 !  pCO2a    partial pressure of CO2 in the atmosphere (usually external forcing).
 !  T        temperature (C)
-!  Wnd      wind speed, metres
+!  Wnd      wind speed, metres (DELETED)
+!  xkw      gas transfer velocity
 !  Henry    henry's constant
 !  density  the density of water for conversion between mmol/m3 and umol/kg
@@ -312,5 +316,5 @@
    IMPLICIT NONE
 
-      REAL(wp), INTENT( in )    :: T, wnd, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS:
+      REAL(wp), INTENT( in )    :: T, xkw, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS:
 !-----------------------------------------------------------------------
       REAL(wp), INTENT( inout ) :: flux                             ! OUTPUT Variables
@@ -320,5 +324,6 @@
 ! calculate the Schmidt number and unit conversions
           sc    = 2073.1-125.62*T+3.6276*T**2.0-0.0432190*T**3.0
-          fwind = (0.222d0 * wnd**2d0 + 0.333d0 * wnd)*(sc/660.d0)**(-0.5)
+!         fwind = (0.222d0 * wnd**2d0 + 0.333d0 * wnd)*(sc/660.d0)**(-0.5)
+          fwind = xkw * (sc/660.d0)**(-0.5)
           fwind = fwind*24.d0/100.d0   ! convert to m/day
 
@@ -326,4 +331,7 @@
 ! here it is rescaled to mmol/m2/d
           flux = fwind * henry * ( pco2a - pco2w ) * dcf
+
+! AXY (23/06/15): let's get it from /d to /s
+          flux = flux / ( 86400. )
 
   RETURN 
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90	(revision 5841)
@@ -39,5 +39,5 @@
 !
    SUBROUTINE trc_dms_medusa( chn, chd, mld, xqsr, xdin,   &  !! inputs
-     &  dms_surf, dms_andr, dms_simo, dms_aran, dms_hall )    !! outputs
+     &  dms_andr, dms_simo, dms_aran, dms_hall )              !! outputs
 !      
 !=======================================================================
@@ -70,4 +70,9 @@
       !!                    published (and different from the above)
       !!
+      !! AXY (08/07/15): amend to remove Julien's original calculation
+      !!                 as this is now superfluous; the four schemes 
+      !!                 are calculated and one is chosen to be passed
+      !!                 to the atmosphere in trc_bio_medusa
+      !!
 !=======================================================================
 
@@ -79,5 +84,4 @@
       REAL(wp), INTENT( in )    :: xqsr                 !! surface irradiance        (W/m2)
       REAL(wp), INTENT( in )    :: xdin                 !! surface DIN               (mmol N/m3)
-      REAL(wp), INTENT( inout ) :: dms_surf             !! DMS surface concentration (mol/m3) 
       REAL(wp), INTENT( inout ) :: dms_andr             !! DMS surface concentration (mol/m3) 
       REAL(wp), INTENT( inout ) :: dms_simo             !! DMS surface concentration (mol/m3) 
@@ -89,73 +93,4 @@
       !! temporary variables
       REAL(wp) ::    fq1,fq2,fq3
-!
-!! IJT (30/03/13): DMS calc needs this
-!! Julien : in Simo & Dachs, GBC, 2002, DMS is derived from 
-!!          CHL/MLD ratio in mg/m4 (i.e. CHL is in mg/m3
-!!          MLD in m).
-!!          In MEDUSA, we already have CHL in mg/m3 for both
-!!          Diatoms and non-diatoms (zchn,zchd); and mld from
-!!          NEMO (hmld) in m.
-      CHL = 0.0
-!!
-!!            CHL = mask * TT(I,J,1,PHYTO_TRACER) &
-!!     &       * c2n_p * mw_carbon / CCHL_P(I,J,1,1)
-      CHL = chn+chd                                 !! mg/m3 
-!!
-!! ------------------------------------------------
-!!  Calculate the DMS concentration in nM (nanomol/litre)
-!!   from Simo & Dachs, GBC, 2002, modified to be positive-definite
-!!   for MLD>182.536m, using DMS=90./MLD (Aranami & Tsunogai, JGR, 2004)
-!!   Multiply by 1.0E-6 to convert nM to (mol/m3)
-!!       cmr = fm(i,1)*chl/mld(i)
-!!       IF (cmr .lt. 0.02) THEN
-!!         IF (mld(i) .le. 182.536) THEN
-!!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(-LOG(mld(i)) + 5.7)
-!!         ELSE
-!!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(90./mld(i))
-!!         ENDIF
-!!       ELSE
-!!         csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(55.8*cmr + 0.6)
-!!       ENDIF
-!!
-        cmr      = CHL / mld
-!       sw_dms   = 0.5 + SIGN( 0.5, cmr - 0.02 )
-!! Jpalm (11-08-2014)
-!! Explanation about the SIGN function :
-!! not easy to read, but maybe "more elegant and efficient")
-!! here for example: 
-!! sw_dms = 1 if cmr is greater than 0.02,
-!!          0 if cmr lower than 0.02
-!! then 
-!! if cmr < 0.02
-!!  dms_surf =  1.0e-6 * 90.0 / mld 
-!!       or  =  1.0e-6 * 5.7 - LOG(mld)
-!! and if cmr > 0.02
-!!  dms_surf = 1.0e-6 * ( 55.8 * cmr + 0.6 )
-!! what is equivalent to the IF loops formulations.
-!! difference is on the stresholds between mld = 182.536m
-!! (strange value...)
-!! and the Max function... that stay uncertain.
-!!
-!        dms_surf = 1.0e-6 * ( sw_dms *             &
-!     &  ( 55.8 * cmr + 0.6 ) + ( 1.0 - sw_dms ) *  &
-!     &  ( MAX( 90.0 / mld, 5.7 - LOG(mld) ) ) )
-!
-! AXY (12/01/15): the DMS equation donated by the UKMO does not match
-!                 that reported in Halloran et al. (2010); amend the
-!                 equations appropriately
-!
-        if (cmr .lt. 0.02) then
-           dms_surf = (-1.0 * log(mld)) + 5.7
-        else
-           dms_surf = (55.8 * cmr) + 0.6
-        endif
-!    
-        if (mld > 182.5) then
-           dms_surf = (90.0 / mld)
-        endif
-!     
-        dms_surf = 1.0e-6 * dms_surf
-
 ! 
 !=======================================================================
@@ -163,4 +98,8 @@
 ! AXY (13/03/15): per remarks above, the following calculations estimate
 !                 DMS using all of the schemes examined for UKESM1
+!
+      CHL = 0.0
+      CHL = chn+chd                                 !! mg/m3 
+      cmr = CHL / mld
 !
 ! AXY (13/03/15): Anderson et al. (2001)
@@ -180,5 +119,4 @@
 !
 ! AXY (13/03/15): Simo & Dachs (2002)
-        cmr = CHL / mld
         fq1 = (-1 * log(mld)) + 5.7
         fq2 = (55.8 * cmr) + 0.6
@@ -191,5 +129,4 @@
 !           
 ! AXY (13/03/15): Aranami & Tsunogai (2004)
-        cmr = CHL / mld
         fq1 = 60.0 / mld
         fq2 = (55.8 * cmr) + 0.6
@@ -202,5 +139,4 @@
 !        
 ! AXY (13/03/15): Halloran et al. (2010)
-        cmr = CHL / mld
         fq1 = (-1 * log(mld)) + 5.7
         fq2 = (55.8 * cmr) + 0.6
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90	(revision 5841)
@@ -38,5 +38,5 @@
    !! JPALM (14/09/15)
    LOGICAL, PUBLIC ::                  &
-      ln_ccd = .FALSE.
+      ln_ccd = .TRUE.
 
    INTEGER ::                          &
@@ -236,4 +236,28 @@
      
       !!----------------------------------------------------------------------
+      !! Averaged properties for DMS calculations (various units)
+      !!----------------------------------------------------------------------
+      !!     
+      !! these store temporally averaged properties for DMS calculations (AXY, 07/07/15)
+      zb_dms_chn(:,:)  = 0.0  !! CHN
+      zn_dms_chn(:,:)  = 0.0
+      za_dms_chn(:,:)  = 0.0
+      zb_dms_chd(:,:)  = 0.0  !! CHD
+      zn_dms_chd(:,:)  = 0.0
+      za_dms_chd(:,:)  = 0.0
+      zb_dms_mld(:,:)  = 0.0  !! MLD
+      zn_dms_mld(:,:)  = 0.0
+      za_dms_mld(:,:)  = 0.0
+      zb_dms_qsr(:,:)  = 0.0  !! QSR
+      zn_dms_qsr(:,:)  = 0.0
+      za_dms_qsr(:,:)  = 0.0
+      zb_dms_din(:,:)  = 0.0  !! DIN
+      zn_dms_din(:,:)  = 0.0
+      za_dms_din(:,:)  = 0.0
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: average fields for DMS initialised to zero'
+      IF(lwp) CALL flush(numout)
+
+      !!----------------------------------------------------------------------
       !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
       !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90	(revision 5841)
@@ -83,5 +83,5 @@
       &  xsdiss,                                              &
       &  vsed,xhr,                                            &
-      &  sedlam,sedlostpoc,jpkb,jdms
+      &  sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model
 #if defined key_roam
       NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        &
@@ -138,11 +138,11 @@
      IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN
          !
-         ! Namelist nampisdia
+         ! Namelist nammeddia
          ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics
+         REWIND( numnatp_ref )              ! Namelist nammeddia in reference namelist : MEDUSA diagnostics
          READ  ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )
 
-         REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics
+         REWIND( numnatp_cfg )              ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics
          READ  ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 )
 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )
@@ -338,4 +338,6 @@
       jpkb	  = 0.
       jdms        = 0
+      jdms_input  = 0
+      jdms_input  = 3
             
       !REWIND(numnatm)
@@ -343,11 +345,11 @@
          ! Namelist natbio
          ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics
+         REWIND( numnatp_ref )              ! Namelist natbio in reference namelist : MEDUSA diagnostics
          READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 903)
-903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )
-
-         REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics
+903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natbio in configuration namelist : MEDUSA diagnostics
          READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 904 )
-904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )
+904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in configuration namelist', lwp )
          IF(lwm) WRITE ( numonp, natbio )
 
@@ -488,8 +490,8 @@
 !! UKESM1 - new diagnostics  !! Jpalm
 !!       jdms        :  include dms diagnostics
-!!
-!!
-!!
-
+!!	 jdms_input  :  use instant (0) or diel-avg (1) inputs
+!!       jdms_model  :  choice of DMS model passed to atmosphere
+!!                      1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL
+!!
       IF(lwp) THEN
 !!
@@ -510,4 +512,18 @@
          &   ' key_axy_carbchem                                                       = INACTIVE'
 #endif        
+#if defined key_mocsy
+         WRITE(numout,*)     &
+         &   ' key_mocsy                                                              = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_mocsy                                                              = INACTIVE'
+#endif        
+#if defined key_avgqsr_medusa
+         WRITE(numout,*)     &
+         &   ' key_avgqsr_medusa                                                      = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_avgqsr_medusa                                                      = INACTIVE'
+#endif        
 #if defined key_bs_axy_zforce
          WRITE(numout,*)     &
@@ -544,4 +560,11 @@
          WRITE(numout,*)     &
          &   ' key_axy_pi_co2                                                         = INACTIVE'
+# endif
+# if defined key_debug_medusa
+         WRITE(numout,*)     &
+         &   ' key_debug_medusa                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_debug_medusa                                                       = INACTIVE'
 # endif
          WRITE(numout,*) ' '
@@ -971,8 +994,28 @@
          &   ' Vert layer for diagnostic of vertical flux,                jpkp        = ', jpkb
 !!
-!! UKESM1 - new diagnostics  !! Jpalm
+!! UKESM1 - new diagnostics  !! Jpalm; AXY (08/07/15)
          WRITE(numout,*) '=== UKESM1-related parameters'
          WRITE(numout,*)     &
          &   ' include DMS diagnostic?,                                   jdms        = ', jdms
+         if (jdms_input .eq. 0) then
+            WRITE(numout,*)     &
+            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = instantaneous'
+         else
+            WRITE(numout,*)     &
+            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = diel-average'
+         endif
+	 if (jdms_model .eq. 1) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Anderson et al. (2001)'
+	 elseif (jdms_model .eq. 2) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Simo & Dachs (2002)'
+	 elseif (jdms_model .eq. 3) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Aranami & Tsunogai (2004)'
+	 elseif (jdms_model .eq. 4) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Halloran et al. (2010)'
+         endif
 !!
       ENDIF
@@ -1032,14 +1075,14 @@
 
       !READ(numnatm,natroam)
-         ! Namelist natbio
+         ! Namelist natroam
          ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics
-         READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 905)
-905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )
-
-         REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics
-         READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 906 )
-906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )
-         IF(lwm) WRITE ( numonp, natbio )
+         REWIND( numnatp_ref )              ! Namelist natroam in reference namelist : MEDUSA diagnostics
+         READ  ( numnatp_ref, natroam, IOSTAT = ios, ERR = 905)
+905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natroam in configuration namelist : MEDUSA diagnostics
+         READ  ( numnatp_cfg, natroam, IOSTAT = ios, ERR = 906 )
+906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natroam )
 
 !! ROAM carbon, alkalinity and oxygen cycle parameters
@@ -1086,11 +1129,11 @@
          ! Namelist natopt
          ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics
+         REWIND( numnatp_ref )              ! Namelist natopt in reference namelist : MEDUSA diagnostics
          READ  ( numnatp_ref, natopt, IOSTAT = ios, ERR = 907)
-907      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )
-
-         REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics
+907      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natopt in configuration namelist : MEDUSA diagnostics
          READ  ( numnatp_cfg, natopt, IOSTAT = ios, ERR = 908 )
-908      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )
+908      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in configuration namelist', lwp )
          IF(lwm) WRITE ( numonp, natopt )
 
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90	(revision 5841)
@@ -73,5 +73,22 @@
       ! determination of surface irradiance
       ! -----------------------------------
-      zpar0m (:,:)   = qsr   (:,:) * 0.43
+      ! AXY (23/07/15): the inclusion of empirical DMS calculations requires
+      !                 daily averages of a series of properties that are
+      !                 used as inputs; these include surface irradiance; 
+      !                 here, this is taken advantage of to allow MEDUSA to
+      !                 base its submarine light field on daily average
+      !                 rather than "instantaneous" irradiance; largely
+      !                 because MEDUSA was originally formulated to work
+      !                 with diel average irradiance rather than a diel
+      !                 cycle; using key_avgqsr_medusa activates this
+      !                 functionality, while its absence gives default
+      !                 MEDUSA (which is whatever is supplied by NEMO)
+# if defined key_avgqsr_medusa
+      ! surface irradiance input is rolling average irradiance
+      zpar0m (:,:)   = zn_dms_qsr(:,:) * 0.43
+# else      
+      ! surface irradiance input is   instantaneous irradiance
+      zpar0m (:,:)   =        qsr(:,:) * 0.43
+# endif
       ! AXY (22/08/14): when zpar0m = 0, zpar100 is also zero and calculating 
       !                 euphotic depth is not possible (cf. the Arctic Octopus); 
@@ -92,5 +109,4 @@
       zparr  (:,:,1) = 0.5 * zpar0m(:,:)
       zparg  (:,:,1) = 0.5 * zpar0m(:,:)
-
 
       ! determination of xpar
@@ -146,5 +162,4 @@
       ENDDO 
 
-
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('opt')")
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90	(revision 5841)
@@ -34,5 +34,4 @@
 ! The following is a map of the subroutines contained within this module
 ! - trc_oxy_medusa
-!      - CALLS gas_transfer
 !      - CALLS oxy_schmidt
 !      - CALLS oxy_sato
@@ -42,6 +41,6 @@
 !=======================================================================
 !
-   SUBROUTINE trc_oxy_medusa( pt, ps, uwind, vwind, pp0, o2, dz, &  !! inputs
-      kw660, o2flux, o2sat )                                        !! outputs
+   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2,  &  !! inputs
+      kwo2, o2flux, o2sat )                               !! outputs
 !      
 !=======================================================================
@@ -57,16 +56,18 @@
       !! number of oxygen) and oxy_sato.f (calculates oxygen saturation 
       !! concentration at 1 atm).
+      !!
+      !! AXY (23/06/15): revised to allow common gas transfer velocity
+      !!                 to be used for CO2 and O2; outputs of this
+      !!                 routine amended to mmol/m3 from mol/m3
       !! 
       !! Function inputs are (in order) : 
       !!     pt      temperature                     (degrees C)
       !!     ps      salinity                        (PSU)
-      !!     uwind   u-wind velocity                 (m/s)
-      !!     vwind   v-wind velocity                 (m/s)
+      !!     kw660   gas transfer velocity           (m/s)
       !!     pp0     surface pressure                (divided by 1 atm)
-      !!     o2      surface O2 concentration        (mol/m3)
-      !!     dz      surface layer thickness         (m)
-      !! (*) kw660   gas transfer velocity           (m/s)
-      !! (*) o2flux  exchange rate of oxygen         (mol/m3/s)
-      !! (+) o2sat   oxygen saturation concentration (mol/m3)
+      !!     o2      surface O2 concentration        (mmol/m3)
+      !! (+) kwo2    gas transfer velocity for O2    (m/s)
+      !! (*) o2flux  exchange rate of oxygen         (mmol/m2/s)
+      !! (+) o2sat   oxygen saturation concentration (mmol/m3)
       !! 
       !! Where (*) is the function output (note its units).  
@@ -78,16 +79,14 @@
       REAL(wp), INTENT( in )    :: pt
       REAL(wp), INTENT( in )    :: ps
-      REAL(wp), INTENT( in )    :: uwind
-      REAL(wp), INTENT( in )    :: vwind
+      REAL(wp), INTENT( in )    :: kw660
       REAL(wp), INTENT( in )    :: pp0
       REAL(wp), INTENT( in )    :: o2
-      REAL(wp), INTENT( in )    :: dz
-      REAL(wp), INTENT( inout ) :: kw660, o2flux, o2sat
-!
-      REAL(wp) :: scl_wind, kwo2, o2schmidt, o2sato
-!
-! Calculate gas transfer
-! 
-      call gas_transfer(uwind, vwind, scl_wind, kw660)
+      REAL(wp), INTENT( out )   :: kwo2, o2flux, o2sat
+!
+      REAL(wp) :: o2schmidt, o2sato, mol_o2
+!
+! Oxygen to mol / m3
+!
+      mol_o2 = o2 / 1000.
 !
 ! Calculate oxygen Schmidt number
@@ -106,5 +105,10 @@
 ! Calculate time rate of change of O2 due to gas exchange (mol/m3/s)
 !
-      o2flux = kwo2 * (o2sat - o2) / dz
+      o2flux = kwo2 * (o2sat - mol_o2)
+!
+! Oxygen flux and saturation to mmol / m3
+!
+      o2sat  =  o2sat * 1000.
+      o2flux = o2flux * 1000.
 !
       END SUBROUTINE trc_oxy_medusa
@@ -130,4 +134,12 @@
       !! are taken from Keeling et al. (1998, GBC, 12, 141-163).
       !! 
+      !! AXY (23/06/2015)
+      !! UPDATED: revised formulation from Wanninkhof (2014) for
+      !! consistency with MOCSY
+      !!
+      !! Winninkhof, R. (2014). Relationship between wind speed and gas
+      !! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+      !! 12, 351-362, doi:10.4319/lom.2014.12.351
+      !!
       !! Function inputs are (in order) : 
       !!     t           temperature (degrees C)
@@ -141,12 +153,21 @@
 !
       REAL(wp) :: pt, o2_schmidt
-      REAL(wp) :: a0, a1, a2, a3
-!
-      data a0 /    1638.0 /
-      data a1 /    -81.83 /
-      data a2 /     1.483 /
-      data a3 / -0.008004 /
-!
-      o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3))
+      REAL(wp) :: a0, a1, a2, a3, a4
+!
+! AXY (23/06/15): OCMIP-2 coefficients
+!     data a0 /    1638.0 /
+!     data a1 /    -81.83 /
+!     data a2 /     1.483 /
+!     data a3 / -0.008004 /
+!
+! AXY (23/06/15): Wanninkhof (2014) coefficients
+      data a0 /     1920.4 /
+      data a1 /     -135.6 /
+      data a2 /     5.2121 /
+      data a3 /   -0.10939 /
+      data a4 / 0.00093777 /
+!
+!     o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3))
+      o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*(a3 + pt*a4)))
 !
       END SUBROUTINE oxy_schmidt
@@ -231,88 +252,4 @@
 !=======================================================================
 
-!=======================================================================
-!
-   SUBROUTINE gas_transfer( uwind, vwind, &  !! input 
-      scl_wind, k )                          !! output
-!      
-!=======================================================================
-      !!
-      !! Title  : Calculates gas transfer velocity
-      !! Author : Andrew Yool
-      !! Date   : 15/10/04 (revised 04/08/2011)
-      !! 
-      !! This subroutine uses near-surface wind speed to calculate gas
-      !! transfer velocity for use in CO2 and O2 exchange calculations.
-      !! 
-      !! Note that the parameterisation of Wanninkhof quoted here is a
-      !! truncation of the original equation.  It excludes a chemical
-      !! enhancement function (based on temperature), although such
-      !! temperature dependence is reported negligible by Etcheto &
-      !! Merlivat (1988).
-      !! 
-      !! Note also that in calculating scalar wind, the variance of the
-      !! wind over the period of a timestep is ignored.  Some authors,
-      !! for instance OCMIP-2, favour including some reference to the
-      !! variability of wind.  However, their wind fields are averaged
-      !! over relatively long time periods, and so this issue may be
-      !! safely (!) ignored here.
-      !! 
-      !! Subroutine inputs are (in order) :
-      !!     uwind     wind u velocity at 10 m (m/s)
-      !!     vwind     wind v velocity at 10 m (m/s)
-      !! (+) scl_wind  scalar wind velocity at 10 m (m/s)
-      !! (*) k         gas transfer velocity (m/s)
-      !! Where (*) is the function output and (+) is a diagnostic output.
-      !!
-!=======================================================================
-
-      implicit none
-!
-! Input variables
-      REAL(wp) :: uwind, vwind
-!
-! Output variables
-      REAL(wp) :: scl_wind, k, tmp_k
-!
-! Choice of parameterisation
-      INTEGER  :: eqn
-!
-! Coefficients for various parameterisations
-      REAL(wp), DIMENSION(6) :: a
-      REAL(wp), DIMENSION(6) :: b
-!
-! Values of coefficients
-      data a(1) / 0.166 /  ! Liss & Merlivat (1986)    [approximated]
-      data a(2) / 0.3   /  ! Wanninkhof (1992)         [sans enhancement]
-      data a(3) / 0.23  /  ! Nightingale et al. (2000) [good]
-      data a(4) / 0.23  /  ! Nightingale et al. (2000) [better]
-      data a(5) / 0.222 /  ! Nightingale et al. (2000) [best]
-      data a(6) / 0.337 /  ! OCMIP-2                   [sans variability]
-!
-      data b(1) / 0.133 /
-      data b(2) / 0.0   /
-      data b(3) / 0.0   /
-      data b(4) / 0.1   /
-      data b(5) / 0.333 /
-      data b(6) / 0.0   /
-!
-! Which parameterisation is to be used?
-      eqn = 2
-!
-! Calculate scalar wind (m/s)
-      scl_wind = (uwind**2 + vwind**2)**0.5
-!
-! Calculate gas transfer velocity (cm/h)
-      tmp_k = (a(eqn) * scl_wind**2) + (b(eqn) * scl_wind)
-!
-! Convert tmp_k from cm/h to m/s
-      k = tmp_k / (100. * 3600.)
-!
-      END SUBROUTINE gas_transfer
-
-!=======================================================================
-!=======================================================================
-!=======================================================================
-
 #else
    !!======================================================================
@@ -322,14 +259,14 @@
 CONTAINS
 
-   SUBROUTINE trc_oxy_medusa( pt, ps, uwind, vwind, pp0, o2, dz, &  !! inputs
-      kw660, o2flux, o2sat )                                        !! outputs
+   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2,  &  !! inputs
+      o2flux, o2sat )                                     !! outputs
       USE par_kind
 
       REAL(wp), INTENT( in )    :: pt
       REAL(wp), INTENT( in )    :: ps
+      REAL(wp), INTENT( in )    :: kw660
       REAL(wp), INTENT( in )    :: pp0
       REAL(wp), INTENT( in )    :: o2
-      REAL(wp), INTENT( in )    :: dz
-      REAL(wp), INTENT( inout ) :: kw660, o2flux, o2sat
+      REAL(wp), INTENT( inout ) :: o2flux, o2sat
 
       WRITE(*,*) 'trc_oxy_medusa: You should not have seen this print! error?', kt
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90	(revision 5841)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90	(revision 5841)
@@ -0,0 +1,306 @@
+MODULE trcrst_medusa
+   !!======================================================================
+   !!                       ***  MODULE trcrst_medusa  ***
+   !! TOP :   create, write, read the restart files of MEDUSA tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!             1.1  !  2014-07 (A. Yool; J. Palmieri) converted for MEDUSA
+   !!             1.2  !  2015-07 (A. Yool) add averaged fields for DMS
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                               medusa tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_medusa   : read  restart file
+   !!   trc_rst_wri_medusa    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_medusa   ! MEDUSA sms trends
+   USE sms_medusa      ! MEDUSA sms trends
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_medusa  ! called by trcini.F90 module (actually trcrst.F90)
+   PUBLIC  trc_rst_wri_medusa   ! called by trcini.F90 module (actually trcrst.F90)
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_medusa( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_medusa  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from medusa model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      !! AXY (07/07/14): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_medusa : Read specific variables from medusa model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      !! AXY (07/07/14): remove LOBSTER calls
+      !! CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 
+      !! CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 
+
+      !! AXY (07/07/14): as well as passive tracers, the restart files
+      !!                 contain 2D fields of sediments; these need to
+      !!                 be read in specially; hence this routine
+      !!
+      !! AXY (13/01/12): check if the restart contains sediment fields;
+      !!                 this is only relevant for simulations that include
+      !!                 biogeochemistry and are restarted from earlier runs
+      !!                 in which there was no sediment component
+      !!
+      IF( iom_varid( knum, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
+         zb_sed_n(:,:)  = 0.0   !! organic N
+         zn_sed_n(:,:)  = 0.0
+         zb_sed_fe(:,:) = 0.0   !! organic Fe
+         zn_sed_fe(:,:) = 0.0
+         zb_sed_si(:,:) = 0.0   !! inorganic Si
+         zn_sed_si(:,:) = 0.0
+         zb_sed_c(:,:)  = 0.0   !! organic C
+         zn_sed_c(:,:)  = 0.0
+         zb_sed_ca(:,:) = 0.0   !! inorganic C
+         zn_sed_ca(:,:) = 0.0
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_sed_n(:,:))
+      fq1 = MAXVAL(zn_sed_n(:,:))
+      fq2 = SUM(zn_sed_n(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_fe(:,:))
+      fq1 = MAXVAL(zn_sed_fe(:,:))
+      fq2 = SUM(zn_sed_fe(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_si(:,:))
+      fq1 = MAXVAL(zn_sed_si(:,:))
+      fq2 = SUM(zn_sed_si(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_c(:,:))
+      fq1 = MAXVAL(zn_sed_c(:,:))
+      fq2 = SUM(zn_sed_c(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_ca(:,:))
+      fq1 = MAXVAL(zn_sed_ca(:,:))
+      fq2 = SUM(zn_sed_ca(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
+         &        fq0, fq1, fq2
+
+      !! AXY (07/07/15): read in temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF( iom_varid( knum, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
+         zb_dms_chn(:,:)  = 0.0   !! CHN
+         zn_dms_chn(:,:)  = 0.0
+         zb_dms_chd(:,:)  = 0.0   !! CHD
+         zn_dms_chd(:,:)  = 0.0
+         zb_dms_mld(:,:)  = 0.0   !! MLD
+         zn_dms_mld(:,:)  = 0.0
+         zb_dms_qsr(:,:)  = 0.0   !! QSR
+         zn_dms_qsr(:,:)  = 0.0
+         zb_dms_din(:,:)  = 0.0   !! DIN
+         zn_dms_din(:,:)  = 0.0
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_dms_chn(:,:))
+      fq1 = MAXVAL(zn_dms_chn(:,:))
+      fq2 = SUM(zn_dms_chn(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_chd(:,:))
+      fq1 = MAXVAL(zn_dms_chd(:,:))
+      fq2 = SUM(zn_dms_chd(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_mld(:,:))
+      fq1 = MAXVAL(zn_dms_mld(:,:))
+      fq2 = SUM(zn_dms_mld(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_qsr(:,:))
+      fq1 = MAXVAL(zn_dms_qsr(:,:))
+      fq2 = SUM(zn_dms_qsr(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_din(:,:))
+      fq1 = MAXVAL(zn_dms_din(:,:))
+      fq2 = SUM(zn_dms_din(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
+
+   END SUBROUTINE trc_rst_read_medusa
+
+   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_medusa  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from medusa model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      !! AXY (07/07/14): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_medusa : Write specific variables from medusa model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      !! AXY (07/07/14): remove LOBSTER calls
+      !! CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
+      !! CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
+
+      !! AXY (07/07/14): as well as passive tracers, the restart files
+      !!                 contain 2D fields of sediments; these need to
+      !!                 be written out specially; hence this routine
+      !!
+      !! AXY (13/01/12): write out "before" and "now" state of seafloor
+      !!                 sediment pools into restart; this happens
+      !!                 whether or not the pools are to be used by
+      !!                 MEDUSA (which is controlled by a switch in the
+      !!                 namelist_top file)
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_N',  zb_sed_n(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_N',  zn_sed_n(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_FE', zb_sed_fe(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_FE', zn_sed_fe(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_SI', zb_sed_si(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_SI', zn_sed_si(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_C',  zb_sed_c(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_C',  zn_sed_c(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_CA', zb_sed_ca(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_CA', zn_sed_ca(:,:) )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_sed_n(:,:))
+      fq1 = MAXVAL(zn_sed_n(:,:))
+      fq2 = SUM(zn_sed_n(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_fe(:,:))
+      fq1 = MAXVAL(zn_sed_fe(:,:))
+      fq2 = SUM(zn_sed_fe(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_si(:,:))
+      fq1 = MAXVAL(zn_sed_si(:,:))
+      fq2 = SUM(zn_sed_si(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_c(:,:))
+      fq1 = MAXVAL(zn_sed_c(:,:))
+      fq2 = SUM(zn_sed_c(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_ca(:,:))
+      fq1 = MAXVAL(zn_sed_ca(:,:))
+      fq2 = SUM(zn_sed_ca(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
+         &        fq0, fq1, fq2
+
+      !! AXY (07/07/15): write out temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_dms_chn(:,:))
+      fq1 = MAXVAL(zn_dms_chn(:,:))
+      fq2 = SUM(zn_dms_chn(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_chd(:,:))
+      fq1 = MAXVAL(zn_dms_chd(:,:))
+      fq2 = SUM(zn_dms_chd(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_mld(:,:))
+      fq1 = MAXVAL(zn_dms_mld(:,:))
+      fq2 = SUM(zn_dms_mld(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_qsr(:,:))
+      fq1 = MAXVAL(zn_dms_qsr(:,:))
+      fq2 = SUM(zn_dms_qsr(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_din(:,:))
+      fq1 = MAXVAL(zn_dms_din(:,:))
+      fq2 = SUM(zn_dms_din(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
+
+   END SUBROUTINE trc_rst_wri_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_medusa( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?',knum
+   END SUBROUTINE trc_rst_read_medusa
+
+   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcrst_medusa
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90	(revision 5841)
@@ -40,5 +40,5 @@
    !! AXY (10/02/09)
    LOGICAL, PUBLIC ::                  &
-      bdustfer = .FALSE.
+      bdustfer = .TRUE.
    REAL(wp), PUBLIC ::                 &
       sedfeinput = 1.e-9_wp  ,         &
@@ -322,5 +322,5 @@
                CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout )
             ENDIF
- 
+
          ENDIF
 
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90	(revision 5841)
@@ -21,4 +21,5 @@
    USE trcopt_medusa
    USE trcsed_medusa
+   USE trcavg_medusa
 
 
@@ -46,4 +47,9 @@
       INTEGER, INTENT(in) :: kt   ! ocean time-step index
 
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_sms_medusa'
+         CALL flush(numout)
+# endif
+
       IF( kt == nittrc000 ) THEN
        IF(lwp) WRITE(numout,*)
@@ -52,5 +58,15 @@
       ENDIF
 
+      CALL trc_avg_medusa( kt )   ! rolling average module
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_avg_medusa'
+         CALL flush(numout)
+# endif
+
       CALL trc_opt_medusa( kt )   ! optical model
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_opt_medusa'
+         CALL flush(numout)
+# endif
 
 # if defined key_kill_medusa
@@ -60,6 +76,14 @@
 # else
       CALL trc_bio_medusa( kt )   ! biological model
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_bio_medusa'
+         CALL flush(numout)
+# endif
 
       CALL trc_sed_medusa( kt )   ! sedimentation model
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa'
+         CALL flush(numout)
+# endif
 # endif
 
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 5841)
@@ -8,4 +8,5 @@
    !!             1.0  !  2004-03  (C. Ethe) Free form and module
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
    USE par_kind          ! kind parameters
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5841)
@@ -11,4 +11,5 @@
    !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -56,5 +57,5 @@
       !! ** Method  : - read passive tracer namelist 
       !!              - read namelist of each defined SMS model
-      !!                ( (PISCES, CFC, MY_TRC )
+      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA )
       !!---------------------------------------------------------------------
       INTEGER  ::   jn, jk                     ! dummy loop indice
@@ -231,9 +232,22 @@
       ENDIF
       !
-# if defined key_debug_medusa
-      CALL flush(numout)
-      IF (lwp) write (numout,*) '------------------------------'
-      IF (lwp) write (numout,*) 'Jpalm - debug'
-      IF (lwp) write (numout,*) 'CALL trc_nam_pisces -- OK'
+
+      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
+      ENDIF
+
+      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
+      ENDIF
+
+      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
+      ENDIF
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_pisces - CFC - C14 - my_trc -- OK'
       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa'
       IF (lwp) write (numout,*) ' '
@@ -262,19 +276,7 @@
       IF (lwp) write (numout,*) 'Jpalm - debug'
       IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK'
-      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc'
-      IF (lwp) write (numout,*) ' '
-# endif
-      !
-      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
-      ENDIF
-
-      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
-      ENDIF
-
-      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
-      ENDIF
+      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam OK'
+      IF (lwp) write (numout,*) ' '
+# endif
       !
       IF(lwp)   CALL flush(numout)
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5841)
@@ -51,9 +51,9 @@
       !
       IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
-      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers
-      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer
       IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14
       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
+      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers
+      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer
 
       IF(ln_ctl) THEN      ! print mean trends (used for debugging)
Index: /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 5840)
+++ /branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 5841)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!              -   !  2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
 #if defined key_top && defined key_iomput
@@ -58,4 +59,7 @@
       ! ---------------------------------------
       IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES 
+      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
+      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
+      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
       !
 # if defined key_debug_medusa
@@ -81,7 +85,4 @@
       !!! JPALM
       !!! don't forget to add idtra 
-      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
-      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
-      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
