Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/air_sea.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/air_sea.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/air_sea.F90	(revision 9824)
@@ -0,0 +1,676 @@
+MODULE air_sea_mod
+   !!======================================================================
+   !!                         ***  MODULE air_sea_mod  ***
+   !! Calculate the carbon chemistry for the whole ocean
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Add air-sea flux kill switch
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   air_sea        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE air_sea( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE air_sea  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - calculate air-sea gas exchange
+      !!  - river inputs
+      !!----------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: f_riv_alk, f_riv_c, f_riv_n,           &
+                                   f_riv_si, f_runoff,                    & 
+                                   fgco2, zphn, zphd,                     &
+# if defined key_roam
+                                   dms_andr, dms_andr2d, dms_aran,        &
+                                   dms_aran2d, dms_hall, dms_hall2d,      &
+                                   dms_simo, dms_simo2d, dms_surf,        &
+                                   dms_surf2d, dms_andm, dms_andm2d,      &
+                                   dms_nlim, dms_wtkn,                    &
+                                   f_co2flux, f_co2flux2d,                &
+                                   f_co2starair_2d, f_co3,                &
+                                   f_dcf, f_fco2a_2d, f_fco2w_2d,         &
+                                   f_h2co3, f_hco3, f_henry,              &
+                                   f_kw660, f_kw6602d,                    &
+                                   f_o2flux, f_o2flux2d, f_o2sat,         &
+                                   f_o2sat2d, f_ocndpco2_2d,              &
+                                   f_ocnk0_2d, f_ocnkwco2_2d,             &
+                                   f_ocnrhosw_2d, f_ocnschco2_2d,         &
+                                   f_omarg, f_omcal,                      &
+                                   f_pco2a2d, f_pco2atm, f_pco2w,         &
+                                   f_pco2w2d, f_ph, f_pp0, f_pp02d,       &
+                                   f_TALK, f_TALK2d, f_TDIC, f_TDIC2d,    &
+                                   f_xco2a, f_xco2a_2d,                   &
+                                   zalk, zdic, zoxy, zsal, ztmp,          &
+# endif
+# if defined key_mocsy
+                                   zpho,                                  &
+# endif
+                                   zchd, zchn, zdin, zsil
+      USE dom_oce,           ONLY: e3t_0, e3t_n, gphit, tmask, mig, mjg
+# if defined key_iomput
+      USE iom,               ONLY: lk_iomput
+# endif
+      USE in_out_manager,    ONLY: lwp, numout
+      USE par_kind,          ONLY: wp
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1
+      USE sbc_oce,           ONLY: fr_i, qsr, wndm
+      USE sms_medusa,        ONLY: jdms, jdms_input, jdms_model,          &
+                                   jriver_alk, jriver_c,                  &
+                                   jriver_n, jriver_si,                   &
+                                   riv_alk, riv_c, riv_n, riv_si,         &
+                                   zn_dms_chd, zn_dms_chn, zn_dms_din,    &
+                                   zn_dms_mld, zn_dms_qsr,                &
+                                   xnln, xnld 
+      USE trc,               ONLY: med_diag
+      USE zdfmxl,            ONLY: hmld
+
+# if defined key_roam
+      USE gastransfer,       ONLY: gas_transfer
+#  if defined key_mocsy
+      USE mocsy_wrapper,     ONLY: mocsy_interface
+#  else
+      USE trcco2_medusa,     ONLY: trc_co2_medusa
+#  endif
+      USE trcdms_medusa,     ONLY: trc_dms_medusa
+      USE trcoxy_medusa,     ONLY: trc_oxy_medusa
+# endif
+      USE lib_mpp,           ONLY: ctl_stop
+      USE trcstat,           ONLY: trc_rst_dia_stat 
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) :: kt
+
+      !! Loop variables
+      INTEGER :: ji, jj
+
+# if defined key_roam
+      !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s
+      REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol
+      REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d
+      REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day
+
+      INTEGER :: iters
+
+      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
+      REAL(wp), DIMENSION(jpi,jpj) :: f_fco2w, f_rhosw
+      REAL(wp), DIMENSION(jpi,jpj) :: f_fco2atm
+      REAL(wp), DIMENSION(jpi,jpj) :: f_schmidtco2, f_kwco2, f_K0
+      REAL(wp), DIMENSION(jpi,jpj) :: f_co2starair, f_dpco2
+      !! Output arguments from mocsy_interface, which aren't used
+      REAL(wp) :: f_BetaD_dum, f_opres_dum
+      REAL(wp) :: f_insitut_dum
+      REAL(wp) :: f_kwo2_dum
+# endif
+
+
+# if defined key_roam
+      !! init
+      f_fco2w(:,:)       = 0.0
+      f_fco2atm(:,:)     = 0.0
+      f_schmidtco2(:,:)  = 0.0
+      f_kwco2(:,:)       = 0.0
+      f_co2starair(:,:)  = 0.0
+      f_dpco2(:,:)       = 0.0
+      f_rhosw(:,:)       = 0.0
+      f_K0(:,:)          = 0.0
+      !! air pressure (atm); ultimately this will use air 
+      !! pressure at the base of the UKESM1 atmosphere 
+      !!                                     
+      f_pp0(:,:)   = 1.0
+
+
+      !!-----------------------------------------------------------
+      !! Air-sea gas exchange
+      !!-----------------------------------------------------------
+
+#   if defined key_debug_medusa
+               IF (lwp) write (numout,*)                     & 
+               'air-sea: gas_transfer kt = ', kt
+               CALL flush(numout)
+#   endif
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            IF (tmask(ji,jj,1) == 1) then
+               !!
+               !! 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
+               !!
+               CALL gas_transfer( wndm(ji,jj), 1, 7,         &  ! inputs
+                                  f_kw660(ji,jj) )              ! outputs
+            ENDIF
+         ENDDO
+      ENDDO
+
+#   if defined key_debug_medusa
+               IF (lwp) write (numout,*)                     &
+               'air-sea: carb-chem kt = ', kt
+               CALL flush(numout)
+               !! JPALM add carb print:
+               call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a')
+               call trc_rst_dia_stat(wndm(:,:), 'wndm')
+               call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660')
+               call trc_rst_dia_stat(ztmp(:,:), 'ztmp')
+               call trc_rst_dia_stat(zsal(:,:), 'zsal')
+               call trc_rst_dia_stat(zalk(:,:), 'zalk')
+               call trc_rst_dia_stat(zdic(:,:), 'zdic')
+               call trc_rst_dia_stat(zsil(:,:), 'zsil')
+               call trc_rst_dia_stat(zpho(:,:), 'zpho')
+#   endif
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,1) == 1) then
+               !!
+#  if defined key_axy_carbchem
+#   if defined key_mocsy
+               !! Jpalm -- 12-09-2017 -- add extra check after reccurent
+               !!          carbonate failure in the coupled run.
+               !!          must be associated to air-sea flux or air xCO2...
+               !!          Check MOCSY inputs
+               IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR.        &
+                    (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR.      &
+                    (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR.     &
+                    (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR.     &
+                    (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN
+                  IF(lwp) THEN 
+                      WRITE(numout,*) ' surface T = ',ztmp(ji,jj)
+                      WRITE(numout,*) ' surface S = ',zsal(ji,jj)
+                      WRITE(numout,*) ' surface ALK = ',zalk(ji,jj)
+                      WRITE(numout,*) ' surface DIC = ',zdic(ji,jj)
+                      WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj)
+                      WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj)   
+                      WRITE(numout,*) ' surface pco2w  = ',f_pco2w(ji,jj)
+                      WRITE(numout,*) ' surface fco2w  = ',f_fco2w(ji,jj)
+                      WRITE(numout,*) ' surface fco2a  = ',f_fco2atm(ji,jj)
+                      WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj)
+                      WRITE(numout,*) ' surface dpco2  = ',f_dpco2(ji,jj)
+                      WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj),  &
+                                       ' kt = ', kt 
+                      WRITE(numout,*) 'MEDUSA - Air-Sea INPUT: unrealistic surface Carb. Chemistry'
+                  ENDIF     
+                  CALL ctl_stop( 'MEDUSA - Air-Sea INPUT: ',             &
+                                 'unrealistic surface Carb. Chemistry -- INPUTS' )
+               ENDIF     
+               !!
+               !! 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(ji,jj),zsal(ji,jj),zalk(ji,jj),     &
+                                    zdic(ji,jj),zsil(ji,jj),zpho(ji,jj),     &
+                                    f_pp0(ji,jj),0.0,                        &
+                                    gphit(ji,jj),f_kw660(ji,jj),             &
+                                    f_xco2a(ji,jj),1,f_ph(ji,jj),            &
+                                    f_pco2w(ji,jj),f_fco2w(ji,jj),           &
+                                    f_h2co3(ji,jj),f_hco3(ji,jj),            &
+                                    f_co3(ji,jj),f_omarg(ji,jj),             &
+                                    f_omcal(ji,jj),f_BetaD_dum,              &
+                                    f_rhosw(ji,jj),f_opres_dum,              &
+                                    f_insitut_dum,f_pco2atm(ji,jj),          &
+                                    f_fco2atm(ji,jj),f_schmidtco2(ji,jj),    &
+                                    f_kwco2(ji,jj),f_K0(ji,jj),              &
+                                    f_co2starair(ji,jj),f_co2flux(ji,jj),    &
+                                    f_dpco2(ji,jj))
+               !! mmol / m3 -> umol / kg
+               f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw(ji,jj)) * 1000.
+               !! meq / m3 ->  ueq / kg
+               f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000.
+               f_dcf(ji,jj)  = f_rhosw(ji,jj)
+               !! Jpalm -- 12-09-2017 -- add extra check after reccurent
+               !!          carbonate failure in the coupled run.
+               !!          must be associated to air-sea flux or air xCO2...
+               !!          Check MOCSY outputs
+               !!===================
+               !! Jpalm -- 19-02-2018 -- remove the cap - only check MOCSY inputs
+               !!       because of specific area in arabic sea where strangely
+               !!       with core 2 forcing, ALK is lower than DIC and result in 
+               !!       Enormous dpco2 - even if all carb chem caract are OK.
+               !!       and this check stops the model.
+               !!       --Input checks are already more than enough to stop the
+               !!       model if carb chem goes crazy. 
+               !!       we remove the mocsy output checks
+               !!===================
+               !!IF ( (f_pco2w(ji,jj) > 1.E4 ).OR.(f_pco2w(ji,jj) < 0.0 ) .OR.     &
+               !!    (f_fco2w(ji,jj) > 1.E4 ).OR.(f_fco2w(ji,jj) < 0.0 ) .OR.     &   
+               !!    (f_fco2atm(ji,jj) > 1.E4 ).OR.(f_fco2atm(ji,jj) < 0.0 ) .OR.     &
+               !!    (f_co2flux(ji,jj) > 1.E-1 ).OR.(f_co2flux(ji,jj) < -1.E-1 ) .OR.     &
+               !!    (f_dpco2(ji,jj) > 1.E4 ).OR.(f_dpco2(ji,jj) < -1.E4 ) ) THEN
+               !!  IF(lwp) THEN 
+               !!      WRITE(numout,*) ' surface T = ',ztmp(ji,jj)
+               !!      WRITE(numout,*) ' surface S = ',zsal(ji,jj)
+               !!      WRITE(numout,*) ' surface ALK = ',zalk(ji,jj)
+               !!      WRITE(numout,*) ' surface DIC = ',zdic(ji,jj)
+               !!      WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj)
+               !!      WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj)   
+               !!      WRITE(numout,*) ' surface pco2w  = ',f_pco2w(ji,jj)
+               !!      WRITE(numout,*) ' surface fco2w  = ',f_fco2w(ji,jj)
+               !!      WRITE(numout,*) ' surface fco2a  = ',f_fco2atm(ji,jj)
+               !!      WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj)
+               !!      WRITE(numout,*) ' surface dpco2  = ',f_dpco2(ji,jj)
+               !!      WRITE(numout,*) ' MOCSY output: ji =', mig(ji),' jj = ', mjg(jj),  &
+               !!                        ' kt = ', kt     
+               !!      WRITE(numout,*) 'MEDUSA - Air-Sea OUTPUT: unrealistic surface Carb. Chemistry'
+               !!  ENDIF     
+               !!  CALL ctl_stop( 'MEDUSA - Air-Sea OUTPUT: ',            &
+               !!                 'unrealistic surface Carb. Chemistry -- OUTPUTS' )
+               !!ENDIF     
+            ENDIF
+         ENDDO
+      ENDDO
+
+#   if defined key_debug_medusa
+               !! JPALM add carb print:
+               call trc_rst_dia_stat(f_pco2w(:,:), 'f_pco2w')
+               call trc_rst_dia_stat(f_fco2w(:,:), 'f_fco2w')
+               call trc_rst_dia_stat(f_fco2atm(:,:), 'f_fco2atm')
+               call trc_rst_dia_stat(f_schmidtco2(:,:), 'f_schmidtco2')
+               call trc_rst_dia_stat(f_kwco2(:,:), 'f_kwco2')
+               call trc_rst_dia_stat(f_co2starair(:,:), 'f_co2starair')
+               call trc_rst_dia_stat(f_co2flux(:,:), 'f_co2flux')
+               call trc_rst_dia_stat(f_dpco2(:,:), 'f_dpco2')
+#   endif
+#   else   
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,1) == 1) then     
+               iters = 0
+               !!
+               !! carbon dioxide (CO2); Jerry Blackford code (ostensibly 
+               !! OCMIP-2, but not)
+               CALL trc_co2_medusa(ztmp(ji,jj),zsal(ji,jj),zdic(ji,jj),      &
+                                   zalk(ji,jj),0.0,                          &
+                                   f_kw660(ji,jj),f_xco2a(ji,jj),            &
+                                   f_ph(ji,jj),                              &
+                                   f_pco2w(ji,jj),f_h2co3(ji,jj),            &
+                                   f_hco3(ji,jj),f_co3(ji,jj),               &
+                                   f_omcal(ji,jj),f_omarg(ji,jj),            &
+                                   f_co2flux(ji,jj),f_TDIC(ji,jj),           &
+                                   f_TALK(ji,jj),f_dcf(ji,jj),               &
+                                   f_henry(ji,jj),iters)
+               !!
+               !! AXY (09/01/14): removed iteration and NaN checks; these have
+               !!                 been moved to trc_co2_medusa together with a
+               !!                 fudge that amends erroneous values (this is
+               !!                 intended to be a temporary fudge!); the
+               !!                 output warnings are retained here so that
+               !!                 failure position can be determined
+               if (iters .eq. 25) then
+                  IF(lwp) WRITE(numout,*) 'air-sea: ITERS WARNING, ',       &
+                     iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+#   endif
+#  else
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,1) == 1) then
+               !! AXY (18/04/13): switch off carbonate chemistry 
+               !!                 calculations; provide quasi-sensible 
+               !!                 alternatives
+               f_ph(ji,jj)           = 8.1
+               f_pco2w(ji,jj)        = f_xco2a(ji,jj)
+               f_h2co3(ji,jj)        = 0.005 * zdic(ji,jj)
+               f_hco3(ji,jj)         = 0.865 * zdic(ji,jj)
+               f_co3(ji,jj)          = 0.130 * zdic(ji,jj)
+               f_omcal(ji,jj) = 4.
+               f_omarg(ji,jj) = 2.
+               f_co2flux(ji,jj)      = 0.
+               f_TDIC(ji,jj)         = zdic(ji,jj)
+               f_TALK(ji,jj)         = zalk(ji,jj)
+               f_dcf(ji,jj)          = 1.026
+               f_henry(ji,jj)        = 1.
+               !! AXY (23/06/15): add in some extra MOCSY diagnostics
+               f_fco2w(ji,jj)        = f_xco2a(ji,jj)
+! This doesn't seem to be used - marc 16/5/17
+!               f_BetaD(ji,jj)        = 1.
+               f_rhosw(ji,jj)        = 1.026
+! This doesn't seem to be used - marc 16/5/17
+!               f_opres(ji,jj)        = 0.
+!               f_insitut(ji,jj)      = ztmp(ji,jj)
+               f_pco2atm(ji,jj)      = f_xco2a(ji,jj)
+               f_fco2atm(ji,jj)      = f_xco2a(ji,jj)
+               f_schmidtco2(ji,jj)   = 660.
+               f_kwco2(ji,jj)        = 0.
+               f_K0(ji,jj)           = 0.
+               f_co2starair(ji,jj)   = f_xco2a(ji,jj)
+               f_dpco2(ji,jj)        = 0.
+            ENDIF
+         ENDDO
+      ENDDO
+#  endif
+
+#  if defined key_axy_killco2flux
+      !! AXY (18/08/17): single kill switch on air-sea CO2 flux for budget checking
+      f_co2flux(:,:) = 0.
+#  endif
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,1) == 1) then
+               !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide 
+               !! through by layer thickness
+               f_co2flux(ji,jj) = (1. - fr_i(ji,jj)) * f_co2flux(ji,jj) *    &
+                                  86400. / fse3t(ji,jj,1)
+               !!
+               !! oxygen (O2); OCMIP-2 code
+               !! AXY (23/06/15): amend input list for oxygen to account 
+               !!                 for common gas transfer velocity
+               CALL trc_oxy_medusa(ztmp(ji,jj),zsal(ji,jj),f_kw660(ji,jj),   &
+                                   f_pp0(ji,jj),zoxy(ji,jj),                 &
+                                   f_kwo2_dum,f_o2flux(ji,jj),               &
+                                   f_o2sat(ji,jj))
+               !!
+               !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide 
+               !! through by layer thickness
+               f_o2flux(ji,jj)  = (1. - fr_i(ji,jj)) * f_o2flux(ji,jj) *     &
+                                  86400. / fse3t(ji,jj,1)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !! Jpalm (08-2014)
+      !! DMS surface concentration calculation
+      !! initialy added for UKESM1 model.
+      !! using MET-OFFICE subroutine.
+      !! DMS module only needs Chl concentration and MLD
+      !! to get an aproximate value of DMS concentration.
+      !! air-sea fluxes are calculated by atmospheric chemitry model
+      !! from atm and oc-surface concentrations.
+      !!
+      !! AXY (13/03/15): this is amended to calculate all of the DMS
+      !!                 estimates examined during UKESM1 (see
+      !!                 comments in trcdms_medusa.F90)
+      !!
+      !! AXY (25/05/17): amended to additionally pass DIN limitation as well as [DIN]; 
+      !!                 accounts for differences in nutrient half-saturations; changes 
+      !!                 also made in trc_dms_medusa; this permits an additional DMS 
+      !!                 calculation while retaining the existing Anderson one 
+      !! 
+      IF (jdms == 1) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,1) == 1) then
+                  !! calculate weighted half-saturation for DIN uptake
+                  dms_wtkn(ji,jj) = ((zphn(ji,jj) * xnln) +            &
+                                     (zphd(ji,jj) * xnld)) /           &
+                                     (zphn(ji,jj) + zphd(ji,jj))        
+                  !!
+                  !! feed in correct inputs
+                  if (jdms_input .eq. 0) then
+                     !! use instantaneous inputs
+                     dms_nlim(ji,jj) = zdin(ji,jj) / (zdin(ji,jj) + dms_wtkn(ji,jj))
+                     !!
+                     CALL trc_dms_medusa(zchn(ji,jj),zchd(ji,jj),             &
+                                         hmld(ji,jj),qsr(ji,jj),              &
+                                         zdin(ji,jj), dms_nlim(ji,jj),        &
+                                         dms_andr,dms_simo,dms_aran,dms_hall, & 
+                                         dms_andm)
+                  else
+                     !! use diel-average inputs
+                     dms_nlim(ji,jj) = zn_dms_din(ji,jj) /                    &
+                                      (zn_dms_din(ji,jj) + dms_wtkn(ji,jj))
+                     !!
+                     CALL trc_dms_medusa(zn_dms_chn(ji,jj),zn_dms_chd(ji,jj), &
+                                         zn_dms_mld(ji,jj),zn_dms_qsr(ji,jj), &
+                                         zn_dms_din(ji,jj),dms_nlim(ji,jj),   &
+                                         dms_andr,dms_simo,dms_aran,dms_hall, & 
+                                         dms_andm)
+                  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
+                  elseif (jdms_model .eq. 5) then
+                     dms_surf = dms_andm
+                  endif
+                  !!
+                  !! 2D diag through iom_use
+                  IF( med_diag%DMS_SURF%dgsave ) THEN
+                     dms_surf2d(ji,jj) = dms_surf
+                  ENDIF
+                  IF( med_diag%DMS_ANDR%dgsave ) THEN
+                     dms_andr2d(ji,jj) = dms_andr
+                  ENDIF
+                  IF( med_diag%DMS_SIMO%dgsave ) THEN
+                     dms_simo2d(ji,jj) = dms_simo
+                  ENDIF
+                  IF( med_diag%DMS_ARAN%dgsave ) THEN
+                     dms_aran2d(ji,jj) = dms_aran
+                  ENDIF
+                  IF( med_diag%DMS_HALL%dgsave ) THEN
+                     dms_hall2d(ji,jj) = dms_hall
+                  ENDIF 
+                  IF( med_diag%DMS_ANDM%dgsave ) THEN 
+                     dms_andm2d(ji,jj) = dms_andm
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+#   if defined key_debug_medusa
+         IF (lwp) write (numout,*)                                &
+            'air-sea: finish calculating dms kt = ',kt
+            CALL flush(numout)
+#   endif 
+      ENDIF                  !! End IF (jdms == 1)
+
+      !!
+      !! store 2D outputs
+      !!
+      !! JPALM -- 17-11-16 -- put fgco2 out of diag request
+      !!       is needed for coupling; pass through restart
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,1) == 1) then
+               !! IF( med_diag%FGCO2%dgsave ) THEN
+               !! convert from  mol/m2/day to kg/m2/s
+               !! mmol-C/m3/d -> kg-CO2/m2/s
+               fgco2(ji,jj) = f_co2flux(ji,jj) * fse3t(ji,jj,1) *             &
+                              CO2flux_conv
+               !! ENDIF
+               IF ( lk_iomput ) THEN
+                  IF( med_diag%ATM_PCO2%dgsave ) THEN
+                     f_pco2a2d(ji,jj) = f_pco2atm(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_PCO2%dgsave ) THEN
+                     f_pco2w2d(ji,jj) = f_pco2w(ji,jj)
+                  ENDIF
+                  IF( med_diag%CO2FLUX%dgsave ) THEN
+                     !! mmol/m3/d -> mmol/m2/d
+                     f_co2flux2d(ji,jj) = f_co2flux(ji,jj) * fse3t(ji,jj,1)
+                  ENDIF
+                  IF( med_diag%TCO2%dgsave ) THEN
+                     f_TDIC2d(ji,jj) = f_TDIC(ji,jj)
+                  ENDIF
+                  IF( med_diag%TALK%dgsave ) THEN
+                     f_TALK2d(ji,jj) = f_TALK(ji,jj)
+                  ENDIF
+                  IF( med_diag%KW660%dgsave ) THEN
+                      f_kw6602d(ji,jj) = f_kw660(ji,jj)
+                  ENDIF
+                  IF( med_diag%ATM_PP0%dgsave ) THEN
+                      f_pp02d(ji,jj) = f_pp0(ji,jj)
+                  ENDIF
+                  IF( med_diag%O2FLUX%dgsave ) THEN
+                     f_o2flux2d(ji,jj) = f_o2flux(ji,jj)
+                  ENDIF
+                  IF( med_diag%O2SAT%dgsave ) THEN
+                     f_o2sat2d(ji,jj) = f_o2sat(ji,jj)
+                  ENDIF
+                  !! AXY (24/11/16): add in extra MOCSY diagnostics
+                  IF( med_diag%ATM_XCO2%dgsave ) THEN
+                     f_xco2a_2d(ji,jj) = f_xco2a(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_FCO2%dgsave ) THEN
+                     f_fco2w_2d(ji,jj) = f_fco2w(ji,jj)
+                  ENDIF
+                  IF( med_diag%ATM_FCO2%dgsave ) THEN
+                     f_fco2a_2d(ji,jj) = f_fco2atm(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_RHOSW%dgsave ) THEN
+                     f_ocnrhosw_2d(ji,jj) = f_rhosw(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+                     f_ocnschco2_2d(ji,jj) = f_schmidtco2(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_KWCO2%dgsave ) THEN
+                     f_ocnkwco2_2d(ji,jj) = f_kwco2(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_K0%dgsave ) THEN
+                     f_ocnk0_2d(ji,jj) = f_K0(ji,jj)
+                  ENDIF
+                  IF( med_diag%CO2STARAIR%dgsave ) THEN
+                     f_co2starair_2d(ji,jj) = f_co2starair(ji,jj)
+                  ENDIF
+                  IF( med_diag%OCN_DPCO2%dgsave ) THEN
+                     f_ocndpco2_2d(ji,jj) = f_dpco2(ji,jj)
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+# endif
+
+      !!-----------------------------------------------------------------
+      !! River inputs
+      !!-----------------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,1) == 1) then
+               !!
+               !! runoff comes in as        kg / m2 / s
+               !! used and written out as   m3 / m2 / d (= m / d)
+               !! where                     1000 kg / m2 / d = 
+               !!                             1 m3 / m2 / d = 1 m / d
+               !!
+               !! AXY (17/07/14): the compiler doesn't like this line for 
+               !!                 some reason; as MEDUSA doesn't even use 
+               !!                 runoff for riverine inputs, a temporary 
+               !!                 solution is to switch off runoff entirely
+               !!                 here; again, this change is one of several 
+               !!                 that will need revisiting once MEDUSA has 
+               !!                 bedded down in UKESM1; particularly so if 
+               !!                 the land scheme provides information
+               !!                 concerning nutrient fluxes
+               !!
+               !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. *   &
+               !!                   60. * 24.
+               f_runoff(ji,jj) = 0.0
+               !!
+               !! nutrients are added via rivers to the model in one of 
+               !! two ways:
+               !!   1. via river concentration; i.e. the average nutrient 
+               !!      concentration of a river water is described by a 
+               !!      spatial file, and this is multiplied by runoff to 
+               !!      give a nutrient flux
+               !!   2. via direct river flux; i.e. the average nutrient 
+               !!      flux due to rivers is described by a spatial file, 
+               !!      and this is simply applied as a direct nutrient 
+               !!      flux (i.e. it does not relate or respond to model 
+               !!      runoff) nutrient fields are derived from the 
+               !!      GlobalNEWS 2 database; carbon and 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 block of code is still 
+               !! executed, however, to set up the total amounts of 
+               !! nutrient entering via rivers
+               !!
+               !! nitrogen
+               if (jriver_n .eq. 1) then
+                  !! river concentration specified; use runoff to 
+                  !! calculate input
+                  f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj)
+               elseif (jriver_n .eq. 2) then
+                  !! river flux specified; independent of runoff
+                  f_riv_n(ji,jj) = riv_n(ji,jj)
+               endif
+               !!
+               !! silicon
+               if (jriver_si .eq. 1) then
+                  !! river concentration specified; use runoff to 
+                  !! calculate input
+                  f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj)
+               elseif (jriver_si .eq. 2) then
+                  !! river flux specified; independent of runoff
+                  f_riv_si(ji,jj) = riv_si(ji,jj)
+               endif
+               !!
+               !! carbon
+               if (jriver_c .eq. 1) then
+                  !! river concentration specified; use runoff to 
+                  !! calculate input
+                  f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj)
+               elseif (jriver_c .eq. 2) then
+                  !! river flux specified; independent of runoff
+                  f_riv_c(ji,jj) = riv_c(ji,jj)
+               endif
+               !!
+               !! alkalinity
+               if (jriver_alk .eq. 1) then
+                  !! river concentration specified; use runoff to 
+                  !! calculate input
+                  f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj)
+               elseif (jriver_alk .eq. 2) then
+                  !! river flux specified; independent of runoff
+                  f_riv_alk(ji,jj) = riv_alk(ji,jj)
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE air_sea
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE air_sea( )                    ! Empty routine
+      WRITE(*,*) 'air_sea: You should not have seen this print! error?'
+   END SUBROUTINE air_sea
+#endif 
+
+   !!======================================================================
+END MODULE air_sea_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_med_diag_iomput.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_med_diag_iomput.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_med_diag_iomput.F90	(revision 9824)
@@ -0,0 +1,725 @@
+MODULE bio_med_diag_iomput_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_med_diag_iomput_mod  ***
+   !! Calculates diagnostics
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_med_diag_iomput        ! Called in bio_medusa_diag.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_med_diag_iomput( jk )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_med_diag_iomput  ***
+      !! Calculates the diagnostics used with iom_put
+      !!-------------------------------------------------------------------
+      USE bio_medusa_mod
+      USE dom_oce,           ONLY: e3t_0, e3t_n, mbathy, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+      USE par_oce,           ONLY: jpim1, jpjm1
+      USE phycst,            ONLY: rsmall
+      USE sms_medusa,        ONLY: f3_omarg, f3_omcal,                   &
+                                   i0100, i0500, i1000,                  &
+                                   xbetac, xbetan, xphi,                 &
+                                   xthetapd, xthetapn, xthetazmi
+      USE trc,               ONLY: med_diag
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! level
+      INTEGER, INTENT( in ) :: jk
+
+      !! Loop avariables
+      INTEGER :: ji, jj, jn
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!-------------------------------------------------------
+               !! Add in XML diagnostics stuff
+               !!-------------------------------------------------------
+               !!
+               !! ** 2D diagnostics
+#   if defined key_debug_medusa
+               IF (lwp) write (numout,*)                                     &
+                  'bio_med_diag_iomput: in ij-jj loop jk = ', jk
+               CALL flush(numout)
+#   endif
+               IF ( med_diag%PRN%dgsave ) THEN
+                   fprn2d(ji,jj) = fprn2d(ji,jj) +                           &
+                                   (fprn(ji,jj)  * zphn(ji,jj) *             &
+                                    fse3t(ji,jj,jk)) 
+               ENDIF
+               IF ( med_diag%MPN%dgsave ) THEN
+                   fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn(ji,jj) *            &
+                                                    fse3t(ji,jj,jk))
+               ENDIF
+               IF ( med_diag%PRD%dgsave ) THEN
+                   fprd2d(ji,jj) = fprd2d(ji,jj) +                           &
+                                   (fprd(ji,jj)  * zphd(ji,jj) *             &
+                                    fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%MPD%dgsave ) THEN
+                   fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd(ji,jj) *            &
+                                                    fse3t(ji,jj,jk)) 
+               ENDIF
+               !  IF( med_diag%DSED%dgsave ) THEN
+               !      CALL iom_put( "DSED"  , ftot_n )
+               !  ENDIF
+               IF( med_diag%OPAL%dgsave ) THEN
+                   fprds2d(ji,jj) = fprds2d(ji,jj) +                         &
+                                    (fprds(ji,jj) * zpds(ji,jj) *            &
+                                     fse3t(ji,jj,jk)) 
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%OPALDISS%dgsave ) THEN
+                   fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss(ji,jj) *      &
+                                                        fse3t(ji,jj,jk))  
+               ENDIF
+               IF( med_diag%GMIPn%dgsave ) THEN
+                   fgmipn2d(ji,jj) = fgmipn2d(ji,jj) +                       &
+                                     (fgmipn(ji,jj)  * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%GMID%dgsave ) THEN
+                   fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid(ji,jj) *         &
+                                                      fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%MZMI%dgsave ) THEN
+                   fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi(ji,jj) *         &
+                                                      fse3t(ji,jj,jk)) 
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%GMEPN%dgsave ) THEN
+                   fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn(ji,jj) *      &
+                                                        fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%GMEPD%dgsave ) THEN
+                   fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd(ji,jj) *      &
+                                                        fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%GMEZMI%dgsave ) THEN
+                   fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) +                     &
+                                      (fgmezmi(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%GMED%dgsave ) THEN
+                   fgmed2d(ji,jj) = fgmed2d(ji,jj) +                         &
+                                       (fgmed(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%MZME%dgsave ) THEN
+                  fdzme2d(ji,jj) = fdzme2d(ji,jj) +                          &
+                                    (fdzme(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               !  IF( med_diag%DEXP%dgsave ) THEN
+               !      CALL iom_put( "DEXP"  , ftot_n )
+               !  ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%DETN%dgsave ) THEN
+                  fslown2d(ji,jj) = fslown2d(ji,jj) +                        &
+                                    (fslown(ji,jj) * fse3t(ji,jj,jk))  
+               ENDIF
+               IF( med_diag%MDET%dgsave ) THEN
+                  fdd2d(ji,jj) = fdd2d(ji,jj) +                              &
+                                 (fdd(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%AEOLIAN%dgsave ) THEN
+                  ffetop2d(ji,jj) = ffetop2d(ji,jj) +                        &
+                                    (ffetop(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%BENTHIC%dgsave ) THEN
+                  ffebot2d(ji,jj) = ffebot2d(ji,jj) +                        &
+                                    (ffebot(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%SCAVENGE%dgsave ) THEN
+                  ffescav2d(ji,jj) = ffescav2d(ji,jj) +                      &
+                                     (ffescav(ji,jj) * fse3t(ji,jj,jk))  
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%PN_JLIM%dgsave ) THEN
+                  ! fjln2d(ji,jj) = fjln2d(ji,jj) +                          &
+                  !                 (fjln(ji,jj)  * zphn(ji,jj) *            &
+                  !                  fse3t(ji,jj,jk)) 
+                  fjln2d(ji,jj) = fjln2d(ji,jj) +                            &
+                                  (fjlim_pn(ji,jj) * zphn(ji,jj) *           &
+                                   fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PN_NLIM%dgsave ) THEN
+                  fnln2d(ji,jj) = fnln2d(ji,jj) +                            &
+                                  (fnln(ji,jj) * zphn(ji,jj) *               &
+                                   fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PN_FELIM%dgsave ) THEN
+                  ffln2d(ji,jj) = ffln2d(ji,jj) +                            &
+                                  (ffln2(ji,jj) * zphn(ji,jj) *              &
+                                   fse3t(ji,jj,jk)) 
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%PD_JLIM%dgsave ) THEN
+                   ! fjld2d(ji,jj) = fjld2d(ji,jj) +                          &
+                   !                 (fjld(ji,jj)  * zphd(ji,jj) *            &
+                   !                  fse3t(ji,jj,jk)) 
+                   fjld2d(ji,jj) = fjld2d(ji,jj) +                           &
+                                   (fjlim_pd(ji,jj) * zphd(ji,jj) *          &
+                                    fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PD_NLIM%dgsave ) THEN
+                   fnld2d(ji,jj) = fnld2d(ji,jj) +                           &
+                                   (fnld(ji,jj) * zphd(ji,jj) *              &
+                                    fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PD_FELIM%dgsave ) THEN
+                   ffld2d(ji,jj) = ffld2d(ji,jj) +                           &
+                                   (ffld(ji,jj) * zphd(ji,jj) *              &
+                                    fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PD_SILIM%dgsave ) THEN
+                   fsld2d2(ji,jj) = fsld2d2(ji,jj) +                         &
+                                    (fsld2(ji,jj) * zphd(ji,jj) *            &
+                                     fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%PDSILIM2%dgsave ) THEN
+                   fsld2d(ji,jj) = fsld2d(ji,jj) +                           &
+                                   (fsld(ji,jj) * zphd(ji,jj) *              &
+                                    fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !! 
+               IF( med_diag%TOTREG_N%dgsave ) THEN
+                  fregen2d(ji,jj) = fregen2d(ji,jj) + fregen(ji,jj)
+               ENDIF
+               IF( med_diag%TOTRG_SI%dgsave ) THEN
+                  fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !! 
+               IF( med_diag%FASTN%dgsave ) THEN
+                   ftempn2d(ji,jj) = ftempn2d(ji,jj) +                       &
+                                     (ftempn(ji,jj)  * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FASTSI%dgsave ) THEN
+                   ftempsi2d(ji,jj) = ftempsi2d(ji,jj) +                     &
+                                      (ftempsi(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FASTFE%dgsave ) THEN
+                   ftempfe2d(ji,jj) = ftempfe2d(ji,jj) +                     &
+                                      (ftempfe(ji,jj) * fse3t(ji,jj,jk))  
+               ENDIF
+               IF( med_diag%FASTC%dgsave ) THEN
+                   ftempc2d(ji,jj) = ftempc2d(ji,jj) +                       &
+                                     (ftempc(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FASTCA%dgsave ) THEN
+                   ftempca2d(ji,jj) = ftempca2d(ji,jj) +                     &
+                                      (ftempca(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !! 
+               IF( med_diag%REMINN%dgsave ) THEN
+                   freminn2d(ji,jj) = freminn2d(ji,jj) +                     &
+                                      (freminn(ji,jj)  * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%REMINSI%dgsave ) THEN
+                   freminsi2d(ji,jj) = freminsi2d(ji,jj) +                   &
+                                       (freminsi(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%REMINFE%dgsave ) THEN
+                   freminfe2d(ji,jj) = freminfe2d(ji,jj) +                   &
+                                       (freminfe(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%REMINC%dgsave ) THEN
+                   freminc2d(ji,jj) = freminc2d(ji,jj) +                     &
+                                      (freminc(ji,jj)  * fse3t(ji,jj,jk)) 
+               ENDIF
+               IF( med_diag%REMINCA%dgsave ) THEN
+                   freminca2d(ji,jj) = freminca2d(ji,jj) +                   &
+                                       (freminca(ji,jj) * fse3t(ji,jj,jk)) 
+               ENDIF
+               !!
+            ENDIF
+         ENDDO
+      ENDDO
+
+# if defined key_roam
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               !! AXY (09/11/16): CMIP6 diagnostics
+               IF( med_diag%FD_NIT3%dgsave ) THEN
+                  fd_nit3(ji,jj,jk) = ffastn(ji,jj)
+               ENDIF
+               IF( med_diag%FD_SIL3%dgsave ) THEN
+                  fd_sil3(ji,jj,jk) = ffastsi(ji,jj)
+               ENDIF
+               IF( med_diag%FD_CAR3%dgsave ) THEN
+                  fd_car3(ji,jj,jk) = ffastc(ji,jj)
+               ENDIF
+               IF( med_diag%FD_CAL3%dgsave ) THEN
+                  fd_cal3(ji,jj,jk) = ffastca(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      IF (jk.eq.i0100) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  IF( med_diag%RR_0100%dgsave ) THEN
+                     ffastca2d(ji,jj) =                                      &
+                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE IF (jk.eq.i0500) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  IF( med_diag%RR_0500%dgsave ) THEN
+                     ffastca2d(ji,jj) =                                      &
+                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE IF (jk.eq.i1000) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  IF( med_diag%RR_1000%dgsave ) THEN
+                     ffastca2d(ji,jj) =                                      &
+                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (jk.eq.mbathy(ji,jj)) THEN
+                  IF (tmask(ji,jj,jk) == 1) THEN
+                     IF( med_diag%IBEN_N%dgsave ) THEN
+                        iben_n2d(ji,jj) = f_sbenin_n(ji,jj) +                &
+                                          f_fbenin_n(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_FE%dgsave ) THEN
+                        iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) +              &
+                                           f_fbenin_fe(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_C%dgsave ) THEN
+                        iben_c2d(ji,jj) = f_sbenin_c(ji,jj) +                &
+                                          f_fbenin_c(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_SI%dgsave ) THEN
+                        iben_si2d(ji,jj) = f_fbenin_si(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_CA%dgsave ) THEN
+                        iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_N%dgsave ) THEN
+                        oben_n2d(ji,jj) = f_benout_n(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_FE%dgsave ) THEN
+                        oben_fe2d(ji,jj) = f_benout_fe(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_C%dgsave ) THEN
+                        oben_c2d(ji,jj) = f_benout_c(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_SI%dgsave ) THEN
+                        oben_si2d(ji,jj) = f_benout_si(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_CA%dgsave ) THEN
+                        oben_ca2d(ji,jj) = f_benout_ca(ji,jj)
+                     ENDIF
+                     IF( med_diag%SFR_OCAL%dgsave ) THEN
+                        sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk)
+                     ENDIF
+                     IF( med_diag%SFR_OARG%dgsave ) THEN
+                        sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk)
+                     ENDIF
+                     IF( med_diag%LYSO_CA%dgsave ) THEN
+                        lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj)
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+      !! end bathy-1 diags
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               IF( med_diag%RIV_N%dgsave ) THEN
+                  rivn2d(ji,jj) = rivn2d(ji,jj) +                            &
+                                  (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%RIV_SI%dgsave ) THEN
+                  rivsi2d(ji,jj) = rivsi2d(ji,jj) +                          &
+                                   (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%RIV_C%dgsave ) THEN
+                  rivc2d(ji,jj) = rivc2d(ji,jj) +                            &
+                                  (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%RIV_ALK%dgsave ) THEN
+                  rivalk2d(ji,jj) = rivalk2d(ji,jj) +                        &
+                                    (f_riv_loc_alk(ji,jj) *                  &
+                                     fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%DETC%dgsave ) THEN
+                  fslowc2d(ji,jj) = fslowc2d(ji,jj) +                        &
+                                    (fslowc(ji,jj)  * fse3t(ji,jj,jk))   
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               IF( med_diag%PN_LLOSS%dgsave ) THEN
+                  fdpn22d(ji,jj) = fdpn22d(ji,jj) +                          &
+                                   (fdpn2(ji,jj)  * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%PD_LLOSS%dgsave ) THEN
+                  fdpd22d(ji,jj) = fdpd22d(ji,jj) +                          &
+                                   (fdpd2(ji,jj)  * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%ZI_LLOSS%dgsave ) THEN
+                  fdzmi22d(ji,jj) = fdzmi22d(ji,jj) +                        &
+                                    (fdzmi2(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_LLOSS%dgsave ) THEN
+                  fdzme22d(ji,jj) = fdzme22d(ji,jj) +                        &
+                                    (fdzme2(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%ZI_MES_N%dgsave ) THEN
+                  zimesn2d(ji,jj) = zimesn2d(ji,jj) +                        &
+                                    (xphi * (fgmipn(ji,jj) +                 &
+                                             fgmid(ji,jj)) *                 &
+                                     fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_MES_D%dgsave ) THEN
+                  zimesd2d(ji,jj) = zimesd2d(ji,jj) +                        & 
+                                    ((1. - xbetan) * finmi(ji,jj) *          &
+                                     fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_MES_C%dgsave ) THEN
+                  zimesc2d(ji,jj) = zimesc2d(ji,jj) +                        &
+                                    (xphi * ((xthetapn * fgmipn(ji,jj)) +    &
+                                             fgmidc(ji,jj)) *                &
+                                             fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_MESDC%dgsave ) THEN
+                  zimesdc2d(ji,jj) = zimesdc2d(ji,jj) +                      &
+                                     ((1. - xbetac) * ficmi(ji,jj) *         &
+                                      fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_EXCR%dgsave ) THEN
+                  ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +                        &
+                                    (fmiexcr(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_RESP%dgsave ) THEN
+                  ziresp2d(ji,jj) = ziresp2d(ji,jj) +                        &
+                                    (fmiresp(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZI_GROW%dgsave ) THEN
+                  zigrow2d(ji,jj) = zigrow2d(ji,jj) +                        &
+                                    (fmigrow(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               IF( med_diag%ZE_MES_N%dgsave ) THEN
+                  zemesn2d(ji,jj) = zemesn2d(ji,jj) +                        &
+                                    (xphi *                                  &
+                                     (fgmepn(ji,jj) + fgmepd(ji,jj) +        &
+                                      fgmezmi(ji,jj) + fgmed(ji,jj)) *       &
+                                     fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_MES_D%dgsave ) THEN
+                  zemesd2d(ji,jj) = zemesd2d(ji,jj) +                        &
+                                    ((1. - xbetan) * finme(ji,jj) *          &
+                                     fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_MES_C%dgsave ) THEN
+                  zemesc2d(ji,jj) = zemesc2d(ji,jj) +                        & 
+                                    (xphi *                                  &
+                                     ((xthetapn * fgmepn(ji,jj)) +           &
+                                      (xthetapd * fgmepd(ji,jj)) +           &
+                                      (xthetazmi * fgmezmi(ji,jj)) +         &
+                                      fgmedc(ji,jj)) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_MESDC%dgsave ) THEN
+                  zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +                      &
+                                     ((1. - xbetac) * ficme(ji,jj) *         &
+                                      fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_EXCR%dgsave ) THEN
+                  zeexcr2d(ji,jj) = zeexcr2d(ji,jj) +                        &
+                                    (fmeexcr(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_RESP%dgsave ) THEN
+                  zeresp2d(ji,jj) = zeresp2d(ji,jj) +                        &
+                                    (fmeresp(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%ZE_GROW%dgsave ) THEN
+                  zegrow2d(ji,jj) = zegrow2d(ji,jj) +                        &
+                                    (fmegrow(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+              IF( med_diag%MDETC%dgsave ) THEN
+                  mdetc2d(ji,jj) = mdetc2d(ji,jj) +                          &
+                                   (fddc(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%GMIDC%dgsave ) THEN
+                  gmidc2d(ji,jj) = gmidc2d(ji,jj) +                          &
+                                   (fgmidc(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%GMEDC%dgsave ) THEN
+                  gmedc2d(ji,jj) = gmedc2d(ji,jj) +                          &
+                                   (fgmedc(ji,jj) * fse3t(ji,jj,jk))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+# endif                   
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               !! ** 3D diagnostics
+               IF( med_diag%TPP3%dgsave ) THEN
+                  tpp3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) +            &
+                                    (fprd(ji,jj) * zphd(ji,jj))
+                  !CALL iom_put( "TPP3"  , tpp3d )
+               ENDIF
+               IF( med_diag%TPPD3%dgsave ) THEN
+                  tppd3(ji,jj,jk) = (fprd(ji,jj) * zphd(ji,jj))
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+                  
+               IF( med_diag%REMIN3N%dgsave ) THEN
+                  !! remineralisation
+                  remin3dn(ji,jj,jk) = fregen(ji,jj) +                       &
+                                       (freminn(ji,jj) * fse3t(ji,jj,jk))
+                  !CALL iom_put( "REMIN3N"  , remin3dn )
+               ENDIF
+               !! IF( med_diag%PH3%dgsave ) THEN
+               !!     CALL iom_put( "PH3"  , f3_pH )
+               !! ENDIF
+               !! IF( med_diag%OM_CAL3%dgsave ) THEN
+               !!     CALL iom_put( "OM_CAL3"  , f3_omcal )
+               !! ENDIF
+	       !! 
+	       !! AXY (09/11/16): CMIP6 diagnostics
+	       IF ( med_diag%DCALC3%dgsave   ) THEN
+                  dcalc3(ji,jj,jk) = freminca(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+	       IF ( med_diag%FEDISS3%dgsave  ) THEN
+                  fediss3(ji,jj,jk) = ffetop(ji,jj)
+               ENDIF
+	       IF ( med_diag%FESCAV3%dgsave  ) THEN
+                  fescav3(ji,jj,jk) = ffescav(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+	       IF ( med_diag%MIGRAZP3%dgsave ) THEN
+                  migrazp3(ji,jj,jk) = fgmipn(ji,jj) * xthetapn
+               ENDIF
+	       IF ( med_diag%MIGRAZD3%dgsave ) THEN
+                  migrazd3(ji,jj,jk) = fgmidc(ji,jj)
+               ENDIF
+	       IF ( med_diag%MEGRAZP3%dgsave ) THEN
+                  megrazp3(ji,jj,jk) = (fgmepn(ji,jj) * xthetapn) +          &
+                                       (fgmepd(ji,jj) * xthetapd)
+               ENDIF
+	       IF ( med_diag%MEGRAZD3%dgsave ) THEN
+                  megrazd3(ji,jj,jk) = fgmedc(ji,jj)
+               ENDIF
+	       IF ( med_diag%MEGRAZZ3%dgsave ) THEN
+                   megrazz3(ji,jj,jk) = (fgmezmi(ji,jj) * xthetazmi)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+	       IF ( med_diag%PBSI3%dgsave    ) THEN
+                  pbsi3(ji,jj,jk)    = (fprds(ji,jj) * zpds(ji,jj))
+               ENDIF
+	       IF ( med_diag%PCAL3%dgsave    ) THEN
+                  pcal3(ji,jj,jk)    = ftempca(ji,jj)
+               ENDIF
+	       IF ( med_diag%REMOC3%dgsave   ) THEN
+                  remoc3(ji,jj,jk)   = freminc(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+	       IF ( med_diag%PNLIMJ3%dgsave  ) THEN
+                  ! pnlimj3(ji,jj,jk)  = fjln(ji,jj)
+                  pnlimj3(ji,jj,jk)  = fjlim_pn(ji,jj)
+               ENDIF
+	       IF ( med_diag%PNLIMN3%dgsave  ) THEN
+                  pnlimn3(ji,jj,jk)  = fnln(ji,jj)
+               ENDIF
+	       IF ( med_diag%PNLIMFE3%dgsave ) THEN
+                  pnlimfe3(ji,jj,jk) = ffln2(ji,jj)
+               ENDIF
+	       IF ( med_diag%PDLIMJ3%dgsave  ) THEN
+                  ! pdlimj3(ji,jj,jk)  = fjld(ji,jj)
+                  pdlimj3(ji,jj,jk)  = fjlim_pd(ji,jj)
+               ENDIF
+	       IF ( med_diag%PDLIMN3%dgsave  ) THEN
+                  pdlimn3(ji,jj,jk)  = fnld(ji,jj)
+               ENDIF
+	       IF ( med_diag%PDLIMFE3%dgsave ) THEN
+                  pdlimfe3(ji,jj,jk) = ffld(ji,jj)
+               ENDIF
+	       IF ( med_diag%PDLIMSI3%dgsave ) THEN
+                  pdlimsi3(ji,jj,jk) = fsld2(ji,jj)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE bio_med_diag_iomput
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_med_diag_iomput( )                    ! Empty routine
+      WRITE(*,*) 'bio_med_diag_iomput: You should not have seen this print! error?'
+   END SUBROUTINE bio_med_diag_iomput
+#endif 
+
+   !!======================================================================
+END MODULE bio_med_diag_iomput_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag.F90	(revision 9824)
@@ -0,0 +1,212 @@
+MODULE bio_medusa_diag_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_medusa_diag_mod  ***
+   !! Calculates diagnostics
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_medusa_diag        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_medusa_diag( jk )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_medusa_diag  ***
+      !! This called from TRC_BIO_MEDUSA and calculates diagnostics
+      !!-------------------------------------------------------------------
+      USE bio_med_diag_iomput_mod,  ONLY: bio_med_diag_iomput
+      USE bio_medusa_mod
+      USE dom_oce,                  ONLY: e3t_0, e3t_n,                  &
+                                          gdepw_0, gdepw_n, tmask
+      USE in_out_manager,           ONLY: lwp, numout
+# if defined key_iomput
+      USE iom,                      ONLY: lk_iomput
+# endif
+      USE par_oce,                  ONLY: jpim1, jpjm1
+      USE sms_medusa,               ONLY: xrfn, xthetapd, xthetapn,      &
+                                          xthetazme, xthetazmi
+      USE trc,                      ONLY: med_diag 
+# if defined key_roam
+      USE trcoxy_medusa,            ONLY: oxy_sato
+# endif
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! level
+      INTEGER, INTENT( in ) :: jk
+
+      !! Loop avariables
+      INTEGER :: ji, jj, jn
+
+# if defined key_trc_diabio
+      !!==========================================================
+      !! LOCAL GRID CELL DIAGNOSTICS
+      !!==========================================================
+      !!
+      !!----------------------------------------------------------
+      !! Full diagnostics key_trc_diabio:
+      !! LOBSTER and PISCES support full diagnistics option 
+      !! key_trc_diabio which gives an option of FULL output of 
+      !! biological sourses and sinks. I cannot see any reason 
+      !! for doing this. If needed, it can be done as shown
+      !! below.
+      !!----------------------------------------------------------
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio'
+# endif
+
+      !! The section below, down to calculation of zo2min, was moved 
+      !! from before the call to AIR_SEA in trcbio_medusa.F90 - marc 9/5/17 
+      IF( lk_iomput ) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  !! sum tracers for inventory checks
+                  IF ( med_diag%INVTN%dgsave )   THEN
+                     ftot_n(ji,jj)  = ftot_n(ji,jj) +                        &
+                        (fse3t(ji,jj,jk) * (zphn(ji,jj) + zphd(ji,jj) +      &
+                                            zzmi(ji,jj) + zzme(ji,jj) +      &
+                                            zdet(ji,jj) + zdin(ji,jj)))
+                  ENDIF
+                  IF ( med_diag%INVTSI%dgsave )  THEN
+                     ftot_si(ji,jj) = ftot_si(ji,jj) +                       & 
+                       (fse3t(ji,jj,jk) * (zpds(ji,jj) + zsil(ji,jj)))
+                  ENDIF
+                  IF ( med_diag%INVTFE%dgsave )  THEN
+                     ftot_fe(ji,jj) = ftot_fe(ji,jj) +                       & 
+                        (fse3t(ji,jj,jk) * (xrfn *                           &
+                                            (zphn(ji,jj) + zphd(ji,jj) +     &
+                                             zzmi(ji,jj) + zzme(ji,jj) +     &
+                                             zdet(ji,jj)) +                  &
+                                            zfer(ji,jj)))
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+
+# if defined key_roam
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  IF ( med_diag%INVTC%dgsave )  THEN
+                     ftot_c(ji,jj)  = ftot_c(ji,jj) +                        & 
+                        (fse3t(ji,jj,jk) * ((xthetapn * zphn(ji,jj)) +       &
+                                            (xthetapd * zphd(ji,jj)) +       &
+                                            (xthetazmi * zzmi(ji,jj)) +      &
+                                            (xthetazme * zzme(ji,jj)) +      &
+                                            zdtc(ji,jj) + zdic(ji,jj)))
+                  ENDIF
+                  IF ( med_diag%INVTALK%dgsave ) THEN
+                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fse3t(ji,jj,jk) *     &
+                                                       zalk(ji,jj))
+                  ENDIF
+                  IF ( med_diag%INVTO2%dgsave )  THEN
+                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fse3t(ji,jj,jk) *    &
+                                                        zoxy(ji,jj))
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  IF ( med_diag%INVTC%dgsave )  THEN
+                     !!
+                     !! AXY (10/11/16): CMIP6 diagnostics
+                     IF ( med_diag%INTDISSIC%dgsave ) THEN
+                        intdissic(ji,jj) = intdissic(ji,jj) +                &
+                                           (fse3t(ji,jj,jk) * zdic(ji,jj))
+                     ENDIF
+                     IF ( med_diag%INTDISSIN%dgsave ) THEN
+                        intdissin(ji,jj) = intdissin(ji,jj) +                &
+                                           (fse3t(ji,jj,jk) * zdin(ji,jj))
+                     ENDIF
+                     IF ( med_diag%INTDISSISI%dgsave ) THEN
+                        intdissisi(ji,jj) = intdissisi(ji,jj) +              &
+                                            (fse3t(ji,jj,jk) * zsil(ji,jj))
+                     ENDIF
+                     IF ( med_diag%INTTALK%dgsave ) THEN
+                        inttalk(ji,jj) = inttalk(ji,jj) +                    &
+                                         (fse3t(ji,jj,jk) * zalk(ji,jj))
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  IF ( med_diag%O2min%dgsave ) THEN
+                     if ( zoxy(ji,jj) < o2min(ji,jj) ) then
+                        o2min(ji,jj)  = zoxy(ji,jj)
+                        IF ( med_diag%ZO2min%dgsave ) THEN
+                           !! layer midpoint
+                           zo2min(ji,jj) = (fsdepw(ji,jj,jk) +               &
+                                            fdep1(ji,jj)) / 2.0
+                        ENDIF
+                     endif
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+# endif
+      ENDIF
+
+# if defined key_roam
+      !! This section is moved from just below CALL to AIR_SEA in
+      !! trcbio_medusa.F90 - marc 9/5/17
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+
+               !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic
+               IF ( med_diag%O2SAT3%dgsave ) THEN
+! Remove f_o2sat3 - marc 9/5/17
+!                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj), f_o2sat3 )
+!                  o2sat3(ji, jj, jk) = f_o2sat3
+                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj),                   &
+                                 o2sat3(ji,jj,jk) )
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+# endif
+
+      !!---------------------------------------------------------------
+      !! Calculates the diagnostics used with iom_put
+      !!---------------------------------------------------------------
+      CALL bio_med_diag_iomput( jk )
+
+   END SUBROUTINE bio_medusa_diag
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_medusa_diag( )                    ! Empty routine
+      WRITE(*,*) 'bio_medusa_diag: You should not have seen this print! error?'
+   END SUBROUTINE bio_medusa_diag
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_diag_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag_slice.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag_slice.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_diag_slice.F90	(revision 9824)
@@ -0,0 +1,412 @@
+MODULE bio_medusa_diag_slice_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_medusa_diag_slice_mod  ***
+   !! Diagnostic calculations at different levels
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_medusa_diag_slice     ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_medusa_diag_slice( jk )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_medusa_diag_slice  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - ...
+      !!----------------------------------------------------------------------
+      USE bio_medusa_mod
+      USE par_medusa,        ONLY: jpchd, jpchn      
+      USE dom_oce,           ONLY: tmask
+      USE in_out_manager,    ONLY: lwp, numout
+# if defined key_iomput
+      USE iom,               ONLY: iom_put
+# endif
+      USE lbclnk,            ONLY: lbc_lnk
+      USE oce,               ONLY: CO2Flux_out_cpl, DMS_out_cpl
+      USE par_oce,           ONLY: jpi, jpj
+      USE sbc_oce,           ONLY: lk_oasis, qsr, wndm
+      USE sms_medusa,        ONLY: i0100, i0150, i0200, i0500, i1000,      &
+                                   f2_ccd_arg, f2_ccd_cal,                 &
+                                   f3_co3, f3_h2co3, f3_hco3, f3_pH,       &
+                                   jdms, ocal_ccd, xpar, xze,              &
+                                   zb_co2_flx, zb_dms_srf,                 &
+                                   zn_co2_flx, zn_dms_srf
+      USE trc,               ONLY: med_diag
+
+      !! The vertical level
+      INTEGER, INTENT( in ) ::    jk
+      !!----------------------------------------------------------------------
+
+      !!-----------------------------------------
+      !!
+      !! 2d specific k level diags
+      !!
+      !!-----------------------------------------
+#   if defined key_debug_medusa
+         IF (lwp) write (numout,*) 'bio_medusa_diag_slice: start jk = ', jk
+         CALL flush(numout)
+#   endif
+      !!
+      IF (jk.eq.1) THEN
+         IF( med_diag%MED_QSR%dgsave ) THEN
+            CALL iom_put( "MED_QSR"  , qsr ) !
+         ENDIF
+         IF( med_diag%MED_XPAR%dgsave ) THEN
+            CALL iom_put( "MED_XPAR"  , xpar(:,:,jk) ) !
+         ENDIF       
+         IF( med_diag%OCAL_CCD%dgsave ) THEN
+            CALL iom_put( "OCAL_CCD"  , ocal_ccd ) !
+         ENDIF
+         IF( med_diag%FE_0000%dgsave ) THEN
+            CALL iom_put( "FE_0000"  , xFree ) !
+         ENDIF                     
+         IF( med_diag%MED_XZE%dgsave ) THEN
+            CALL iom_put( "MED_XZE"  , xze ) !
+         ENDIF 
+# if defined key_roam                     
+         IF( med_diag%WIND%dgsave ) THEN
+            CALL iom_put( "WIND"  , wndm )
+         ENDIF
+         IF( med_diag%ATM_PCO2%dgsave ) THEN
+            CALL iom_put( "ATM_PCO2"  , f_pco2a2d )
+            DEALLOCATE( f_pco2a2d )
+         ENDIF
+         IF( med_diag%OCN_PH%dgsave ) THEN
+            zw2d(:,:) = f3_pH(:,:,jk)
+            CALL iom_put( "OCN_PH"  , zw2d )
+         ENDIF
+         IF( med_diag%OCN_PCO2%dgsave ) THEN
+            CALL iom_put( "OCN_PCO2"  , f_pco2w2d )
+            DEALLOCATE( f_pco2w2d )
+         ENDIF
+         IF( med_diag%OCNH2CO3%dgsave ) THEN
+            zw2d(:,:) = f3_h2co3(:,:,jk)
+            CALL iom_put( "OCNH2CO3"  , zw2d )
+         ENDIF
+         IF( med_diag%OCN_HCO3%dgsave ) THEN
+            zw2d(:,:) = f3_hco3(:,:,jk)
+            CALL iom_put( "OCN_HCO3"  , zw2d )
+         ENDIF
+         IF( med_diag%OCN_CO3%dgsave ) THEN
+            zw2d(:,:) = f3_co3(:,:,jk)
+            CALL iom_put( "OCN_CO3"  , zw2d )
+         ENDIF
+         IF( med_diag%CO2FLUX%dgsave ) THEN
+            CALL iom_put( "CO2FLUX"  , f_co2flux2d )
+            DEALLOCATE( f_co2flux2d )
+         ENDIF
+         !! 
+         !! AXY (10/11/16): repeat CO2 flux diagnostic in UKMO/CMIP6 units;
+         !!                 this both outputs the CO2 flux in specified units
+         !!                 and sends the resulting field to the coupler
+         !! JPALM (17/11/16): put CO2 flux (fgco2) alloc/unalloc/pass to zn 
+         !!                   out of diag list request 
+         CALL lbc_lnk( fgco2(:,:),'T',1. )
+         IF( med_diag%FGCO2%dgsave ) THEN
+            CALL iom_put( "FGCO2"  , fgco2 )
+         ENDIF
+         !! JPALM (17/11/16): should mv this fgco2 part 
+         !!                   out of lk_iomput loop
+         zb_co2_flx = zn_co2_flx
+         zn_co2_flx = fgco2
+         IF (lk_oasis) THEN
+            CO2Flux_out_cpl = zn_co2_flx
+         ENDIF
+         DEALLOCATE( fgco2 )
+         !! ---
+         IF( med_diag%OM_CAL%dgsave ) THEN
+            CALL iom_put( "OM_CAL"  , f_omcal )
+         ENDIF
+         IF( med_diag%OM_ARG%dgsave ) THEN
+            CALL iom_put( "OM_ARG"  , f_omarg )
+         ENDIF
+         IF( med_diag%TCO2%dgsave ) THEN
+            CALL iom_put( "TCO2"  , f_TDIC2d )
+            DEALLOCATE( f_TDIC2d )
+         ENDIF
+         IF( med_diag%TALK%dgsave ) THEN
+            CALL iom_put( "TALK"  , f_TALK2d )
+            DEALLOCATE( f_TALK2d )
+         ENDIF
+         IF( med_diag%KW660%dgsave ) THEN
+            CALL iom_put( "KW660"  , f_kw6602d )
+            DEALLOCATE( f_kw6602d )
+         ENDIF
+         IF( med_diag%ATM_PP0%dgsave ) THEN
+            CALL iom_put( "ATM_PP0"  , f_pp02d )
+            DEALLOCATE( f_pp02d )
+         ENDIF
+         IF( med_diag%O2FLUX%dgsave ) THEN
+            CALL iom_put( "O2FLUX"  , f_o2flux2d )
+            DEALLOCATE( f_o2flux2d )
+         ENDIF
+         IF( med_diag%O2SAT%dgsave ) THEN
+            CALL iom_put( "O2SAT"  , f_o2sat2d )
+            DEALLOCATE( f_o2sat2d )
+         ENDIF
+         IF( med_diag%CAL_CCD%dgsave ) THEN
+            CALL iom_put( "CAL_CCD"  , f2_ccd_cal )
+         ENDIF
+         IF( med_diag%ARG_CCD%dgsave ) THEN
+            CALL iom_put( "ARG_CCD"  , f2_ccd_arg )
+         ENDIF
+         IF (jdms .eq. 1) THEN
+            IF( med_diag%DMS_SURF%dgsave ) THEN
+               CALL lbc_lnk(dms_surf2d(:,:),'T',1. )
+               CALL iom_put( "DMS_SURF"  , dms_surf2d )
+               zb_dms_srf = zn_dms_srf
+               zn_dms_srf = dms_surf2d
+               IF (lk_oasis) THEN
+                  DMS_out_cpl = zn_dms_srf
+               ENDIF
+               DEALLOCATE( dms_surf2d ) 
+            ENDIF
+            IF( med_diag%DMS_ANDR%dgsave ) THEN
+               CALL iom_put( "DMS_ANDR"  , dms_andr2d )
+               DEALLOCATE( dms_andr2d )
+            ENDIF
+            IF( med_diag%DMS_SIMO%dgsave ) THEN
+               CALL iom_put( "DMS_SIMO"  , dms_simo2d )
+               DEALLOCATE( dms_simo2d )
+            ENDIF
+            IF( med_diag%DMS_ARAN%dgsave ) THEN
+               CALL iom_put( "DMS_ARAN"  , dms_aran2d )
+               DEALLOCATE( dms_aran2d )
+            ENDIF
+            IF( med_diag%DMS_HALL%dgsave ) THEN
+               CALL iom_put( "DMS_HALL"  , dms_hall2d )
+               DEALLOCATE( dms_hall2d )
+            ENDIF
+            IF( med_diag%DMS_ANDM%dgsave ) THEN
+               CALL iom_put( "DMS_ANDM"  , dms_andm2d )
+               DEALLOCATE( dms_andm2d )
+            ENDIF
+         ENDIF
+         !! AXY (24/11/16): extra MOCSY diagnostics
+         IF( med_diag%ATM_XCO2%dgsave ) THEN
+            CALL iom_put( "ATM_XCO2"  ,   f_xco2a_2d      )
+            DEALLOCATE( f_xco2a_2d )
+         ENDIF
+         IF( med_diag%OCN_FCO2%dgsave ) THEN
+            CALL iom_put( "OCN_FCO2"  ,   f_fco2w_2d      )
+            DEALLOCATE( f_fco2w_2d )
+         ENDIF
+         IF( med_diag%ATM_FCO2%dgsave ) THEN
+            CALL iom_put( "ATM_FCO2"  ,   f_fco2a_2d      )
+            DEALLOCATE( f_fco2a_2d )
+         ENDIF
+         IF( med_diag%OCN_RHOSW%dgsave ) THEN
+            CALL iom_put( "OCN_RHOSW"  ,  f_ocnrhosw_2d   )
+            DEALLOCATE( f_ocnrhosw_2d )
+         ENDIF
+         IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+            CALL iom_put( "OCN_SCHCO2"  , f_ocnschco2_2d  )
+            DEALLOCATE( f_ocnschco2_2d )
+         ENDIF
+         IF( med_diag%OCN_KWCO2%dgsave ) THEN
+            CALL iom_put( "OCN_KWCO2"  ,  f_ocnkwco2_2d   )
+            DEALLOCATE( f_ocnkwco2_2d )
+         ENDIF
+         IF( med_diag%OCN_K0%dgsave ) THEN
+            CALL iom_put( "OCN_K0"  ,     f_ocnk0_2d      )
+            DEALLOCATE( f_ocnk0_2d )
+         ENDIF
+         IF( med_diag%CO2STARAIR%dgsave ) THEN
+            CALL iom_put( "CO2STARAIR"  , f_co2starair_2d )
+            DEALLOCATE( f_co2starair_2d )
+         ENDIF
+         IF( med_diag%OCN_DPCO2%dgsave ) THEN
+            CALL iom_put( "OCN_DPCO2"  ,  f_ocndpco2_2d   )
+            DEALLOCATE( f_ocndpco2_2d )
+         ENDIF
+# endif                     
+      ELSE IF (jk.eq.i0100) THEN 
+         IF( med_diag%SDT__100%dgsave ) THEN
+            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDT__100"  , zw2d )
+         ENDIF
+         IF( med_diag%REG__100%dgsave ) THEN
+            CALL iom_put( "REG__100"  , fregen2d )
+         ENDIF
+         IF( med_diag%FDT__100%dgsave ) THEN
+            CALL iom_put( "FDT__100"  , ffastn )
+         ENDIF           
+         IF( med_diag%RG__100F%dgsave ) THEN
+            CALL iom_put( "RG__100F"  , fregenfast )
+         ENDIF
+         IF( med_diag%FDS__100%dgsave ) THEN
+            CALL iom_put( "FDS__100"  , ffastsi )
+         ENDIF         
+         IF( med_diag%RGS_100F%dgsave ) THEN
+            CALL iom_put( "RGS_100F"  , fregenfastsi )
+         ENDIF
+         IF( med_diag%FE_0100%dgsave ) THEN
+            CALL iom_put( "FE_0100"  , xFree )
+         ENDIF
+# if defined key_roam                     
+         IF( med_diag%RR_0100%dgsave ) THEN
+            CALL iom_put( "RR_0100"  , ffastca2d )
+         ENDIF                     
+         IF( med_diag%SDC__100%dgsave ) THEN
+            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDC__100"  , zw2d )
+         ENDIF                  
+         IF( med_diag%epC100%dgsave    ) THEN
+            zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk)
+            CALL iom_put( "epC100"    , zw2d )
+         ENDIF		     
+         IF( med_diag%epCALC100%dgsave ) THEN
+            CALL iom_put( "epCALC100" , ffastca )
+         ENDIF		     
+         IF( med_diag%epN100%dgsave    ) THEN
+            zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk)
+            CALL iom_put( "epN100"    , zw2d )
+         ENDIF		     
+         IF( med_diag%epSI100%dgsave   ) THEN
+            CALL iom_put( "epSI100"   , ffastsi )
+         ENDIF		     
+# endif                     
+      ELSE IF (jk.eq.i0200) THEN
+         IF( med_diag%SDT__200%dgsave ) THEN
+            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDT__200"  , zw2d )
+         ENDIF
+         IF( med_diag%REG__200%dgsave ) THEN
+            CALL iom_put( "REG__200"  , fregen2d )
+         ENDIF
+         IF( med_diag%FDT__200%dgsave ) THEN
+            CALL iom_put( "FDT__200"  , ffastn )
+         ENDIF
+         IF( med_diag%RG__200F%dgsave ) THEN
+            CALL iom_put( "RG__200F"  , fregenfast )
+         ENDIF
+         IF( med_diag%FDS__200%dgsave ) THEN
+            CALL iom_put( "FDS__200"  , ffastsi )
+         ENDIF
+         IF( med_diag%RGS_200F%dgsave ) THEN
+            CALL iom_put( "RGS_200F"  , fregenfastsi )
+         ENDIF
+         IF( med_diag%FE_0200%dgsave ) THEN
+            CALL iom_put( "FE_0200"   , xFree )
+         ENDIF
+# if defined key_roam                     
+         IF( med_diag%SDC__200%dgsave ) THEN
+            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDC__200"  , zw2d )
+         ENDIF
+# endif                     
+      ELSE IF (jk.eq.i0500) THEN
+         IF( med_diag%SDT__500%dgsave ) THEN
+            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDT__500"  , zw2d )
+         ENDIF
+         IF( med_diag%REG__500%dgsave ) THEN
+            CALL iom_put( "REG__500"  , fregen2d )
+         ENDIF      
+         IF( med_diag%FDT__500%dgsave ) THEN
+            CALL iom_put( "FDT__500"  , ffastn )
+         ENDIF
+         IF( med_diag%RG__500F%dgsave ) THEN
+            CALL iom_put( "RG__500F"  , fregenfast )
+         ENDIF
+         IF( med_diag%FDS__500%dgsave ) THEN
+            CALL iom_put( "FDS__500"  , ffastsi )
+         ENDIF
+         IF( med_diag%RGS_500F%dgsave ) THEN
+            CALL iom_put( "RGS_500F"  , fregenfastsi )
+         ENDIF
+         IF( med_diag%FE_0500%dgsave ) THEN
+            CALL iom_put( "FE_0500"  , xFree )
+         ENDIF
+# if defined key_roam                     
+         IF( med_diag%RR_0500%dgsave ) THEN
+            CALL iom_put( "RR_0500"  , ffastca2d )
+         ENDIF
+         IF( med_diag%SDC__500%dgsave ) THEN
+            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDC__500"  , zw2d )
+         ENDIF  
+# endif                      
+      ELSE IF (jk.eq.i1000) THEN
+         IF( med_diag%SDT_1000%dgsave ) THEN
+            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDT_1000"  , zw2d )
+         ENDIF
+         IF( med_diag%REG_1000%dgsave ) THEN
+            CALL iom_put( "REG_1000"  , fregen2d )
+         ENDIF  
+         IF( med_diag%FDT_1000%dgsave ) THEN
+            CALL iom_put( "FDT_1000"  , ffastn )
+         ENDIF
+         IF( med_diag%RG_1000F%dgsave ) THEN
+            CALL iom_put( "RG_1000F"  , fregenfast )
+         ENDIF
+         IF( med_diag%FDS_1000%dgsave ) THEN
+            CALL iom_put( "FDS_1000"  , ffastsi )
+         ENDIF
+         IF( med_diag%RGS1000F%dgsave ) THEN
+            CALL iom_put( "RGS1000F"  , fregenfastsi )
+         ENDIF
+         IF( med_diag%FE_1000%dgsave ) THEN
+            CALL iom_put( "FE_1000"  , xFree )
+         ENDIF
+# if defined key_roam                     
+         IF( med_diag%RR_1000%dgsave ) THEN
+            CALL iom_put( "RR_1000"  , ffastca2d )
+            DEALLOCATE( ffastca2d )
+         ENDIF
+         IF( med_diag%SDC_1000%dgsave ) THEN
+            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+            CALL iom_put( "SDC_1000"  , zw2d )
+         ENDIF 
+# endif                      
+      ENDIF
+      !! to do on every k loop :
+      IF( med_diag%DETFLUX3%dgsave ) THEN
+         !! detrital flux
+         detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk)
+         !CALL iom_put( "DETFLUX3"  , ftot_n )
+      ENDIF
+# if defined key_roam                     
+      IF( med_diag%EXPC3%dgsave ) THEN
+         expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk)
+      ENDIF		     
+      IF( med_diag%EXPN3%dgsave ) THEN
+         expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk)
+      ENDIF		     
+# endif		     
+#   if defined key_debug_medusa
+         IF (lwp) write (numout,*) 'bio_medusa_diag_slice: end jk = ', jk
+         CALL flush(numout)
+#   endif
+
+   END SUBROUTINE bio_medusa_diag_slice
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_medusa_diag_slice( )                  ! Empty routine
+      WRITE(*,*) 'bio_medusa_diag_slice: You should not have seen this print! error?'
+   END SUBROUTINE bio_medusa_diag_slice
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_diag_slice_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_fin.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_fin.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_fin.F90	(revision 9824)
@@ -0,0 +1,935 @@
+MODULE bio_medusa_fin_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_medusa_fin_mod  ***
+   !! Finalisation for TRC_BIO_MEDUSA
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Amend bethic reservoir updating
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_medusa_fin     ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_medusa_fin( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_medusa_fin  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - ...
+      !!----------------------------------------------------------------------
+      USE bio_medusa_mod
+      USE dom_oce,           ONLY: atfp, atfp1, neuler, rdt, e3t_n, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+# if defined key_iomput
+      USE iom,               ONLY: iom_put, lk_iomput
+# endif
+      USE lbclnk,            ONLY: lbc_lnk
+      USE oce,               ONLY: chloro_out_cpl 
+      USE par_medusa,        ONLY: jp_medusa_2d, jp_medusa_3d,          &
+                                   jp_medusa_trd, jpchd, jpchn
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1, jpk
+      USE phycst,            ONLY: rsmall
+      USE sbc_oce,           ONLY: lk_oasis
+      USE sms_medusa,        ONLY: jinorgben, jorgben,                  &
+                                   f3_co3, f3_h2co3, f3_hco3,           &
+                                   f3_omarg, f3_omcal, f3_pH,           &
+                                   za_sed_c, za_sed_ca, za_sed_fe,      &
+                                   za_sed_n, za_sed_si,                 &
+                                   zb_sed_c, zb_sed_ca, zb_sed_fe,      &
+                                   zb_sed_n, zb_sed_si,                 &
+                                   zn_sed_c, zn_sed_ca, zn_sed_fe,      &
+                                   zn_sed_n, zn_sed_si, zn_chl_srf,     &
+                                   scl_chl, chl_out
+      USE trc,               ONLY: med_diag, nittrc000, trn 
+      USE trcnam_trp,        ONLY: ln_trcadv_cen2, ln_trcadv_tvd
+ 
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) ::    kt
+
+      INTEGER :: ji, jj
+      INTEGER :: jn
+
+      REAL(wp) :: fq0,fq1,fq2,fq3
+
+# if defined key_roam                     
+      !!----------------------------------------------------------------------
+      !! AXY (09/08/17): fix benthic submodel
+      !!----------------------------------------------------------------------
+      !! Process benthic in/out fluxes
+      !! These can be handled outside of the 3D calculations since the
+      !! benthic pools (and fluxes) are 2D in nature; this code was
+      !! developed with help from George Nurser (NOC); it cannot be run
+      !! in a configuration with variable time-stepping with depth
+      !!----------------------------------------------------------------------
+      !!
+      !! time-step calculation
+      if (jorgben.eq.1) then
+         za_sed_n(:,:)  = zb_sed_n(:,:)  + ((2. * (rdt / 86400.)) * &
+                          ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ))
+         za_sed_fe(:,:) = zb_sed_fe(:,:) + ((2. * (rdt / 86400.)) * &
+                          ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ))
+         za_sed_c(:,:)  = zb_sed_c(:,:)  + ((2. * (rdt / 86400.)) * &
+                          ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ))
+      endif
+      if (jinorgben.eq.1) then
+         za_sed_si(:,:) = zb_sed_si(:,:) + ((2. * (rdt / 86400.)) * &
+                          ( f_fbenin_si(:,:) - f_benout_si(:,:) ))
+         za_sed_ca(:,:) = zb_sed_ca(:,:) + ((2. * (rdt / 86400.)) * &
+                          ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ))
+      endif
+      !!
+      !! time-level calculation
+      if (jorgben.eq.1) then
+         zb_sed_n(:,:)  = zn_sed_n(:,:)  + (atfp * &
+                          ( za_sed_n(:,:)  - (2. * zn_sed_n(:,:))  + zb_sed_n(:,:)  ))
+         zn_sed_n(:,:)  = za_sed_n(:,:)
+         zb_sed_fe(:,:) = zn_sed_fe(:,:) + (atfp * &
+                          ( za_sed_fe(:,:) - (2. * zn_sed_fe(:,:)) + zb_sed_fe(:,:) ))
+         zn_sed_fe(:,:) = za_sed_fe(:,:)
+         zb_sed_c(:,:)  = zn_sed_c(:,:)  + (atfp * &
+                          ( za_sed_c(:,:)  - (2. * zn_sed_c(:,:))  + zb_sed_c(:,:)  ))
+         zn_sed_c(:,:)  = za_sed_c(:,:)
+      endif
+      if (jinorgben.eq.1) then
+         zb_sed_si(:,:) = zn_sed_si(:,:) + (atfp * &
+                          ( za_sed_si(:,:) - (2. * zn_sed_si(:,:)) + zb_sed_si(:,:) ))
+         zn_sed_si(:,:) = za_sed_si(:,:)
+         zb_sed_ca(:,:) = zn_sed_ca(:,:) + (atfp * &
+                          ( za_sed_ca(:,:) - (2. * zn_sed_ca(:,:)) + zb_sed_ca(:,:) ))
+         zn_sed_ca(:,:) = za_sed_ca(:,:)
+      endif
+# endif      
+
+#  if defined key_debug_medusa
+         !! AXY (12/07/17)
+         !!-----------------------------------------------------------------
+         !! Check conservation of MEDUSA's sinks-minus-sources using fflx_X 
+         !! diagnostics (i.e. biogeochemical processes only)
+         !!   - fflx_X diagnostics *should* include all transfers between
+         !!     modelled components
+         !!   - they should also include gains / losses due to air-sea 
+         !!     fluxes of C and O2, aeolian and seafloor inputs of Fe, and 
+         !!     inputs from seafloor "benthic buckets" (N, Si, Fe, C and 
+         !!     alkalinity)
+         !!   - however, they do not include the transfer of material to 
+         !!     "benthic buckets" by sedimenting slow- and fast-sinking
+         !!     detritus since these are separate 2D reservoirs
+         !!   - consequently, for a given water column, the integrated
+         !!     fluxes should sum to the "loss" of material to the "benthic
+         !!     buckets"
+         !!   - if they do not, this suggests that MEDUSA contains errors
+         !!     in its accounting (e.g. processes omitted from calculated
+         !!     fluxes)
+         !!   - here, the local integrated fluxes and benthic inputs (plus
+         !!     air-sea fluxes in the case of C) are reported together with
+         !!     the resulting error
+         !!   - only N, Si, C and alkalinity inventories considered; Fe and
+         !!     O2 overlooked because of wholesale loss (and addition, in 
+         !!     the case of O2) of these tracers within the water column
+         !!-----------------------------------------------------------------
+         !!
+         !! nitrogen
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,1) == 1) then
+                  fq0 = fflx_n(ji,jj)
+                  fq1 = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj)
+                  fq2 = fq0 + fq1
+                  fq3 = f_benout_n(ji,jj)
+                  if (lwp) write (numout,'a,2i3,a,4f15,5)')                   &
+                     'AXY N   cons: (i,j)=',ji,jj,', (flx,ben,err,out)=',      &
+                     fq0,fq1,fq2,fq3
+               ENDIF
+            ENDDO
+         ENDDO   
+         !! silicon
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,1) == 1) then
+                  fq0 = fflx_si(ji,jj)
+                  fq1 = f_fbenin_si(ji,jj)
+                  fq2 = fq0 + fq1
+                  fq3 = f_benout_si(ji,jj)
+                  if (lwp) write (numout,'a,2i3,a,4f15,5)')                   &
+                     'AXY Si  cons: (i,j)=',ji,jj,', (flx,ben,err,out)=',     &
+                     fq0,fq1,fq2,fq3
+               ENDIF
+            ENDDO
+         ENDDO   
+         !! carbon
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,1) == 1) then
+                  fq0 = fflx_c(ji,jj)
+                  fq1 = f_sbenin_c(ji,jj) + f_fbenin_c(ji,jj) + f_fbenin_ca(ji,jj)
+                  fq2 = f_co2flux(ji,jj) * fse3t(ji,jj,1)
+                  fq3 = fq0 + fq1
+                  fq4 = f_benout_c(ji,jj) + f_benout_ca(ji,jj)
+                  if (lwp) write (numout,'a,2i3,a,5f15,5)')                   &
+                     'AXY C   cons: (i,j)=',ji,jj,', (flx,ben,asf,err,out)=', &
+                     fq0,fq1,fq2,fq3,fq4
+                ENDIF
+             ENDDO
+          ENDDO   
+          !! alkalinity
+          DO jj = 2,jpjm1
+             DO ji = 2,jpim1
+                if (tmask(ji,jj,1) == 1) then
+                   fq0 = fflx_a(ji,jj)
+                   fq1 = 2.0 * f_fbenin_ca(ji,jj)
+                   fq2 = fq0 + fq1
+                   fq3 = 2.0 * f_benout_ca(ji,jj)
+                   if (lwp) write (numout,'a,2i3,a,4f15,5)')                   &
+                      'AXY alk cons: (i,j)=',ji,jj,', (flx,ben,err,out)=',     &
+                      fq0,fq1,fq2,fq3
+               ENDIF
+            ENDDO
+         ENDDO   
+#  endif
+
+         !!!---------------------------------------------------------------
+         !! Add very last diag calculations 
+         !!!---------------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !!         
+               IF( med_diag%PN_JLIM%dgsave ) THEN
+                  fjln2d(ji,jj) = fjln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PN_NLIM%dgsave ) THEN
+                  fnln2d(ji,jj) = fnln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PN_FELIM%dgsave ) THEN
+                  ffln2d(ji,jj) = ffln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_JLIM%dgsave ) THEN
+                  fjld2d(ji,jj) = fjld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_NLIM%dgsave ) THEN
+                  fnld2d(ji,jj) = fnld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_FELIM%dgsave ) THEN
+                  ffld2d(ji,jj) = ffld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_SILIM%dgsave ) THEN
+                  fsld2d2(ji,jj) = fsld2d2(ji,jj) / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PDSILIM2%dgsave ) THEN
+                  fsld2d(ji,jj) = fsld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !!!---------------------------------------------------------------
+         !! Calculates Chl diag for UM coupling 
+         !!!---------------------------------------------------------------
+         !! JPALM -- 02-06-2017 --
+         !! add Chl surf coupling
+         !! no need to output, just pass to cpl var
+         IF (lk_oasis) THEN
+            IF (chl_out.eq.1) THEN
+               !! export and scale surface chl
+               zn_chl_srf(:,:) = MAX( 0.0, (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6 )
+                                 !! surf Chl in Kg-chl/m3 as needed for cpl
+            ELSEIF (chl_out.eq.2) THEN
+               !! export and scale mld chl
+               zn_chl_srf(:,:) = MAX( 0.0, fchl_ml(:,:) * 1.0E-6 )
+                                 !! mld Chl in Kg-chl/m3 as needed for cpl
+            ENDIF
+            chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl        !! Coupling Chl
+         END IF
+
+         !!----------------------------------------------------------------
+         !! Add in XML diagnostics stuff
+         !!----------------------------------------------------------------
+         !!
+         !! ** 2D diagnostics
+#   if defined key_debug_medusa
+         IF (lwp) write (numout,*) 'bio_medusa_fin: export all diag kt = ', kt
+         CALL flush(numout)
+#   endif
+         IF ( med_diag%INVTN%dgsave ) THEN
+            CALL iom_put( "INVTN"  , ftot_n )
+         ENDIF
+         IF ( med_diag%INVTSI%dgsave ) THEN
+            CALL iom_put( "INVTSI"  , ftot_si )
+         ENDIF
+         IF ( med_diag%INVTFE%dgsave ) THEN
+            CALL iom_put( "INVTFE"  , ftot_fe )
+         ENDIF                           
+         IF ( med_diag%ML_PRN%dgsave ) THEN
+            CALL iom_put( "ML_PRN"  , fprn_ml )
+         ENDIF
+         IF ( med_diag%ML_PRD%dgsave ) THEN
+            CALL iom_put( "ML_PRD"  , fprd_ml )
+         ENDIF
+         IF ( med_diag%OCAL_LVL%dgsave ) THEN
+            CALL iom_put( "OCAL_LVL"  , fccd )
+         ENDIF
+         IF ( med_diag%CHL_MLD%dgsave ) THEN
+            CALL iom_put( "CHL_MLD"  , fchl_ml )
+         ENDIF
+         IF (lk_oasis) THEN
+            IF ( med_diag%CHL_CPL%dgsave ) THEN
+               CALL iom_put( "CHL_CPL"  , chloro_out_cpl )
+            ENDIF
+         ENDIF
+         IF ( med_diag%PN_JLIM%dgsave ) THEN
+            CALL iom_put( "PN_JLIM"  , fjln2d )
+            DEALLOCATE( fjln2d )
+         ENDIF
+         IF ( med_diag%PN_NLIM%dgsave ) THEN
+            CALL iom_put( "PN_NLIM"  , fnln2d )
+            DEALLOCATE( fnln2d )
+         ENDIF
+         IF ( med_diag%PN_FELIM%dgsave ) THEN
+            CALL iom_put( "PN_FELIM"  , ffln2d )
+            DEALLOCATE( ffln2d )
+         ENDIF
+         IF ( med_diag%PD_JLIM%dgsave ) THEN
+            CALL iom_put( "PD_JLIM"  , fjld2d )
+            DEALLOCATE( fjld2d )
+         ENDIF
+         IF ( med_diag%PD_NLIM%dgsave ) THEN
+            CALL iom_put( "PD_NLIM"  , fnld2d )
+            DEALLOCATE( fnld2d )
+         ENDIF
+         IF ( med_diag%PD_FELIM%dgsave ) THEN
+            CALL iom_put( "PD_FELIM"  , ffld2d )
+            DEALLOCATE( ffld2d )
+         ENDIF
+         IF ( med_diag%PD_SILIM%dgsave ) THEN
+            CALL iom_put( "PD_SILIM"  , fsld2d2 )
+            DEALLOCATE( fsld2d2 )
+         ENDIF
+         IF ( med_diag%PDSILIM2%dgsave ) THEN
+            CALL iom_put( "PDSILIM2"  , fsld2d )
+            DEALLOCATE( fsld2d )
+         ENDIF
+         IF ( med_diag%INTFLX_N%dgsave ) THEN
+            CALL iom_put( "INTFLX_N"  , fflx_n )
+         ENDIF
+         IF ( med_diag%INTFLX_SI%dgsave ) THEN
+            CALL iom_put( "INTFLX_SI"  , fflx_si )
+         ENDIF
+         IF ( med_diag%INTFLX_FE%dgsave ) THEN
+            CALL iom_put( "INTFLX_FE"  , fflx_fe )
+         ENDIF        
+         IF ( med_diag%INT_PN%dgsave ) THEN
+            CALL iom_put( "INT_PN"  , ftot_pn )
+         ENDIF
+         IF ( med_diag%INT_PD%dgsave ) THEN
+            CALL iom_put( "INT_PD"  , ftot_pd )
+         ENDIF         
+         IF ( med_diag%INT_ZMI%dgsave ) THEN
+            CALL iom_put( "INT_ZMI"  , ftot_zmi )
+         ENDIF
+         IF ( med_diag%INT_ZME%dgsave ) THEN
+            CALL iom_put( "INT_ZME"  , ftot_zme )
+         ENDIF
+         IF ( med_diag%INT_DET%dgsave ) THEN
+            CALL iom_put( "INT_DET"  , ftot_det )
+         ENDIF
+         IF ( med_diag%INT_DTC%dgsave ) THEN
+            CALL iom_put( "INT_DTC"  , ftot_dtc )
+         ENDIF
+         IF ( med_diag%BEN_N%dgsave ) THEN
+            CALL iom_put( "BEN_N"  , za_sed_n )
+         ENDIF
+         IF ( med_diag%BEN_FE%dgsave ) THEN
+            CALL iom_put( "BEN_FE"  , za_sed_fe )
+         ENDIF
+         IF ( med_diag%BEN_C%dgsave ) THEN
+            CALL iom_put( "BEN_C"  , za_sed_c )
+         ENDIF
+         IF ( med_diag%BEN_SI%dgsave ) THEN
+            CALL iom_put( "BEN_SI"  , za_sed_si )
+         ENDIF
+         IF ( med_diag%BEN_CA%dgsave ) THEN
+            CALL iom_put( "BEN_CA"  , za_sed_ca )
+         ENDIF
+         IF ( med_diag%RUNOFF%dgsave ) THEN
+            CALL iom_put( "RUNOFF"  , f_runoff )
+         ENDIF 
+# if defined key_roam        
+         IF ( med_diag%N_PROD%dgsave ) THEN
+            CALL iom_put( "N_PROD"  , fnit_prod )
+         ENDIF
+         IF ( med_diag%N_CONS%dgsave ) THEN
+            CALL iom_put( "N_CONS"  , fnit_cons )
+         ENDIF
+         IF ( med_diag%C_PROD%dgsave ) THEN
+            CALL iom_put( "C_PROD"  , fcar_prod )
+         ENDIF
+         IF ( med_diag%C_CONS%dgsave ) THEN
+            CALL iom_put( "C_CONS"  , fcar_cons )
+         ENDIF
+         IF ( med_diag%O2_PROD%dgsave ) THEN
+            CALL iom_put( "O2_PROD"  , foxy_prod )
+         ENDIF
+         IF ( med_diag%O2_CONS%dgsave ) THEN
+            CALL iom_put( "O2_CONS"  , foxy_cons )
+         ENDIF
+         IF ( med_diag%O2_ANOX%dgsave ) THEN
+            CALL iom_put( "O2_ANOX"  , foxy_anox )
+         ENDIF
+         IF ( med_diag%INVTC%dgsave ) THEN
+            CALL iom_put( "INVTC"  , ftot_c )
+         ENDIF
+         IF ( med_diag%INVTALK%dgsave ) THEN
+            CALL iom_put( "INVTALK"  , ftot_a )
+         ENDIF
+         IF ( med_diag%INVTO2%dgsave ) THEN
+            CALL iom_put( "INVTO2"  , ftot_o2 )
+         ENDIF
+         IF ( med_diag%COM_RESP%dgsave ) THEN
+            CALL iom_put( "COM_RESP"  , fcomm_resp )
+         ENDIF         
+# endif      
+         !!
+         !! diagnostic filled in the i-j-k main loop
+         !!--------------------------------------------
+         IF ( med_diag%PRN%dgsave ) THEN
+            CALL iom_put( "PRN"  , fprn2d )
+            DEALLOCATE( fprn2d )
+         ENDIF
+         IF ( med_diag%MPN%dgsave ) THEN
+            CALL iom_put( "MPN"  ,fdpn2d )
+            DEALLOCATE( fdpn2d )
+         ENDIF
+         IF ( med_diag%PRD%dgsave ) THEN
+            CALL iom_put( "PRD"  ,fprd2d )
+            DEALLOCATE( fprd2d )
+         ENDIF
+         IF( med_diag%MPD%dgsave ) THEN
+            CALL iom_put( "MPD"  , fdpd2d )
+            DEALLOCATE( fdpd2d )
+         ENDIF
+         !  IF( med_diag%DSED%dgsave ) THEN
+         !      CALL iom_put( "DSED"  , ftot_n )
+         !  ENDIF
+         IF( med_diag%OPAL%dgsave ) THEN
+            CALL iom_put( "OPAL"  , fprds2d )
+            DEALLOCATE( fprds2d )
+         ENDIF
+         IF( med_diag%OPALDISS%dgsave ) THEN
+            CALL iom_put( "OPALDISS"  , fsdiss2d )
+            DEALLOCATE( fsdiss2d )
+         ENDIF
+         IF( med_diag%GMIPn%dgsave ) THEN
+            CALL iom_put( "GMIPn"  , fgmipn2d )
+            DEALLOCATE( fgmipn2d )
+         ENDIF
+         IF( med_diag%GMID%dgsave ) THEN
+            CALL iom_put( "GMID"  , fgmid2d )
+            DEALLOCATE( fgmid2d )
+         ENDIF
+         IF( med_diag%MZMI%dgsave ) THEN
+            CALL iom_put( "MZMI"  , fdzmi2d )
+            DEALLOCATE( fdzmi2d )
+         ENDIF
+         IF( med_diag%GMEPN%dgsave ) THEN
+            CALL iom_put( "GMEPN"  , fgmepn2d )
+            DEALLOCATE( fgmepn2d )
+         ENDIF
+         IF( med_diag%GMEPD%dgsave ) THEN
+            CALL iom_put( "GMEPD"  , fgmepd2d )
+            DEALLOCATE( fgmepd2d )
+         ENDIF
+         IF( med_diag%GMEZMI%dgsave ) THEN
+            CALL iom_put( "GMEZMI"  , fgmezmi2d )
+            DEALLOCATE( fgmezmi2d )
+         ENDIF
+         IF( med_diag%GMED%dgsave ) THEN
+            CALL iom_put( "GMED"  , fgmed2d )
+            DEALLOCATE( fgmed2d )
+         ENDIF
+         IF( med_diag%MZME%dgsave ) THEN
+            CALL iom_put( "MZME"  , fdzme2d )
+            DEALLOCATE( fdzme2d )
+         ENDIF
+         !  IF( med_diag%DEXP%dgsave ) THEN
+         !      CALL iom_put( "DEXP"  , ftot_n )
+         !  ENDIF
+         IF( med_diag%DETN%dgsave ) THEN
+            CALL iom_put( "DETN"  , fslown2d )
+            DEALLOCATE( fslown2d )
+         ENDIF
+         IF( med_diag%MDET%dgsave ) THEN
+            CALL iom_put( "MDET"  , fdd2d )
+            DEALLOCATE( fdd2d )
+         ENDIF
+         IF( med_diag%AEOLIAN%dgsave ) THEN
+            CALL iom_put( "AEOLIAN"  , ffetop2d )
+            DEALLOCATE( ffetop2d )
+         ENDIF
+         IF( med_diag%BENTHIC%dgsave ) THEN
+            CALL iom_put( "BENTHIC"  , ffebot2d )
+            DEALLOCATE( ffebot2d )
+         ENDIF
+         IF( med_diag%SCAVENGE%dgsave ) THEN
+            CALL iom_put( "SCAVENGE"  , ffescav2d )
+            DEALLOCATE( ffescav2d )
+         ENDIF
+         !! 
+         IF( med_diag%TOTREG_N%dgsave ) THEN
+            CALL iom_put( "TOTREG_N"  , fregen2d )
+            DEALLOCATE( fregen2d )
+         ENDIF
+         IF( med_diag%TOTRG_SI%dgsave ) THEN
+            CALL iom_put( "TOTRG_SI"  , fregensi2d )
+            DEALLOCATE( fregensi2d )
+         ENDIF
+         !! 
+         IF( med_diag%FASTN%dgsave ) THEN
+            CALL iom_put( "FASTN"  , ftempn2d )
+            DEALLOCATE( ftempn2d )
+         ENDIF
+         IF( med_diag%FASTSI%dgsave ) THEN
+            CALL iom_put( "FASTSI"  , ftempsi2d )
+            DEALLOCATE( ftempsi2d )
+         ENDIF
+         IF( med_diag%FASTFE%dgsave ) THEN
+            CALL iom_put( "FASTFE"  , ftempfe2d )
+            DEALLOCATE( ftempfe2d )
+         ENDIF
+         IF( med_diag%FASTC%dgsave ) THEN
+            CALL iom_put( "FASTC"  , ftempc2d )
+            DEALLOCATE( ftempc2d )
+         ENDIF
+         IF( med_diag%FASTCA%dgsave ) THEN
+            CALL iom_put( "FASTCA"  , ftempca2d )
+            DEALLOCATE( ftempca2d )
+         ENDIF
+         !! 
+         IF( med_diag%REMINN%dgsave ) THEN
+            CALL iom_put( "REMINN"  , freminn2d )
+            DEALLOCATE( freminn2d )
+         ENDIF
+         IF( med_diag%REMINSI%dgsave ) THEN
+            CALL iom_put( "REMINSI"  , freminsi2d )
+            DEALLOCATE( freminsi2d )
+         ENDIF
+         IF( med_diag%REMINFE%dgsave ) THEN
+            CALL iom_put( "REMINFE"  , freminfe2d )
+            DEALLOCATE( freminfe2d )
+         ENDIF
+         IF( med_diag%REMINC%dgsave ) THEN
+            CALL iom_put( "REMINC"  , freminc2d )
+            DEALLOCATE( freminc2d )
+         ENDIF
+         IF( med_diag%REMINCA%dgsave ) THEN
+            CALL iom_put( "REMINCA"  , freminca2d )
+            DEALLOCATE( freminca2d )
+         ENDIF
+         IF( med_diag%SEAFLRN%dgsave ) THEN
+            CALL iom_put( "SEAFLRN"  , fsedn )
+         ENDIF
+         IF( med_diag%SEAFLRSI%dgsave ) THEN
+            CALL iom_put( "SEAFLRSI"  , fsedsi )
+         ENDIF
+         IF( med_diag%SEAFLRFE%dgsave ) THEN
+            CALL iom_put( "SEAFLRFE"  , fsedfe )
+         ENDIF
+         IF( med_diag%SEAFLRC%dgsave ) THEN
+            CALL iom_put( "SEAFLRC"  , fsedc )
+         ENDIF
+         IF( med_diag%SEAFLRCA%dgsave ) THEN
+            CALL iom_put( "SEAFLRCA"  , fsedca )
+         ENDIF
+         !!
+# if defined key_roam            
+         !!
+         IF( med_diag%RIV_N%dgsave ) THEN
+            CALL iom_put( "RIV_N"  , rivn2d )
+            DEALLOCATE( rivn2d )
+         ENDIF
+         IF( med_diag%RIV_SI%dgsave ) THEN
+            CALL iom_put( "RIV_SI"  , rivsi2d )
+            DEALLOCATE( rivsi2d )
+         ENDIF
+         IF( med_diag%RIV_C%dgsave ) THEN
+            CALL iom_put( "RIV_C"  , rivc2d )
+            DEALLOCATE( rivc2d )
+         ENDIF
+         IF( med_diag%RIV_ALK%dgsave ) THEN
+            CALL iom_put( "RIV_ALK"  , rivalk2d )
+            DEALLOCATE( rivalk2d )
+         ENDIF
+         IF( med_diag%DETC%dgsave ) THEN
+            CALL iom_put( "DETC"  , fslowc2d )
+            DEALLOCATE( fslowc2d )
+         ENDIF
+         !!
+         IF( med_diag%PN_LLOSS%dgsave ) THEN
+            CALL iom_put( "PN_LLOSS"  , fdpn22d )
+            DEALLOCATE( fdpn22d )
+         ENDIF
+         IF( med_diag%PD_LLOSS%dgsave ) THEN
+            CALL iom_put( "PD_LLOSS"  , fdpd22d )
+            DEALLOCATE( fdpd22d )
+         ENDIF
+         IF( med_diag%ZI_LLOSS%dgsave ) THEN
+            CALL iom_put( "ZI_LLOSS"  , fdzmi22d )
+             DEALLOCATE( fdzmi22d )
+          ENDIF
+          IF( med_diag%ZE_LLOSS%dgsave ) THEN
+             CALL iom_put( "ZE_LLOSS"  , fdzme22d )
+             DEALLOCATE( fdzme22d )
+          ENDIF
+          IF( med_diag%ZI_MES_N%dgsave ) THEN
+             CALL iom_put( "ZI_MES_N"  , zimesn2d )
+             DEALLOCATE( zimesn2d )
+          ENDIF
+          IF( med_diag%ZI_MES_D%dgsave ) THEN
+             CALL iom_put( "ZI_MES_D"  , zimesd2d )
+             DEALLOCATE( zimesd2d )
+          ENDIF
+          IF( med_diag%ZI_MES_C%dgsave ) THEN
+             CALL iom_put( "ZI_MES_C"  , zimesc2d )
+             DEALLOCATE( zimesc2d )
+          ENDIF
+          IF( med_diag%ZI_MESDC%dgsave ) THEN
+             CALL iom_put( "ZI_MESDC"  ,zimesdc2d )
+             DEALLOCATE( zimesdc2d )
+          ENDIF
+          IF( med_diag%ZI_EXCR%dgsave ) THEN
+             CALL iom_put( "ZI_EXCR"  , ziexcr2d )
+             DEALLOCATE( ziexcr2d )
+          ENDIF
+          IF( med_diag%ZI_RESP%dgsave ) THEN
+             CALL iom_put( "ZI_RESP"  , ziresp2d )
+             DEALLOCATE( ziresp2d )
+          ENDIF
+          IF( med_diag%ZI_GROW%dgsave ) THEN
+             CALL iom_put( "ZI_GROW"  , zigrow2d )
+             DEALLOCATE( zigrow2d )
+          ENDIF
+          IF( med_diag%ZE_MES_N%dgsave ) THEN
+             CALL iom_put( "ZE_MES_N"  , zemesn2d )
+             DEALLOCATE( zemesn2d )
+          ENDIF
+          IF( med_diag%ZE_MES_D%dgsave ) THEN
+             CALL iom_put( "ZE_MES_D"  , zemesd2d )
+             DEALLOCATE( zemesd2d )
+          ENDIF
+          IF( med_diag%ZE_MES_C%dgsave ) THEN
+             CALL iom_put( "ZE_MES_C"  , zemesc2d )
+             DEALLOCATE( zemesc2d )
+          ENDIF
+          IF( med_diag%ZE_MESDC%dgsave ) THEN
+             CALL iom_put( "ZE_MESDC"  , zemesdc2d )
+             DEALLOCATE( zemesdc2d )
+          ENDIF
+          IF( med_diag%ZE_EXCR%dgsave ) THEN
+             CALL iom_put( "ZE_EXCR"  , zeexcr2d )
+             DEALLOCATE( zeexcr2d )
+          ENDIF
+          IF( med_diag%ZE_RESP%dgsave ) THEN
+             CALL iom_put( "ZE_RESP"  , zeresp2d )
+             DEALLOCATE( zeresp2d )
+          ENDIF
+          IF( med_diag%ZE_GROW%dgsave ) THEN
+             CALL iom_put( "ZE_GROW"  , zegrow2d )
+             DEALLOCATE( zegrow2d )
+          ENDIF
+          IF( med_diag%MDETC%dgsave ) THEN
+             CALL iom_put( "MDETC"  , mdetc2d )
+             DEALLOCATE( mdetc2d )
+          ENDIF
+          IF( med_diag%GMIDC%dgsave ) THEN
+             CALL iom_put( "GMIDC"  , gmidc2d )
+             DEALLOCATE( gmidc2d )
+          ENDIF
+          IF( med_diag%GMEDC%dgsave ) THEN
+             CALL iom_put( "GMEDC"  , gmedc2d )
+             DEALLOCATE( gmedc2d )
+          ENDIF
+          IF( med_diag%IBEN_N%dgsave ) THEN
+             CALL iom_put( "IBEN_N"  , iben_n2d )
+             DEALLOCATE( iben_n2d )
+          ENDIF
+          IF( med_diag%IBEN_FE%dgsave ) THEN
+             CALL iom_put( "IBEN_FE"  , iben_fe2d )
+             DEALLOCATE( iben_fe2d )
+          ENDIF
+          IF( med_diag%IBEN_C%dgsave ) THEN
+             CALL iom_put( "IBEN_C"  , iben_c2d )
+             DEALLOCATE( iben_c2d )
+          ENDIF
+          IF( med_diag%IBEN_SI%dgsave ) THEN
+             CALL iom_put( "IBEN_SI"  , iben_si2d )
+             DEALLOCATE( iben_si2d )
+          ENDIF
+          IF( med_diag%IBEN_CA%dgsave ) THEN
+             CALL iom_put( "IBEN_CA"  , iben_ca2d )
+             DEALLOCATE( iben_ca2d )
+          ENDIF
+          IF( med_diag%OBEN_N%dgsave ) THEN
+             CALL iom_put( "OBEN_N"  , oben_n2d )
+             DEALLOCATE( oben_n2d )
+          ENDIF
+          IF( med_diag%OBEN_FE%dgsave ) THEN
+             CALL iom_put( "OBEN_FE"  , oben_fe2d )
+             DEALLOCATE( oben_fe2d )
+          ENDIF
+          IF( med_diag%OBEN_C%dgsave ) THEN
+             CALL iom_put( "OBEN_C"  , oben_c2d )
+             DEALLOCATE( oben_c2d )
+          ENDIF
+          IF( med_diag%OBEN_SI%dgsave ) THEN
+             CALL iom_put( "OBEN_SI"  , oben_si2d )
+             DEALLOCATE( oben_si2d )
+          ENDIF
+          IF( med_diag%OBEN_CA%dgsave ) THEN
+             CALL iom_put( "OBEN_CA"  , oben_ca2d )
+             DEALLOCATE( oben_ca2d )
+          ENDIF
+          IF( med_diag%SFR_OCAL%dgsave ) THEN
+             CALL iom_put( "SFR_OCAL"  , sfr_ocal2d )
+             DEALLOCATE( sfr_ocal2d )
+          ENDIF
+          IF( med_diag%SFR_OARG%dgsave ) THEN
+             CALL iom_put( "SFR_OARG"  , sfr_oarg2d )
+             DEALLOCATE( sfr_oarg2d )
+          ENDIF
+          IF( med_diag%LYSO_CA%dgsave ) THEN
+             CALL iom_put( "LYSO_CA"  , lyso_ca2d )
+             DEALLOCATE( lyso_ca2d )
+          ENDIF
+# endif                   
+          !!
+          !! ** 3D diagnostics
+          IF( med_diag%TPP3%dgsave ) THEN
+             CALL iom_put( "TPP3"  , tpp3d )
+             DEALLOCATE( tpp3d )
+          ENDIF
+          IF( med_diag%DETFLUX3%dgsave ) THEN
+             CALL iom_put( "DETFLUX3"  , detflux3d )
+             DEALLOCATE( detflux3d )
+          ENDIF
+          IF( med_diag%REMIN3N%dgsave ) THEN
+             CALL iom_put( "REMIN3N"  , remin3dn )
+             DEALLOCATE( remin3dn )
+          ENDIF
+# if defined key_roam          
+          IF( med_diag%PH3%dgsave ) THEN
+             CALL iom_put( "PH3"  , f3_pH )
+          ENDIF
+          IF( med_diag%OM_CAL3%dgsave ) THEN
+             CALL iom_put( "OM_CAL3"  , f3_omcal )
+          ENDIF
+          !!
+          !! AXY (09/11/16): 2D CMIP6 diagnostics
+          IF( med_diag%INTDISSIC%dgsave ) THEN
+             CALL iom_put( "INTDISSIC"  , intdissic )
+             DEALLOCATE( intdissic )
+          ENDIF          
+          IF( med_diag%INTDISSIN%dgsave ) THEN
+             CALL iom_put( "INTDISSIN"  , intdissin )
+             DEALLOCATE( intdissin )
+          ENDIF          
+          IF( med_diag%INTDISSISI%dgsave ) THEN
+             CALL iom_put( "INTDISSISI"  , intdissisi )
+             DEALLOCATE( intdissisi )
+          ENDIF          
+          IF( med_diag%INTTALK%dgsave ) THEN
+             CALL iom_put( "INTTALK"  , inttalk )
+             DEALLOCATE( inttalk )
+          ENDIF          
+          IF( med_diag%O2min%dgsave ) THEN
+             CALL iom_put( "O2min"  , o2min )
+             DEALLOCATE( o2min )
+          ENDIF          
+          IF( med_diag%ZO2min%dgsave ) THEN
+             CALL iom_put( "ZO2min"  , zo2min )
+             DEALLOCATE( zo2min )
+          ENDIF          
+          IF( med_diag%FBDDTALK%dgsave ) THEN
+             CALL iom_put( "FBDDTALK"  , fbddtalk )
+             DEALLOCATE( fbddtalk )
+          ENDIF          
+          IF( med_diag%FBDDTDIC%dgsave ) THEN
+             CALL iom_put( "FBDDTDIC"  , fbddtdic )
+             DEALLOCATE( fbddtdic )
+          ENDIF          
+          IF( med_diag%FBDDTDIFE%dgsave ) THEN
+             CALL iom_put( "FBDDTDIFE" , fbddtdife )
+             DEALLOCATE( fbddtdife )
+          ENDIF          
+          IF( med_diag%FBDDTDIN%dgsave ) THEN
+             CALL iom_put( "FBDDTDIN"  , fbddtdin )
+             DEALLOCATE( fbddtdin )
+          ENDIF          
+          IF( med_diag%FBDDTDISI%dgsave ) THEN
+             CALL iom_put( "FBDDTDISI" , fbddtdisi )
+             DEALLOCATE( fbddtdisi )
+          ENDIF    
+          !!
+          !! AXY (09/11/16): 3D CMIP6 diagnostics
+          IF( med_diag%TPPD3%dgsave ) THEN
+             CALL iom_put( "TPPD3"     , tppd3 )
+             DEALLOCATE( tppd3 )
+          ENDIF          
+          IF( med_diag%BDDTALK3%dgsave ) THEN
+             CALL iom_put( "BDDTALK3"  , bddtalk3 )
+             DEALLOCATE( bddtalk3 )
+          ENDIF          
+          IF( med_diag%BDDTDIC3%dgsave ) THEN
+             CALL iom_put( "BDDTDIC3"  , bddtdic3 )
+             DEALLOCATE( bddtdic3 )
+          ENDIF          
+          IF( med_diag%BDDTDIFE3%dgsave ) THEN
+             CALL iom_put( "BDDTDIFE3" , bddtdife3 )
+             DEALLOCATE( bddtdife3 )
+          ENDIF          
+          IF( med_diag%BDDTDIN3%dgsave ) THEN
+             CALL iom_put( "BDDTDIN3"  , bddtdin3 )
+             DEALLOCATE( bddtdin3 )
+          ENDIF          
+          IF( med_diag%BDDTDISI3%dgsave ) THEN
+             CALL iom_put( "BDDTDISI3" , bddtdisi3 )
+             DEALLOCATE( bddtdisi3 )
+          ENDIF    
+          IF( med_diag%FD_NIT3%dgsave ) THEN
+             CALL iom_put( "FD_NIT3"  , fd_nit3 )
+             DEALLOCATE( fd_nit3 )
+          ENDIF
+          IF( med_diag%FD_SIL3%dgsave ) THEN
+             CALL iom_put( "FD_SIL3"  , fd_sil3 )
+             DEALLOCATE( fd_sil3 )
+          ENDIF
+          IF( med_diag%FD_CAL3%dgsave ) THEN
+             CALL iom_put( "FD_CAL3"  , fd_cal3 )
+             DEALLOCATE( fd_cal3 )
+          ENDIF
+          IF( med_diag%FD_CAR3%dgsave ) THEN
+             CALL iom_put( "FD_CAR3"  , fd_car3 )
+             DEALLOCATE( fd_car3 )
+          ENDIF
+          IF( med_diag%CO33%dgsave ) THEN
+             CALL iom_put( "CO33"  , f3_co3 )
+          ENDIF          	        
+          IF( med_diag%CO3SATARAG3%dgsave ) THEN
+             CALL iom_put( "CO3SATARAG3"  , f3_omarg )
+          ENDIF          	        
+          IF( med_diag%CO3SATCALC3%dgsave ) THEN
+             CALL iom_put( "CO3SATCALC3"  , f3_omcal )
+          ENDIF          	        
+          IF( med_diag%EXPC3%dgsave ) THEN
+             CALL iom_put( "EXPC3"  , expc3 )
+             DEALLOCATE( expc3 )
+          ENDIF          	        
+          IF( med_diag%EXPN3%dgsave ) THEN
+             CALL iom_put( "EXPN3"  , expn3 )
+             DEALLOCATE( expn3 )
+          ENDIF          	        
+          IF( med_diag%DCALC3%dgsave ) THEN
+             CALL iom_put( "DCALC3"  , dcalc3 )
+             DEALLOCATE( dcalc3 )
+          ENDIF          	        
+          IF( med_diag%FEDISS3%dgsave ) THEN
+             CALL iom_put( "FEDISS3"  , fediss3 )
+             DEALLOCATE( fediss3 )
+          ENDIF          	        
+          IF( med_diag%FESCAV3%dgsave ) THEN
+             CALL iom_put( "FESCAV3"  , fescav3 )
+             DEALLOCATE( fescav3 )
+          ENDIF          	        
+          IF( med_diag%MIGRAZP3%dgsave ) THEN
+             CALL iom_put( "MIGRAZP3"  , migrazp3 )
+             DEALLOCATE( migrazp3 )
+          ENDIF          	        
+          IF( med_diag%MIGRAZD3%dgsave ) THEN
+             CALL iom_put( "MIGRAZD3"  , migrazd3 )
+             DEALLOCATE( migrazd3 )
+          ENDIF          	        
+          IF( med_diag%MEGRAZP3%dgsave ) THEN
+             CALL iom_put( "MEGRAZP3"  , megrazp3 )
+             DEALLOCATE( megrazp3 )
+          ENDIF          	        
+          IF( med_diag%MEGRAZD3%dgsave ) THEN
+             CALL iom_put( "MEGRAZD3"  , megrazd3 )
+             DEALLOCATE( megrazd3 )
+          ENDIF          	        
+          IF( med_diag%MEGRAZZ3%dgsave ) THEN
+             CALL iom_put( "MEGRAZZ3"  , megrazz3 )
+             DEALLOCATE( megrazz3 )
+          ENDIF          	        
+          IF( med_diag%O2SAT3%dgsave ) THEN
+             CALL iom_put( "O2SAT3"  , o2sat3 )
+             DEALLOCATE( o2sat3 )
+          ENDIF          	        
+          IF( med_diag%PBSI3%dgsave ) THEN
+             CALL iom_put( "PBSI3"  , pbsi3 )
+             DEALLOCATE( pbsi3 )
+          ENDIF          	        
+          IF( med_diag%PCAL3%dgsave ) THEN
+             CALL iom_put( "PCAL3"  , pcal3 )
+             DEALLOCATE( pcal3 )
+          ENDIF          	        
+          IF( med_diag%REMOC3%dgsave ) THEN
+             CALL iom_put( "REMOC3"  , remoc3 )
+             DEALLOCATE( remoc3 )
+          ENDIF          	        
+          IF( med_diag%PNLIMJ3%dgsave ) THEN
+             CALL iom_put( "PNLIMJ3" , pnlimj3 )
+             DEALLOCATE( pnlimj3 )
+          ENDIF          	        
+          IF( med_diag%PNLIMN3%dgsave ) THEN
+             CALL iom_put( "PNLIMN3" , pnlimn3 )
+             DEALLOCATE( pnlimn3 )
+          ENDIF          	        
+          IF( med_diag%PNLIMFE3%dgsave ) THEN
+             CALL iom_put( "PNLIMFE3" , pnlimfe3 )
+             DEALLOCATE( pnlimfe3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMJ3%dgsave ) THEN
+             CALL iom_put( "PDLIMJ3" , pdlimj3 )
+             DEALLOCATE( pdlimj3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMN3%dgsave ) THEN
+             CALL iom_put( "PDLIMN3" , pdlimn3 )
+             DEALLOCATE( pdlimn3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMFE3%dgsave ) THEN
+             CALL iom_put( "PDLIMFE3" , pdlimfe3 )
+             DEALLOCATE( pdlimfe3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMSI3%dgsave ) THEN
+             CALL iom_put( "PDLIMSI3" , pdlimsi3 )
+             DEALLOCATE( pdlimsi3 )
+          ENDIF          	        
+          
+# endif         
+
+          DEALLOCATE( zw2d )
+
+   END SUBROUTINE bio_medusa_fin
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_medusa_fin( )                    ! Empty routine
+      WRITE(*,*) 'bio_medusa_fin: You should not have seen this print! error?'
+   END SUBROUTINE bio_medusa_fin
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_fin_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_init.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_init.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_init.F90	(revision 9824)
@@ -0,0 +1,871 @@
+MODULE bio_medusa_init_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_medusa_init  ***
+   !! Initialisation for TRC_BIO_MEDUSA
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Add slow-sinking detrius variables
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_medusa_init    ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_medusa_init( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_medusa_init  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - zeroes arrays used in TRC_BIO_MEDUSA
+      !!  - sets up the arrays needed for the diagnostics
+      !!---------------------------------------------------------------------- 
+      USE bio_medusa_mod
+      USE par_oce,           ONLY: jpi, jpj, jpk
+      USE sms_medusa,        ONLY: jdms
+      USE trc,               ONLY: ln_diatrc, med_diag, nittrc000 
+      USE in_out_manager,    ONLY: lwp
+
+# if defined key_iomput
+      USE iom,               ONLY: lk_iomput, numout
+      USE trcnam_medusa,     ONLY: trc_nam_iom_medusa
+# endif
+
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) ::    kt
+
+      IF( ln_diatrc ) THEN
+         IF (lwp) write (numout,*) 'Diagnostics are now ALL through XIOS (key_xios)'
+         IF (lwp) write (numout,*) 'No more key_diatrc anymore.'
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !! Zero fast-sinking detritus 2D fields
+      !!----------------------------------------------------------------------
+      !!
+      ffastn(:,:)  = 0.0        !! organic nitrogen
+      ffastsi(:,:) = 0.0        !! biogenic silicon
+      ffastfe(:,:) = 0.0        !! organic iron
+      ffastc(:,:)  = 0.0        !! organic carbon
+      ffastca(:,:) = 0.0        !! biogenic calcium carbonate
+      !!
+      fsedn(:,:)   = 0.0        !! Seafloor flux of N 
+      fsedsi(:,:)  = 0.0        !! Seafloor flux of Si
+      fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe
+      fsedc(:,:)   = 0.0        !! Seafloor flux of C
+      fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3
+      !!
+      fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus)
+      fregenfastsi(:,:) = 0.0   !! integrated Si regeneration (fast detritus)
+# if defined key_roam
+      fregenfastc(:,:)  = 0.0   !! integrated  C regeneration (fast detritus)
+# endif
+      !!
+      fccd(:,:)    = 0.0        !! last depth level before CCD
+
+      !!----------------------------------------------------------------------
+      !! blank nutrient/flux inventories
+      !!----------------------------------------------------------------------
+      !!
+      fflx_n(:,:)  = 0.0        !! nitrogen flux total
+      fflx_si(:,:) = 0.0        !! silicon  flux total
+      fflx_fe(:,:) = 0.0        !! iron     flux total
+      fifd_n(:,:)  = 0.0        !! nitrogen fast detritus production
+      fifd_si(:,:) = 0.0        !! silicon  fast detritus production
+      fifd_fe(:,:) = 0.0        !! iron     fast detritus production
+      fofd_n(:,:)  = 0.0        !! nitrogen fast detritus remineralisation
+      fofd_si(:,:) = 0.0        !! silicon  fast detritus remineralisation
+      fofd_fe(:,:) = 0.0        !! iron     fast detritus remineralisation
+# if defined key_roam
+      fflx_c(:,:)  = 0.0        !! carbon     flux total
+      fflx_a(:,:)  = 0.0        !! alkalinity flux total
+      fflx_o2(:,:) = 0.0        !! oxygen     flux total
+      ftot_c(:,:)  = 0.0        !! carbon     inventory
+      ftot_a(:,:)  = 0.0        !! alkalinity inventory
+      ftot_o2(:,:) = 0.0        !! oxygen     inventory
+      fifd_c(:,:)  = 0.0        !! carbon     fast detritus production
+! I don't think fifd_a or fifd_o2 are used - marc 11/5/17
+!      fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production
+!      fifd_o2(:,:) = 0.0        !! oxygen     fast detritus production
+      fofd_c(:,:)  = 0.0        !! carbon     fast detritus remineralisation
+! I don't think fofd_a or fofd_o2 are used - marc 11/5/17
+!      fofd_a(:,:)  = 0.0        !! alkalinity fast detritus remineralisation
+!      fofd_o2(:,:) = 0.0        !! oxygen     fast detritus remineralisation
+      !!
+      fnit_prod(:,:) = 0.0      !! (organic)   nitrogen production
+      fnit_cons(:,:) = 0.0      !! (organic)   nitrogen consumption
+      fsil_prod(:,:) = 0.0      !! (inorganic) silicon production
+      fsil_cons(:,:) = 0.0      !! (inorganic) silicon consumption
+      fcar_prod(:,:) = 0.0      !! (organic)   carbon production
+      fcar_cons(:,:) = 0.0      !! (organic)   carbon consumption
+      !!
+      foxy_prod(:,:) = 0.0      !! oxygen production
+      foxy_cons(:,:) = 0.0      !! oxygen consumption
+      foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption
+      !!
+# endif
+      ftot_n(:,:)   = 0.0       !! N inventory 
+      ftot_si(:,:)  = 0.0       !! Si inventory
+      ftot_fe(:,:)  = 0.0       !! Fe inventory
+      ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton
+      ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton
+      ftot_zmi(:,:) = 0.0       !! integrated microzooplankton
+      ftot_zme(:,:) = 0.0       !! integrated mesozooplankton
+      ftot_det(:,:) = 0.0       !! integrated slow detritus, nitrogen
+      ftot_dtc(:,:) = 0.0       !! integrated slow detritus, carbon
+      !!
+      fzmi_i(:,:)  = 0.0        !! material grazed by microzooplankton
+      fzmi_o(:,:)  = 0.0        !! ... sum of fate of this material
+      fzme_i(:,:)  = 0.0        !! material grazed by  mesozooplankton
+      fzme_o(:,:)  = 0.0        !! ... sum of fate of this material
+      !!
+      f_sbenin_n(:,:)  = 0.0    !! slow detritus N  -> benthic pool
+      f_sbenin_fe(:,:) = 0.0    !! slow detritus Fe -> benthic pool
+      f_sbenin_c(:,:)  = 0.0    !! slow detritus C  -> benthic pool
+      f_fbenin_n(:,:)  = 0.0    !! fast detritus N  -> benthic pool
+      f_fbenin_fe(:,:) = 0.0    !! fast detritus Fe -> benthic pool
+      f_fbenin_si(:,:) = 0.0    !! fast detritus Si -> benthic pool
+      f_fbenin_c(:,:)  = 0.0    !! fast detritus C  -> benthic pool
+      f_fbenin_ca(:,:) = 0.0    !! fast detritus Ca -> benthic pool
+      !!
+      f_benout_n(:,:)  = 0.0    !! benthic N  pool  -> dissolved
+      f_benout_fe(:,:) = 0.0    !! benthic Fe pool  -> dissolved
+      f_benout_si(:,:) = 0.0    !! benthic Si pool  -> dissolved
+      f_benout_c(:,:)  = 0.0    !! benthic C  pool  -> dissolved
+      f_benout_ca(:,:) = 0.0    !! benthic Ca pool  -> dissolved
+      !!
+      f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool  -> dissolved (when it shouldn't!)
+      !!
+      f_runoff(:,:)  = 0.0      !! riverine runoff
+      f_riv_n(:,:)   = 0.0      !! riverine N   input 
+      f_riv_si(:,:)  = 0.0      !! riverine Si  input 
+      f_riv_c(:,:)   = 0.0      !! riverine C   input 
+      f_riv_alk(:,:) = 0.0      !! riverine alk input 
+      !! 
+      !! Jpalm -- 06-03-2017 -- Forgotten var to init
+      f_omarg(:,:) = 0.0        !!
+      f_omcal(:,:) = 0.0 
+      xFree(:,:) = 0.0          !! state variables for iron-ligand system
+      fcomm_resp(:,:) = 0.0 
+      fprn_ml(:,:) = 0.0        !! mixed layer PP diagnostics
+      fprd_ml(:,:) = 0.0        !! mixed layer PP diagnostics
+      !! AXY (16/08/17)
+      fchl_ml(:,:) = 0.0	!! mixed layer chlorophyll diagnostics
+      !! 
+      fslownflux(:,:) = 0.0 
+      fslowcflux(:,:) = 0.0 
+      !!
+      !! JPALM -- 21-09-2017 -- needed to debug air-sea carb
+      f_xco2a(:,:)  = 0.0
+      f_pco2w(:,:)  = 0.0
+      f_ph(:,:)     = 0.0
+      f_kw660(:,:)  = 0.0
+      ztmp(:,:)  = 0.0
+      zsal(:,:)  = 0.0
+      zalk(:,:)  = 0.0
+      zdic(:,:)  = 0.0
+      zsil(:,:)  = 0.0
+      zpho(:,:)  = 0.0
+      f_co2flux(:,:)  = 0.0 
+      f_pco2atm(:,:)  = 0.0
+      f_h2co3(:,:)    = 0.0
+      f_hco3(:,:)     = 0.0
+      f_co3(:,:)      = 0.0
+      f_omarg(:,:)    = 0.0
+      f_omcal(:,:)    = 0.0
+      !!
+      !! AXY (08/08/17): zero slow detritus fluxes
+      fslowsink(:,:)  = 0.0
+# if defined key_roam
+      fslowsinkc(:,:) = 0.0
+# endif      
+      !!
+      !! allocate and initiate 2D diag
+      !! -----------------------------
+      !! Juju :: add kt condition !!
+      IF ( lk_iomput ) THEN 
+
+         !! initialise iom_use test
+         IF ( kt == nittrc000 )   CALL trc_nam_iom_medusa 
+
+         ALLOCATE( zw2d(1:jpi, 1:jpj) )
+         zw2d(:,:)      = 0.0   !!
+         IF ( med_diag%PRN%dgsave ) THEN
+            ALLOCATE( fprn2d(1:jpi, 1:jpj) )
+            fprn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF ( med_diag%MPN%dgsave ) THEN
+            ALLOCATE( fdpn2d(1:jpi, 1:jpj) )
+            fdpn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF ( med_diag%PRD%dgsave ) THEN
+            ALLOCATE( fprd2d(1:jpi, 1:jpj) )
+            fprd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MPD%dgsave ) THEN
+            ALLOCATE( fdpd2d(1:jpi, 1:jpj) )
+            fdpd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OPAL%dgsave ) THEN
+            ALLOCATE( fprds2d(1:jpi, 1:jpj) )
+            fprds2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OPALDISS%dgsave ) THEN
+            ALLOCATE( fsdiss2d(1:jpi, 1:jpj) )
+            fsdiss2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMIPn%dgsave ) THEN
+            ALLOCATE( fgmipn2d(1:jpi, 1:jpj) )
+            fgmipn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMID%dgsave ) THEN
+            ALLOCATE( fgmid2d(1:jpi, 1:jpj) )
+            fgmid2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MZMI%dgsave ) THEN
+            ALLOCATE( fdzmi2d(1:jpi, 1:jpj) )
+            fdzmi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEPN%dgsave ) THEN
+            ALLOCATE( fgmepn2d(1:jpi, 1:jpj) )
+            fgmepn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEPD%dgsave ) THEN
+            ALLOCATE( fgmepd2d(1:jpi, 1:jpj) )
+            fgmepd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEZMI%dgsave ) THEN
+            ALLOCATE( fgmezmi2d(1:jpi, 1:jpj) )
+            fgmezmi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMED%dgsave ) THEN
+            ALLOCATE( fgmed2d(1:jpi, 1:jpj) )
+            fgmed2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MZME%dgsave ) THEN
+            ALLOCATE( fdzme2d(1:jpi, 1:jpj) )
+            fdzme2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%DETN%dgsave ) THEN
+            ALLOCATE( fslown2d(1:jpi, 1:jpj) )
+            fslown2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MDET%dgsave ) THEN
+            ALLOCATE( fdd2d(1:jpi, 1:jpj) )
+            fdd2d(:,:)      = 0.0 !!
+         ENDIF      
+         IF( med_diag%AEOLIAN%dgsave ) THEN
+            ALLOCATE( ffetop2d(1:jpi, 1:jpj) )
+            ffetop2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%BENTHIC%dgsave ) THEN
+            ALLOCATE( ffebot2d(1:jpi, 1:jpj) )
+            ffebot2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%SCAVENGE%dgsave ) THEN
+            ALLOCATE( ffescav2d(1:jpi, 1:jpj) )
+            ffescav2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_JLIM%dgsave ) THEN
+            ALLOCATE( fjln2d(1:jpi, 1:jpj) )
+            fjln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_NLIM%dgsave ) THEN
+            ALLOCATE( fnln2d(1:jpi, 1:jpj) )
+            fnln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_FELIM%dgsave ) THEN
+            ALLOCATE( ffln2d(1:jpi, 1:jpj) )
+            ffln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_JLIM%dgsave ) THEN
+            ALLOCATE( fjld2d(1:jpi, 1:jpj) )
+            fjld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_NLIM%dgsave ) THEN
+            ALLOCATE( fnld2d(1:jpi, 1:jpj) )
+            fnld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_FELIM%dgsave ) THEN
+            ALLOCATE( ffld2d(1:jpi, 1:jpj) )
+            ffld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_SILIM%dgsave ) THEN
+            ALLOCATE( fsld2d2(1:jpi, 1:jpj) )
+            fsld2d2(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PDSILIM2%dgsave ) THEN
+            ALLOCATE( fsld2d(1:jpi, 1:jpj) )
+            fsld2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip SDT_XXXX diagnostics here
+!!
+         IF( med_diag%TOTREG_N%dgsave ) THEN
+            ALLOCATE( fregen2d(1:jpi, 1:jpj) )
+            fregen2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%TOTRG_SI%dgsave ) THEN
+            ALLOCATE( fregensi2d(1:jpi, 1:jpj) )
+            fregensi2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip REG_XXXX diagnostics here
+!!
+         IF( med_diag%FASTN%dgsave ) THEN
+            ALLOCATE( ftempn2d(1:jpi, 1:jpj) )
+            ftempn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTSI%dgsave ) THEN
+            ALLOCATE( ftempsi2d(1:jpi, 1:jpj) )
+            ftempsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTFE%dgsave ) THEN
+            ALLOCATE( ftempfe2d(1:jpi, 1:jpj) )
+            ftempfe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTC%dgsave ) THEN
+            ALLOCATE( ftempc2d(1:jpi, 1:jpj) )
+            ftempc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTCA%dgsave ) THEN
+            ALLOCATE( ftempca2d(1:jpi, 1:jpj) )
+            ftempca2d(:,:)      = 0.0 !!
+         ENDIF     
+!!
+!! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here
+!!
+         IF( med_diag%REMINN%dgsave ) THEN
+            ALLOCATE( freminn2d(1:jpi, 1:jpj) )
+            freminn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINSI%dgsave ) THEN
+            ALLOCATE( freminsi2d(1:jpi, 1:jpj) )
+            freminsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINFE%dgsave ) THEN
+            ALLOCATE( freminfe2d(1:jpi, 1:jpj) )
+            freminfe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINC%dgsave ) THEN
+            ALLOCATE( freminc2d(1:jpi, 1:jpj) )
+            freminc2d(:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%REMINCA%dgsave ) THEN
+            ALLOCATE( freminca2d(1:jpi, 1:jpj) )
+            freminca2d(:,:)      = 0.0 !!
+         ENDIF
+
+# if defined key_roam
+!!
+!! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here
+!!
+         IF( med_diag%RR_0100%dgsave ) THEN
+            ALLOCATE( ffastca2d(1:jpi, 1:jpj) )
+            ffastca2d(:,:)      = 0.0 !!
+         ENDIF
+
+         IF( med_diag%ATM_PCO2%dgsave ) THEN
+            ALLOCATE( f_pco2a2d(1:jpi, 1:jpj) )
+            f_pco2a2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OCN_PH diagnostic here
+!!
+         IF( med_diag%OCN_PCO2%dgsave ) THEN
+            ALLOCATE( f_pco2w2d(1:jpi, 1:jpj) )
+            f_pco2w2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here
+!!
+         IF( med_diag%CO2FLUX%dgsave ) THEN
+            ALLOCATE( f_co2flux2d(1:jpi, 1:jpj) )
+            f_co2flux2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OM_XXX diagnostics here
+!!
+         IF( med_diag%TCO2%dgsave ) THEN
+            ALLOCATE( f_TDIC2d(1:jpi, 1:jpj) )
+            f_TDIC2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%TALK%dgsave ) THEN
+            ALLOCATE( f_TALK2d(1:jpi, 1:jpj) )
+            f_TALK2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%KW660%dgsave ) THEN
+            ALLOCATE( f_kw6602d(1:jpi, 1:jpj) )
+            f_kw6602d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ATM_PP0%dgsave ) THEN
+            ALLOCATE( f_pp02d(1:jpi, 1:jpj) )
+            f_pp02d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%O2FLUX%dgsave ) THEN
+            ALLOCATE( f_o2flux2d(1:jpi, 1:jpj) )
+            f_o2flux2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%O2SAT%dgsave ) THEN
+            ALLOCATE( f_o2sat2d(1:jpi, 1:jpj) )
+            f_o2sat2d(:,:)      = 0.0 !!
+         ENDIF 
+!!
+!! skip XXX_CCD diagnostics here
+!! 
+         IF( med_diag%SFR_OCAL%dgsave ) THEN
+            ALLOCATE( sfr_ocal2d(1:jpi, 1:jpj) )
+            sfr_ocal2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%SFR_OARG%dgsave ) THEN
+            ALLOCATE( sfr_oarg2d(1:jpi, 1:jpj) )
+            sfr_oarg2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here
+!! 
+         IF( med_diag%IBEN_N%dgsave ) THEN
+            ALLOCATE( iben_n2d(1:jpi, 1:jpj) )
+            iben_n2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_FE%dgsave ) THEN
+            ALLOCATE( iben_fe2d(1:jpi, 1:jpj) )
+            iben_fe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_C%dgsave ) THEN
+            ALLOCATE( iben_c2d(1:jpi, 1:jpj) )
+            iben_c2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_SI%dgsave ) THEN
+            ALLOCATE( iben_si2d(1:jpi, 1:jpj) )
+            iben_si2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_CA%dgsave ) THEN
+            ALLOCATE( iben_ca2d(1:jpi, 1:jpj) )
+            iben_ca2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_N%dgsave ) THEN
+            ALLOCATE( oben_n2d(1:jpi, 1:jpj) )
+            oben_n2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_FE%dgsave ) THEN
+            ALLOCATE( oben_fe2d(1:jpi, 1:jpj) )
+            oben_fe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_C%dgsave ) THEN
+            ALLOCATE( oben_c2d(1:jpi, 1:jpj) )
+            oben_c2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_SI%dgsave ) THEN
+            ALLOCATE( oben_si2d(1:jpi, 1:jpj) )
+            oben_si2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_CA%dgsave ) THEN
+            ALLOCATE( oben_ca2d(1:jpi, 1:jpj) )
+            oben_ca2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip BEN_XX diagnostics here
+!!
+
+         IF( med_diag%RIV_N%dgsave ) THEN
+            ALLOCATE( rivn2d(1:jpi, 1:jpj) )
+            rivn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_SI%dgsave ) THEN
+            ALLOCATE( rivsi2d(1:jpi, 1:jpj) )
+            rivsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_C%dgsave ) THEN
+            ALLOCATE( rivc2d(1:jpi, 1:jpj) )
+            rivc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_ALK%dgsave ) THEN
+            ALLOCATE( rivalk2d(1:jpi, 1:jpj) )
+            rivalk2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%DETC%dgsave ) THEN
+            ALLOCATE( fslowc2d(1:jpi, 1:jpj) )
+            fslowc2d(:,:)      = 0.0 !!
+         ENDIF 
+!!
+!! skip SDC_XXXX, INVTXXX diagnostics here
+!!
+         IF( med_diag%LYSO_CA%dgsave ) THEN
+            ALLOCATE( lyso_ca2d(1:jpi, 1:jpj) )
+            lyso_ca2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip COM_RESP diagnostic here
+!!
+         IF( med_diag%PN_LLOSS%dgsave ) THEN
+            ALLOCATE( fdpn22d(1:jpi, 1:jpj) )
+            fdpn22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_LLOSS%dgsave ) THEN
+            ALLOCATE( fdpd22d(1:jpi, 1:jpj) )
+            fdpd22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_LLOSS%dgsave ) THEN
+            ALLOCATE( fdzmi22d(1:jpi, 1:jpj) )
+            fdzmi22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_LLOSS%dgsave ) THEN
+            ALLOCATE( fdzme22d(1:jpi, 1:jpj) )
+            fdzme22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_N%dgsave ) THEN   
+            ALLOCATE( zimesn2d(1:jpi, 1:jpj) )
+            zimesn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_D%dgsave ) THEN
+            ALLOCATE( zimesd2d(1:jpi, 1:jpj) )
+            zimesd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_C%dgsave ) THEN
+            ALLOCATE( zimesc2d(1:jpi, 1:jpj) )
+            zimesc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MESDC%dgsave ) THEN
+            ALLOCATE( zimesdc2d(1:jpi, 1:jpj) )
+            zimesdc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_EXCR%dgsave ) THEN
+            ALLOCATE( ziexcr2d(1:jpi, 1:jpj) )
+            ziexcr2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_RESP%dgsave ) THEN
+            ALLOCATE( ziresp2d(1:jpi, 1:jpj) )
+            ziresp2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_GROW%dgsave ) THEN
+            ALLOCATE( zigrow2d(1:jpi, 1:jpj) )
+            zigrow2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_N%dgsave ) THEN
+            ALLOCATE( zemesn2d(1:jpi, 1:jpj) )
+            zemesn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_D%dgsave ) THEN
+            ALLOCATE( zemesd2d(1:jpi, 1:jpj) )
+            zemesd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_C%dgsave ) THEN
+            ALLOCATE( zemesc2d(1:jpi, 1:jpj) )
+            zemesc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MESDC%dgsave ) THEN
+            ALLOCATE( zemesdc2d(1:jpi, 1:jpj) )
+            zemesdc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_EXCR%dgsave ) THEN
+            ALLOCATE( zeexcr2d(1:jpi, 1:jpj) )
+            zeexcr2d(:,:)      = 0.0 !!
+         ENDIF                  
+         IF( med_diag%ZE_RESP%dgsave ) THEN
+            ALLOCATE( zeresp2d(1:jpi, 1:jpj) )
+            zeresp2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_GROW%dgsave ) THEN
+            ALLOCATE( zegrow2d(1:jpi, 1:jpj) )
+            zegrow2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MDETC%dgsave ) THEN
+            ALLOCATE( mdetc2d(1:jpi, 1:jpj) )
+            mdetc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMIDC%dgsave ) THEN
+            ALLOCATE( gmidc2d(1:jpi, 1:jpj) )
+            gmidc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEDC%dgsave ) THEN
+            ALLOCATE( gmedc2d(1:jpi, 1:jpj) )
+            gmedc2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip INT_XXX diagnostics here
+!!
+         IF (jdms .eq. 1) THEN
+            IF( med_diag%DMS_SURF%dgsave ) THEN
+               ALLOCATE( dms_surf2d(1:jpi, 1:jpj) )
+               dms_surf2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ANDR%dgsave ) THEN
+               ALLOCATE( dms_andr2d(1:jpi, 1:jpj) )
+               dms_andr2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_SIMO%dgsave ) THEN
+               ALLOCATE( dms_simo2d(1:jpi, 1:jpj) )
+               dms_simo2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ARAN%dgsave ) THEN
+               ALLOCATE( dms_aran2d(1:jpi, 1:jpj) )
+               dms_aran2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_HALL%dgsave ) THEN
+               ALLOCATE( dms_hall2d(1:jpi, 1:jpj) )
+               dms_hall2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ANDM%dgsave ) THEN
+               ALLOCATE( dms_andm2d(1:jpi, 1:jpj) )
+               dms_andm2d(:,:)      = 0.0 !!
+            ENDIF
+         ENDIF   
+         !!
+         !! AXY (24/11/16): extra MOCSY diagnostics, 2D
+         IF( med_diag%ATM_XCO2%dgsave ) THEN
+            ALLOCATE( f_xco2a_2d(1:jpi, 1:jpj) )
+            f_xco2a_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_FCO2%dgsave ) THEN
+            ALLOCATE( f_fco2w_2d(1:jpi, 1:jpj) )
+            f_fco2w_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ATM_FCO2%dgsave ) THEN
+            ALLOCATE( f_fco2a_2d(1:jpi, 1:jpj) )
+            f_fco2a_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_RHOSW%dgsave ) THEN
+            ALLOCATE( f_ocnrhosw_2d(1:jpi, 1:jpj) )
+            f_ocnrhosw_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+            ALLOCATE( f_ocnschco2_2d(1:jpi, 1:jpj) )
+            f_ocnschco2_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_KWCO2%dgsave ) THEN
+            ALLOCATE( f_ocnkwco2_2d(1:jpi, 1:jpj) )
+            f_ocnkwco2_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_K0%dgsave ) THEN
+            ALLOCATE( f_ocnk0_2d(1:jpi, 1:jpj) )
+            f_ocnk0_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%CO2STARAIR%dgsave ) THEN
+            ALLOCATE( f_co2starair_2d(1:jpi, 1:jpj) )
+            f_co2starair_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_DPCO2%dgsave ) THEN
+            ALLOCATE( f_ocndpco2_2d(1:jpi, 1:jpj) )
+            f_ocndpco2_2d(:,:)      = 0.0 !!
+         ENDIF
+# endif  
+         IF( med_diag%TPP3%dgsave ) THEN
+            ALLOCATE( tpp3d(1:jpi, 1:jpj, 1:jpk) )
+            tpp3d(:,:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%DETFLUX3%dgsave ) THEN
+            ALLOCATE( detflux3d(1:jpi, 1:jpj, 1:jpk) )
+            detflux3d(:,:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%REMIN3N%dgsave ) THEN
+             ALLOCATE( remin3dn(1:jpi, 1:jpj, 1:jpk) )
+             remin3dn(:,:,:)      = 0.0 !! 
+         ENDIF
+         !! 
+         !! AXY (10/11/16): CMIP6 diagnostics, 2D
+         !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request
+         !!                   needed for coupling/passed through restart
+         !! IF( med_diag%FGCO2%dgsave ) THEN
+            ALLOCATE( fgco2(1:jpi, 1:jpj) )
+            fgco2(:,:)      = 0.0 !!
+         !! ENDIF
+         IF( med_diag%INTDISSIC%dgsave ) THEN
+            ALLOCATE( intdissic(1:jpi, 1:jpj) )
+            intdissic(:,:)  = 0.0 !!
+         ENDIF          
+         IF( med_diag%INTDISSIN%dgsave ) THEN
+            ALLOCATE( intdissin(1:jpi, 1:jpj) )
+            intdissin(:,:)  = 0.0 !!
+         ENDIF          
+         IF( med_diag%INTDISSISI%dgsave ) THEN
+            ALLOCATE( intdissisi(1:jpi, 1:jpj) )
+            intdissisi(:,:)  = 0.0 !!
+         ENDIF          
+         IF( med_diag%INTTALK%dgsave ) THEN
+            ALLOCATE( inttalk(1:jpi, 1:jpj) )
+            inttalk(:,:)  = 0.0 !!
+         ENDIF          
+         IF( med_diag%O2min%dgsave ) THEN
+            ALLOCATE( o2min(1:jpi, 1:jpj) )
+            o2min(:,:)  = 1.e3 !! set to high value as we're looking for min(o2)
+         ENDIF          
+         IF( med_diag%ZO2min%dgsave ) THEN
+            ALLOCATE( zo2min(1:jpi, 1:jpj) )
+            zo2min(:,:)  = 0.0 !!
+         ENDIF          
+         IF( med_diag%FBDDTALK%dgsave  ) THEN
+            ALLOCATE( fbddtalk(1:jpi, 1:jpj) )
+            fbddtalk(:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%FBDDTDIC%dgsave  ) THEN
+            ALLOCATE( fbddtdic(1:jpi, 1:jpj) )
+            fbddtdic(:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%FBDDTDIFE%dgsave ) THEN
+            ALLOCATE( fbddtdife(1:jpi, 1:jpj) )
+            fbddtdife(:,:) = 0.0 !! 
+         ENDIF
+         IF( med_diag%FBDDTDIN%dgsave  ) THEN
+            ALLOCATE( fbddtdin(1:jpi, 1:jpj) )
+            fbddtdin(:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%FBDDTDISI%dgsave ) THEN
+            ALLOCATE( fbddtdisi(1:jpi, 1:jpj) )
+            fbddtdisi(:,:) = 0.0 !! 
+         ENDIF
+         !! 
+         !! AXY (10/11/16): CMIP6 diagnostics, 3D
+         IF( med_diag%TPPD3%dgsave     ) THEN
+            ALLOCATE( tppd3(1:jpi, 1:jpj, 1:jpk) )
+            tppd3(:,:,:)     = 0.0 !! 
+         ENDIF
+         IF( med_diag%BDDTALK3%dgsave  ) THEN
+            ALLOCATE( bddtalk3(1:jpi, 1:jpj, 1:jpk) )
+            bddtalk3(:,:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%BDDTDIC3%dgsave  ) THEN
+            ALLOCATE( bddtdic3(1:jpi, 1:jpj, 1:jpk) )
+            bddtdic3(:,:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%BDDTDIFE3%dgsave ) THEN
+            ALLOCATE( bddtdife3(1:jpi, 1:jpj, 1:jpk) )
+            bddtdife3(:,:,:) = 0.0 !! 
+         ENDIF
+         IF( med_diag%BDDTDIN3%dgsave  ) THEN
+            ALLOCATE( bddtdin3(1:jpi, 1:jpj, 1:jpk) )
+            bddtdin3(:,:,:)  = 0.0 !! 
+         ENDIF
+         IF( med_diag%BDDTDISI3%dgsave ) THEN
+            ALLOCATE( bddtdisi3(1:jpi, 1:jpj, 1:jpk) )
+            bddtdisi3(:,:,:) = 0.0 !! 
+         ENDIF
+         IF( med_diag%FD_NIT3%dgsave   ) THEN
+            ALLOCATE( fd_nit3(1:jpi, 1:jpj, 1:jpk) )
+            fd_nit3(:,:,:)   = 0.0 !! 
+         ENDIF
+         IF( med_diag%FD_SIL3%dgsave   ) THEN
+            ALLOCATE( fd_sil3(1:jpi, 1:jpj, 1:jpk) )
+            fd_sil3(:,:,:)   = 0.0 !! 
+         ENDIF
+         IF( med_diag%FD_CAR3%dgsave   ) THEN
+            ALLOCATE( fd_car3(1:jpi, 1:jpj, 1:jpk) )
+            fd_car3(:,:,:)   = 0.0 !! 
+         ENDIF
+         IF( med_diag%FD_CAL3%dgsave   ) THEN
+            ALLOCATE( fd_cal3(1:jpi, 1:jpj, 1:jpk) )
+            fd_cal3(:,:,:)   = 0.0 !! 
+         ENDIF
+         IF( med_diag%DCALC3%dgsave    ) THEN
+            ALLOCATE( dcalc3(1:jpi, 1:jpj, 1:jpk) )
+            dcalc3(:,:,: )   = 0.0 !! 
+         ENDIF
+         IF( med_diag%EXPC3%dgsave     ) THEN
+            ALLOCATE( expc3(1:jpi, 1:jpj, 1:jpk) )
+            expc3(:,:,: )    = 0.0 !! 
+         ENDIF
+         IF( med_diag%EXPN3%dgsave     ) THEN
+            ALLOCATE( expn3(1:jpi, 1:jpj, 1:jpk) )
+            expn3(:,:,: )    = 0.0 !! 
+         ENDIF
+         IF( med_diag%FEDISS3%dgsave   ) THEN
+            ALLOCATE( fediss3(1:jpi, 1:jpj, 1:jpk) )
+            fediss3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%FESCAV3%dgsave   ) THEN
+            ALLOCATE( fescav3(1:jpi, 1:jpj, 1:jpk) )
+            fescav3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%MIGRAZP3%dgsave   ) THEN
+            ALLOCATE( migrazp3(1:jpi, 1:jpj, 1:jpk) )
+            migrazp3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%MIGRAZD3%dgsave   ) THEN
+            ALLOCATE( migrazd3(1:jpi, 1:jpj, 1:jpk) )
+            migrazd3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%MEGRAZP3%dgsave   ) THEN
+            ALLOCATE( megrazp3(1:jpi, 1:jpj, 1:jpk) )
+            megrazp3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%MEGRAZD3%dgsave   ) THEN
+            ALLOCATE( megrazd3(1:jpi, 1:jpj, 1:jpk) )
+            megrazd3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%MEGRAZZ3%dgsave   ) THEN
+            ALLOCATE( megrazz3(1:jpi, 1:jpj, 1:jpk) )
+            megrazz3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%O2SAT3%dgsave     ) THEN
+            ALLOCATE( o2sat3(1:jpi, 1:jpj, 1:jpk) )
+            o2sat3(:,:,: )    = 0.0 !! 
+         ENDIF
+         IF( med_diag%PBSI3%dgsave      ) THEN
+            ALLOCATE( pbsi3(1:jpi, 1:jpj, 1:jpk) )
+            pbsi3(:,:,: )     = 0.0 !! 
+         ENDIF
+         IF( med_diag%PCAL3%dgsave      ) THEN
+            ALLOCATE( pcal3(1:jpi, 1:jpj, 1:jpk) )
+            pcal3(:,:,: )     = 0.0 !! 
+         ENDIF
+         IF( med_diag%REMOC3%dgsave     ) THEN
+            ALLOCATE( remoc3(1:jpi, 1:jpj, 1:jpk) )
+            remoc3(:,:,: )    = 0.0 !! 
+         ENDIF
+         IF( med_diag%PNLIMJ3%dgsave    ) THEN
+            ALLOCATE( pnlimj3(1:jpi, 1:jpj, 1:jpk) )
+            pnlimj3(:,:,: )   = 0.0 !! 
+         ENDIF
+         IF( med_diag%PNLIMN3%dgsave    ) THEN
+            ALLOCATE( pnlimn3(1:jpi, 1:jpj, 1:jpk) )
+            pnlimn3(:,:,: )   = 0.0 !! 
+         ENDIF
+         IF( med_diag%PNLIMFE3%dgsave   ) THEN
+            ALLOCATE( pnlimfe3(1:jpi, 1:jpj, 1:jpk) )
+            pnlimfe3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%PDLIMJ3%dgsave    ) THEN
+            ALLOCATE( pdlimj3(1:jpi, 1:jpj, 1:jpk) )
+            pdlimj3(:,:,: )   = 0.0 !! 
+         ENDIF
+         IF( med_diag%PDLIMN3%dgsave    ) THEN
+            ALLOCATE( pdlimn3(1:jpi, 1:jpj, 1:jpk) )
+            pdlimn3(:,:,: )   = 0.0 !! 
+         ENDIF
+         IF( med_diag%PDLIMFE3%dgsave   ) THEN
+            ALLOCATE( pdlimfe3(1:jpi, 1:jpj, 1:jpk) )
+            pdlimfe3(:,:,: )  = 0.0 !! 
+         ENDIF
+         IF( med_diag%PDLIMSI3%dgsave   ) THEN
+            ALLOCATE( pdlimsi3(1:jpi, 1:jpj, 1:jpk) )
+            pdlimsi3(:,:,: )  = 0.0 !! 
+         ENDIF
+      ENDIF
+      !! lk_iomput
+
+   END SUBROUTINE bio_medusa_init
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_medusa_init( )                   ! Empty routine
+      WRITE(*,*) 'bio_medusa_init: You should not have seen this print! error?'
+   END SUBROUTINE bio_medusa_init
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_init_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_mod.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_mod.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_mod.F90	(revision 9824)
@@ -0,0 +1,408 @@
+MODULE bio_medusa_mod
+   !!======================================================================
+   !!                      ***  MODULE  bio_medusa_mod  ***
+   !! MEDUSA variables   :  module for MEDUSA variables which are shared
+   !!                       across subroutines 
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Slow detritus, ML-avg chl variables
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                           MEDUSA
+   !!----------------------------------------------------------------------
+   !! Variable conventions
+   !!----------------------------------------------------------------------
+   !!
+   !! names: z*** - state variable 
+   !!        f*** - function (or temporary variable used in part of a function)
+   !!        b*** - right-hand part (sources and sinks)
+   !!        i*** - integer variable (usually used in yes/no flags)
+   !!----------------------------------------------------------------------
+   USE par_kind,          ONLY: wp
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   bio_medusa_alloc     ! called by trcini.F90
+
+   !! model state variables
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zchn,zchd,zphn,zphd,zpds,zzmi
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zzme,zdet,zdtc,zdin,zsil,zfer
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdic, zalk, zoxy
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmp, zsal
+# endif
+# if defined key_mocsy
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpho
+# endif
+
+   !! integrated source and sink terms
+   REAL(wp) ::    b0
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,fprn,frn
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fprd,frd
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn,fjlim_pd
+   !! AXY (16/07/09): add in Eppley curve functionality
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_T,xvpnT,xvpdT
+
+   !! AXY (16/05/11): per Katya's prompting, add in new T-dependence
+   !!                 for phytoplankton growth only (i.e. no change
+   !!                 for remineralisation)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_Q10
+   !! AXY (01/03/10): add in mixed layer PP diagnostics
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn_ml,fprd_ml
+   !! AXY (16/08/17): add in mixed layer chlorophyll diagnostic
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fchl_ml
+   !!
+   !! nutrient limiting factors
+   !! N and Fe (renaming ffln to ffln2 to avoid conflict with
+   !! ffln in module sms_medusa - marc 25/4/17)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnln,ffln2
+   !! N, Fe and Si
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnld,ffld,fsld,fsld2
+   !!
+   !! silicon cycle
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,fprds,fsdiss
+
+   !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffetop,ffebot,ffescav
+   !! Variable for iron-ligand system
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: xFree
+
+   !! Microzooplankton grazing
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmipn,fgmid,fgmidc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmigrow,fmiexcr,fmiresp
+   !!
+   !! Mesozooplankton grazing
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepn,fgmepd
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepds,fgmezmi,fgmed,fgmedc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmegrow,fmeexcr,fmeresp
+   !!
+   !! mortality/Remineralisation
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn,fdpd,fdpds,fdzmi,fdzme,fdd
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fddc
+# endif
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslown, fslowc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslownflux, fslowcflux
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregen,fregensi
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfast,fregenfastsi
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfastc
+# endif
+   !!
+   !! AXY (08/08/17): sinking of detritus moved here
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::    fslowsink, fslowgain, fslowloss
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::    fslowsinkc, fslowgainc, fslowlossc
+# endif
+   !!
+   !! Particle flux
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn,ftempsi,ftempfe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc,ftempca
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminn,freminsi,freminfe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminc,freminca
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastn,ffastsi,ffastfe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastc,ffastca
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsedn,fsedsi,fsedfe,fsedc,fsedca
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd
+
+   !! AXY (08/07/11): fate of fast detritus reaching the seafloor
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffast2slown,ffast2slowc
+
+   !! water column nutrient and flux integrals
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_n,ftot_si,ftot_fe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fflx_n,fflx_si,fflx_fe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_n,fifd_si,fifd_fe
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_n,fofd_si,fofd_fe
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_c,ftot_a,ftot_o2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fflx_c,fflx_a,fflx_o2
+! I don't think fifd_a, fifd_o2, fofd_a or fofd_o2 are used - marc 11/5/17
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_c,fifd_a,fifd_o2
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_c,fofd_a,fofd_o2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_c
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_c
+# endif
+
+   !! Zooplankton grazing integrals
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fzmi_i,fzmi_o,fzme_i,fzme_o
+
+   !! Limitation term temporary variables
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_pn,ftot_pd
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_zmi,ftot_zme,ftot_det,ftot_dtc
+
+   !! use biological fluxes (1) or not (0)
+   INTEGER  ::    ibio_switch
+   !!
+   !! diagnose fluxes (should only be used in 1D runs)
+   INTEGER                               :: idf, idfval
+
+   !! Nitrogen and silicon production and consumption
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnit_prod,fnit_cons
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsil_prod,fsil_cons
+
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_xco2a
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ph,f_pco2w,f_h2co3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_hco3,f_co3,f_co2flux
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_TDIC,f_TALK,f_dcf,f_henry
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pp0
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_kw660,f_o2flux,f_o2sat
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_omcal,f_omarg
+
+   !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2atm
+
+   !! Carbon, alkalinity production and consumption
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fcomm_resp
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fcar_prod,fcar_cons
+
+   !! Oxygen production and consumption (and non-consumption)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: foxy_prod,foxy_cons,foxy_anox
+
+   !! Add DMS in MEDUSA for UKESM1 model
+   REAL(wp)                              :: dms_surf,dms_andm
+   !! AXY (13/03/15): add in other DMS calculations
+   REAL(wp)                              :: dms_andr,dms_simo,dms_aran,dms_hall
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_nlim, dms_wtkn
+# endif
+
+   !! Benthic fluxes
+   INTEGER  ::    ibenthic
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_sbenin_n,f_sbenin_fe,f_sbenin_c
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fbenin_n,f_fbenin_fe,f_fbenin_si
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fbenin_c,f_fbenin_ca
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_n,f_benout_fe,f_benout_si 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_c,f_benout_ca
+
+   !! Benthic fluxes of CaCO3 that shouldn't happen because of lysocline
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_lyso_ca
+
+   !! riverine fluxes
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_runoff,f_riv_n,f_riv_si
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_c,f_riv_alk
+   !! AXY (19/07/12): variables for local riverine fluxes to handle 
+   !! inputs below surface
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_n,f_riv_loc_si
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_c, f_riv_loc_alk
+
+   !! Jpalm -- 11-10-2015 -- adapt diag to iom_use
+   !! 2D var for diagnostics.
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn2d, fdpn2d, fprd2d, fdpd2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprds2d, fsdiss2d, fgmipn2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmid2d, fdzmi2d, fgmepn2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepd2d, fgmezmi2d, fgmed2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdzme2d, fslown2d, fdd2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffetop2d, ffebot2d, ffescav2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjln2d, fnln2d, ffln2d, fjld2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnld2d, ffld2d, fsld2d2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsld2d, fregen2d, fregensi2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn2d, ftempsi2d, ftempfe2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc2d, ftempca2d, freminn2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminsi2d, freminfe2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminc2d, freminca2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
+# if defined key_roam
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastca2d, rivn2d, rivsi2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: rivc2d, rivalk2d, fslowc2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn22d, fdpd22d, fdzmi22d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdzme22d, zimesn2d, zimesd2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zimesc2d, zimesdc2d, ziexcr2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ziresp2d, zigrow2d, zemesn2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zemesd2d, zemesc2d, zemesdc2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zeexcr2d, zeresp2d, zegrow2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: mdetc2d, gmidc2d, gmedc2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2a2d, f_pco2w2d, f_co2flux2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_TDIC2d, f_TALK2d, f_kw6602d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pp02d, f_o2flux2d, f_o2sat2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_andr2d, dms_simo2d, dms_aran2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_hall2d, dms_andm2d, dms_surf2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: iben_n2d, iben_fe2d, iben_c2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: iben_si2d, iben_ca2d, oben_n2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: oben_fe2d, oben_c2d, oben_si2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: oben_ca2d, sfr_ocal2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sfr_oarg2d, lyso_ca2d 
+   !! AXY (23/11/16): extra MOCSY diagnostics
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnrhosw_2d, f_ocnschco2_2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnkwco2_2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnk0_2d, f_co2starair_2d
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocndpco2_2d
+# endif
+   !!
+   !! 3D var for diagnostics.
+   REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn
+   !!
+# if defined key_roam
+   !! AXY (04/11/16)
+   !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef 
+   !! for simplicity)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgco2,intdissic,intdissin
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: intdissisi,inttalk,o2min,zo2min
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fbddtalk,fbddtdic,fbddtdife
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fbddtdin,fbddtdisi
+   !!
+   !! 3D var for new CMIP6 diagnostics
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tppd3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: bddtalk3,bddtdic3,bddtdife3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: bddtdin3, bddtdisi3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: fd_nit3,fd_sil3,fd_car3,fd_cal3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: co33,co3satarag3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: co3satcalc3,dcalc3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: expc3,expn3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: fediss3,fescav3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: migrazp3,migrazd3,megrazp3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: megrazd3, megrazz3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: o2sat3,pbsi3,pcal3,remoc3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pnlimj3,pnlimn3,pnlimfe3
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pdlimj3,pdlimn3,pdlimfe3,pdlimsi3
+# endif
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION bio_medusa_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE bio_medusa_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp,           ONLY: ctl_warn
+      USE par_oce,           ONLY: jpi, jpj
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE(zchn(jpi,jpj),zchd(jpi,jpj),zphn(jpi,jpj),             &
+               zphd(jpi,jpj),zpds(jpi,jpj),zzmi(jpi,jpj),             &
+               zzme(jpi,jpj),zdet(jpi,jpj),zdtc(jpi,jpj),             &
+               zdin(jpi,jpj),zsil(jpi,jpj),zfer(jpi,jpj),             &
+# if defined key_roam
+               zdic(jpi,jpj),zalk(jpi,jpj),zoxy(jpi,jpj),             &
+               ztmp(jpi,jpj),zsal(jpi,jpj),                           &
+# endif
+# if defined key_mocsy
+               zpho(jpi,jpj),                                         &
+# endif
+               fthetan(jpi,jpj),fprn(jpi,jpj),frn(jpi,jpj),           &
+               fthetad(jpi,jpj),fprd(jpi,jpj),frd(jpi,jpj),           &
+               fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj),                   &
+               fun_T(jpi,jpj),fun_Q10(jpi,jpj),                       &
+               fprn_ml(jpi,jpj),fprd_ml(jpi,jpj),fchl_ml(jpi,jpj),    &
+               fnln(jpi,jpj),ffln2(jpi,jpj),                          &
+               fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj),             &
+               fsld2(jpi,jpj),                                        &
+               fsin(jpi,jpj),fprds(jpi,jpj),fsdiss(jpi,jpj),          &
+               ffetop(jpi,jpj),ffebot(jpi,jpj),ffescav(jpi,jpj),      &
+               xFree(jpi,jpj),                                        &
+               fgmipn(jpi,jpj),fgmid(jpi,jpj),fgmidc(jpi,jpj),        &
+               finmi(jpi,jpj),ficmi(jpi,jpj),                         &
+               fmigrow(jpi,jpj),fmiexcr(jpi,jpj),fmiresp(jpi,jpj),    &
+               fgmepn(jpi,jpj),fgmepd(jpi,jpj),                       &
+               fgmepds(jpi,jpj),fgmezmi(jpi,jpj),fgmed(jpi,jpj),      &
+               fgmedc(jpi,jpj),                                       &
+               finme(jpi,jpj),ficme(jpi,jpj),                         &
+               fmegrow(jpi,jpj),fmeexcr(jpi,jpj),fmeresp(jpi,jpj),    &
+               fdpn(jpi,jpj),fdpd(jpi,jpj),fdpds(jpi,jpj),            &
+               fdzmi(jpi,jpj),fdzme(jpi,jpj),fdd(jpi,jpj),            &
+# if defined key_roam
+               fddc(jpi,jpj),                                         &
+# endif
+               fdpn2(jpi,jpj),fdpd2(jpi,jpj),fdpds2(jpi,jpj),         &
+               fdzmi2(jpi,jpj),fdzme2(jpi,jpj),                       &
+               fslown(jpi,jpj),fslowc(jpi,jpj),                       &
+               fslownflux(jpi,jpj),fslowcflux(jpi,jpj),               &
+               fregen(jpi,jpj),fregensi(jpi,jpj),                     &
+               fregenfast(jpi,jpj),fregenfastsi(jpi,jpj),             &
+# if defined key_roam
+               fregenfastc(jpi,jpj),                                  &
+# endif
+	       fslowsink(jpi,jpj),fslowgain(jpi,jpj),                 &
+               fslowloss(jpi,jpj),                                    &
+# if defined key_roam
+	       fslowsinkc(jpi,jpj),fslowgainc(jpi,jpj),               &
+               fslowlossc(jpi,jpj),                                   &
+# endif
+               fdep1(jpi,jpj),                                        &
+               ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj),     &
+               ftempc(jpi,jpj),ftempca(jpi,jpj),                      &
+               freminn(jpi,jpj),freminsi(jpi,jpj),freminfe(jpi,jpj),  &
+               freminc(jpi,jpj),freminca(jpi,jpj),                    &
+               ffastn(jpi,jpj),ffastsi(jpi,jpj),ffastfe(jpi,jpj),     &
+               ffastc(jpi,jpj),ffastca(jpi,jpj),                      &
+               fsedn(jpi,jpj),fsedsi(jpi,jpj),fsedfe(jpi,jpj),        &
+               fsedc(jpi,jpj),fsedca(jpi,jpj),                        &
+               fccd(jpi,jpj),                                         &
+               ffast2slown(jpi,jpj),ffast2slowc(jpi,jpj),             &
+               ftot_n(jpi,jpj),ftot_si(jpi,jpj),ftot_fe(jpi,jpj),     &
+               fflx_n(jpi,jpj),fflx_si(jpi,jpj),fflx_fe(jpi,jpj),     &
+               fifd_n(jpi,jpj),fifd_si(jpi,jpj),fifd_fe(jpi,jpj),     &
+               fofd_n(jpi,jpj),fofd_si(jpi,jpj),fofd_fe(jpi,jpj),     &
+# if defined key_roam
+               ftot_c(jpi,jpj),ftot_a(jpi,jpj),ftot_o2(jpi,jpj),      &
+               fflx_c(jpi,jpj),fflx_a(jpi,jpj),fflx_o2(jpi,jpj),      &
+! I don't think fifd_a, fifd_o2, fofd_a or fofd_o2 are used - marc 11/5/17
+!               fifd_c(jpi,jpj),fifd_a(jpi,jpj),fifd_o2(jpi,jpj),      &
+!               fofd_c(jpi,jpj),fofd_a(jpi,jpj),fofd_o2(jpi,jpj),      &
+               fifd_c(jpi,jpj), fofd_c(jpi,jpj),                      &
+# endif
+               fzmi_i(jpi,jpj),fzmi_o(jpi,jpj),fzme_i(jpi,jpj),       &
+               fzme_o(jpi,jpj),                                       &
+               ftot_pn(jpi,jpj),ftot_pd(jpi,jpj),                     &
+               ftot_zmi(jpi,jpj),ftot_zme(jpi,jpj),ftot_det(jpi,jpj), &
+               ftot_dtc(jpi,jpj),                                     &
+               fnit_prod(jpi,jpj),fnit_cons(jpi,jpj),                 &
+               fsil_prod(jpi,jpj),fsil_cons(jpi,jpj),                 &
+# if defined key_roam
+               f_xco2a(jpi,jpj),                                      &
+               f_ph(jpi,jpj),f_pco2w(jpi,jpj),f_h2co3(jpi,jpj),       &
+               f_hco3(jpi,jpj),f_co3(jpi,jpj),f_co2flux(jpi,jpj),     &
+               f_TDIC(jpi,jpj),f_TALK(jpi,jpj),f_dcf(jpi,jpj),        &
+               f_henry(jpi,jpj),                                      &
+               f_pp0(jpi,jpj),                                        &
+               f_kw660(jpi,jpj),f_o2flux(jpi,jpj),f_o2sat(jpi,jpj),   &
+               f_omcal(jpi,jpj),f_omarg(jpi,jpj),                     &
+               f_pco2atm(jpi,jpj),                 &
+               fcomm_resp(jpi,jpj),                                   &
+               fcar_prod(jpi,jpj),fcar_cons(jpi,jpj),                 &
+               foxy_prod(jpi,jpj), foxy_cons(jpi,jpj),                &
+               foxy_anox(jpi,jpj),                                    &
+               dms_nlim(jpi,jpj),dms_wtkn(jpi,jpj),                   &
+# endif
+               f_sbenin_n(jpi,jpj),f_sbenin_fe(jpi,jpj),              &
+               f_sbenin_c(jpi,jpj),                                   &
+               f_fbenin_n(jpi,jpj),f_fbenin_fe(jpi,jpj),              &
+               f_fbenin_si(jpi,jpj),                                  &
+               f_fbenin_c(jpi,jpj),f_fbenin_ca(jpi,jpj),              &
+               f_benout_n(jpi,jpj),f_benout_fe(jpi,jpj),              &
+               f_benout_si(jpi,jpj),                                  &
+               f_benout_c(jpi,jpj),f_benout_ca(jpi,jpj),              &
+               f_benout_lyso_ca(jpi,jpj),                             &
+               f_runoff(jpi,jpj),f_riv_n(jpi,jpj),f_riv_si(jpi,jpj),  &
+               f_riv_c(jpi,jpj),f_riv_alk(jpi,jpj),                   &
+               f_riv_loc_n(jpi,jpj),f_riv_loc_si(jpi,jpj),            &
+               f_riv_loc_c(jpi,jpj),f_riv_loc_alk(jpi,jpj),           &
+               STAT = bio_medusa_alloc)
+
+      !! Check that allocation was successful
+      IF ( bio_medusa_alloc /= 0 ) THEN  
+         CALL ctl_warn('bio_medusa_alloc: failed to allocate arrays')
+      END IF
+   
+   END FUNCTION bio_medusa_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                          No MEDUSA
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_update.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_update.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/bio_medusa_update.F90	(revision 9824)
@@ -0,0 +1,841 @@
+MODULE bio_medusa_update_mod
+   !!======================================================================
+   !!                         ***  MODULE bio_medusa_update_mod  ***
+   !! Update tracer fields
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Amend slow-detritus bug
+   !!   -   ! 2017-08 (A. Yool)            Reformatting for clarity
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   bio_medusa_update        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE bio_medusa_update( kt, jk )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE bio_medusa_update  ***
+      !! This called from TRC_BIO_MEDUSA and updates the tracer fields
+      !!---------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: b0, bddtalk3, bddtdic3, bddtdife3,        &
+                                   bddtdin3, bddtdisi3,                      &
+                                   ibenthic, ibio_switch, idf, idfval,       &
+                                   f_benout_c, f_benout_ca, f_benout_n,      &
+                                   f_benout_si,                              &
+                                   f_co2flux, f_o2flux,                      &
+                                   f_riv_loc_alk, f_riv_loc_c,               &
+                                   f_riv_loc_n, f_riv_loc_si,                & 
+                                   f_riv_alk, f_riv_c, f_riv_n, f_riv_si,    &
+                                   fbddtalk, fbddtdic, fbddtdife,            &
+                                   fbddtdin, fbddtdisi,                      & 
+                                   fdd, fdpd, fdpd2, fdpds, fdpds2,          &
+                                   fdpn, fdpn2,                              &
+                                   fdzme, fdzme2, fdzmi, fdzmi2,             &
+                                   ffast2slowc, ffast2slown,                 &
+                                   ffebot, ffetop, ffescav,                  &
+                                   fflx_fe, fflx_n, fflx_si,                 &
+                                   fgmed, fgmepd, fgmedc, fgmepd, fgmepds,   &
+                                   fgmepn, fgmezmi,                          &
+                                   fgmid, fgmidc, fgmipn,                    &
+                                   ficme, ficmi, finme, finmi,               &
+                                   fmeexcr, fmegrow, fmeresp,                &
+                                   fmiexcr, fmigrow, fmiresp,                &
+                                   fnit_cons, fnit_prod,                     &
+                                   fprd, fprds, fprn,                        &
+                                   frd,                                      &
+                                   freminc, freminca, freminn, freminsi,     &
+                                   frn,                                      &
+                                   fsil_cons, fsil_prod, fsdiss,             &
+                                   ftempca, fthetad, fthetan,                &
+                                   fslowsink, fslowgain, fslowloss,          & ! AXY (22/08/17)
+                                   f_sbenin_n, f_sbenin_c,                   &
+# if defined key_roam
+                                   fslowsinkc, fslowgainc, fslowlossc,       & ! AXY (22/08/17)
+                                   fcar_cons, fcar_prod, fcomm_resp,         &
+                                   fddc, fflx_a, fflx_c, fflx_o2, zoxy,      &
+                                   foxy_anox, foxy_cons, foxy_prod,          &
+# endif
+                                   zpds, zphd, zphn
+      USE dom_oce,           ONLY: e3t_0, e3t_n, gphit, mbathy, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+      USE lib_mpp,           ONLY: ctl_stop
+      USE par_kind,          ONLY: wp
+      USE par_medusa,        ONLY: jp_medusa, jp_msa0, jp_msa1,              &
+                                   jpalk, jpchd, jpchn, jpdet, jpdic,        &
+                                   jpdin, jpdtc, jpfer, jpoxy, jppds,        &
+                                   jpphd, jpphn, jpsil, jpzme, jpzmi,        &
+                                   jpalk_lc, jpchd_lc, jpchn_lc, jpdet_lc,   & 
+                                   jpdic_lc, jpdin_lc, jpdtc_lc, jpfer_lc,   & 
+                                   jpoxy_lc, jppds_lc, jpphd_lc, jpphn_lc,   &
+                                   jpsil_lc, jpzme_lc, jpzmi_lc
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1, jpk
+      USE par_trc,           ONLY: jptra
+      USE sms_medusa,        ONLY: friver_dep,                               &
+                                   jinorgben, jorgben,                       &
+                                   jriver_alk, jriver_c,                     &
+                                   jriver_n, jriver_si,                      &
+                                   xbetac, xbetan,                           &
+                                   xfdfrac1, xfdfrac2, xfdfrac3,             &
+                                   xo2min, xphi, xrfn,                       &
+                                   xthetanit, xthetapd, xthetapn,            &
+                                   xthetarem, xthetazme, xthetazmi,          &
+                                   xxi
+      USE trc,               ONLY: med_diag, tra
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) :: kt
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+
+      !! Loop variables
+      INTEGER :: ji, jj, jn
+
+      !! AXY (23/08/13): changed from individual variables for each flux to
+      !!                 an array that holds all fluxes
+      REAL(wp), DIMENSION(jpi,jpj,jp_medusa) :: btra
+
+      !! nitrogen and silicon production and consumption
+      REAL(wp) :: fn_prod, fn_cons, fs_prod, fs_cons
+
+      !! carbon, alkalinity production and consumption
+      REAL(wp) :: fc_prod, fc_cons, fa_prod, fa_cons
+
+      !! oxygen production and consumption (and non-consumption)
+      REAL(wp), DIMENSION(jpi,jpj) :: fo2_prod, fo2_cons
+      REAL(wp), DIMENSION(jpi,jpj) :: fo2_ncons, fo2_ccons
+
+      !! temporary variables
+      REAL(wp) :: fq0
+
+      !!==========================================================
+      !! LOCAL GRID CELL TRENDS
+      !!==========================================================
+      !!
+      !!----------------------------------------------------------
+      !! Determination of trends
+      !!----------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! chlorophyll
+               btra(ji,jj,jpchn_lc) = b0 * ( ( (frn(ji,jj) * fprn(ji,jj) *      &
+                                             zphn(ji,jj) ) -                 &
+                                           fgmipn(ji,jj) - fgmepn(ji,jj) -   &
+                                           fdpn(ji,jj) - fdpn2(ji,jj) ) *    &
+                                          (fthetan(ji,jj) / xxi) )
+               btra(ji,jj,jpchd_lc) = b0 * ( ( (frd(ji,jj) * fprd(ji,jj) *      &
+                                             zphd(ji,jj) ) -                 &
+                                           fgmepd(ji,jj) - fdpd(ji,jj) -     &
+                                           fdpd2(ji,jj) ) *                  &
+                                          (fthetad(ji,jj) / xxi) )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! phytoplankton
+               btra(ji,jj,jpphn_lc) = b0 * ( (fprn(ji,jj) * zphn(ji,jj)) -      &
+                                          fgmipn(ji,jj) - fgmepn(ji,jj) -    &
+                                          fdpn(ji,jj) - fdpn2(ji,jj) )
+               btra(ji,jj,jpphd_lc) = b0 * ( (fprd(ji,jj) * zphd(ji,jj)) -      &
+                                          fgmepd(ji,jj) - fdpd(ji,jj) -      &
+                                          fdpd2(ji,jj) )
+               btra(ji,jj,jppds_lc) = b0 * ( (fprds(ji,jj) * zpds(ji,jj)) -     &
+                                          fgmepds(ji,jj) - fdpds(ji,jj) -    &
+                                          fsdiss(ji,jj) - fdpds2(ji,jj) )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! zooplankton
+               btra(ji,jj,jpzmi_lc) = b0 * (fmigrow(ji,jj) - fgmezmi(ji,jj) -   &
+                                         fdzmi(ji,jj) - fdzmi2(ji,jj))
+               btra(ji,jj,jpzme_lc) = b0 * (fmegrow(ji,jj) - fdzme(ji,jj) -     &
+                                         fdzme2(ji,jj))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!----------------------------------------------------------
+      !! detritus
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               btra(ji,jj,jpdet_lc) = b0 * (                           &
+                   fdpn(ji,jj)                                         & ! mort. losses 
+                 + ((1.0 - xfdfrac1) * fdpd(ji,jj))                    & ! mort. losses 
+                 + fdzmi(ji,jj)                                        & ! mort. losses
+                 + ((1.0 - xfdfrac2) * fdzme(ji,jj))                   & ! mort. losses
+                 + ((1.0 - xbetan) * (finmi(ji,jj) + finme(ji,jj)))    & ! assim. inefficiency
+                 - fgmid(ji,jj) - fgmed(ji,jj)                         & ! grazing
+                 - fdd(ji,jj)                                          & ! remin.
+                 + fslowgain(ji,jj) - fslowloss(ji,jj)                 & ! slow-sinking
+                 - (f_sbenin_n(ji,jj) / fse3t(ji,jj,jk))               & ! slow-sinking loss to seafloor
+                 + ffast2slown(ji,jj) )                                  ! seafloor fast->slow 
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! dissolved inorganic nitrogen nutrient
+               !! primary production
+               fn_cons = - (fprn(ji,jj) * zphn(ji,jj)) -                     &
+                           (fprd(ji,jj) * zphd(ji,jj))
+               !! 
+               fn_prod =                                                     &
+                                         ! messy feeding remin.
+                         (xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) +           &
+                         (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) +            &
+                                  fgmezmi(ji,jj) + fgmed(ji,jj))) +          &
+                                         ! excretion and remin.
+                         fmiexcr(ji,jj) + fmeexcr(ji,jj) + fdd(ji,jj) +      &
+                         freminn(ji,jj) +                                    &
+                                         ! metab. losses
+                         fdpn2(ji,jj) + fdpd2(ji,jj) + fdzmi2(ji,jj) +       &
+                         fdzme2(ji,jj)
+               !! 
+               !! riverine flux
+               if ( jriver_n .gt. 0 ) then
+                  f_riv_loc_n(ji,jj) = f_riv_n(ji,jj) *                      &
+                     friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk)
+                  fn_prod = fn_prod + f_riv_loc_n(ji,jj)
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
+                   ibenthic.eq.1) then
+                  fn_prod = fn_prod + (f_benout_n(ji,jj) / fse3t(ji,jj,jk))
+               endif
+               !!
+               btra(ji,jj,jpdin_lc) = b0 * ( fn_prod + fn_cons )
+               !!
+               !! consumption of dissolved nitrogen
+               fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fn_cons )
+               !! production of dissolved nitrogen
+               fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fn_prod )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! dissolved silicic acid nutrient
+               !! opal production
+               fs_cons = - (fprds(ji,jj) * zpds(ji,jj))
+               !!
+               fs_prod =                                                     &
+                             ! opal dissolution
+                         fsdiss(ji,jj) +                                     &
+                             ! mort. loss
+                         ((1.0 - xfdfrac1) * fdpds(ji,jj)) +                 &
+                             &  ! egestion of grazed Si
+                         ((1.0 - xfdfrac3) * fgmepds(ji,jj)) +               &
+                             ! fast diss. and metab. losses
+                         freminsi(ji,jj) + fdpds2(ji,jj)
+               !! 
+               !! riverine flux
+               if ( jriver_si .gt. 0 ) then
+                  f_riv_loc_si(ji,jj) = f_riv_si(ji,jj) *                    &
+                                        friver_dep(jk,mbathy(ji,jj)) /       &
+                                        fse3t(ji,jj,jk)
+                  fs_prod = fs_prod + f_riv_loc_si(ji,jj)
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
+                   ibenthic.eq.1) then
+                  fs_prod = fs_prod + (f_benout_si(ji,jj) / fse3t(ji,jj,jk))
+               endif
+               !!
+               btra(ji,jj,jpsil_lc) = b0 * ( &
+                 fs_prod + fs_cons )
+               !! consumption of dissolved silicon
+               fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fs_cons )
+               !! production of dissolved silicon
+               fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fs_prod )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then !!
+               !!----------------------------------------------------------
+               !! dissolved "iron" nutrient
+               btra(ji,jj,jpfer_lc) = b0 * ( (xrfn * btra(ji,jj,jpdin_lc)) +       &
+                                          ffetop(ji,jj) + ffebot(ji,jj) -    &
+                                          ffescav(ji,jj) )
+            ENDIF
+         ENDDO
+      ENDDO
+
+# if defined key_roam
+      !!----------------------------------------------------------
+      !! AXY (26/11/08): implicit detrital carbon change
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then 
+               !!
+               btra(ji,jj,jpdtc_lc) = b0 * (                           &
+                   (xthetapn * fdpn(ji,jj))                            & ! mort. losses 
+                 + ((1.0 - xfdfrac1) * (xthetapd * fdpd(ji,jj)))       & ! mort. losses 
+                 + (xthetazmi * fdzmi(ji,jj))                          & ! mort. losses 
+                 + ((1.0 - xfdfrac2) * (xthetazme * fdzme(ji,jj)))     & ! mort. losses 
+                 + ((1.0 - xbetac) * (ficmi(ji,jj) + ficme(ji,jj)))    & ! assim. inefficiency
+                 - fgmidc(ji,jj) - fgmedc(ji,jj)                       & ! grazing
+                 - fddc(ji,jj)                                         & ! remin.
+                 + fslowgainc(ji,jj) - fslowlossc(ji,jj)               & ! slow-sinking
+                 - (f_sbenin_c(ji,jj) / fse3t(ji,jj,jk))               & ! slow-sinking loss to seafloor
+                 + ffast2slowc(ji,jj) )                                  ! seafloor fast->slow
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! dissolved inorganic carbon
+               !! primary production
+               fc_cons = - (xthetapn * fprn(ji,jj) * zphn(ji,jj)) -          &
+                           (xthetapd * fprd(ji,jj) * zphd(ji,jj))
+               !!
+               fc_prod =                                                     &
+                            ! messy feeding remin
+                         (xthetapn * xphi * fgmipn(ji,jj)) +                 &
+                         (xphi * fgmidc(ji,jj)) +                            &
+                         (xthetapn * xphi * fgmepn(ji,jj)) +                 &
+                         (xthetapd * xphi * fgmepd(ji,jj)) +                 &
+                         (xthetazmi * xphi * fgmezmi(ji,jj)) +               &
+                         (xphi * fgmedc(ji,jj)) +                            &
+                            ! resp., remin., losses
+                         fmiresp(ji,jj) + fmeresp(ji,jj) + fddc(ji,jj) +     &
+                         freminc(ji,jj) + (xthetapn * fdpn2(ji,jj)) +        &
+                            ! losses
+                         (xthetapd * fdpd2(ji,jj)) +                         &
+                         (xthetazmi * fdzmi2(ji,jj)) +                       &
+                         (xthetazme * fdzme2(ji,jj))
+               !! 
+               !! riverine flux
+               if ( jriver_c .gt. 0 ) then
+                  f_riv_loc_c(ji,jj) = f_riv_c(ji,jj) *                      &
+                                       friver_dep(jk,mbathy(ji,jj)) /        &
+                                       fse3t(ji,jj,jk)
+                  fc_prod = fc_prod + f_riv_loc_c(ji,jj)
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
+                   ibenthic.eq.1) then
+                  fc_prod = fc_prod + (f_benout_c(ji,jj) / fse3t(ji,jj,jk))
+               endif
+               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
+                   ibenthic.eq.1) then
+                  fc_prod = fc_prod + (f_benout_ca(ji,jj) / fse3t(ji,jj,jk))
+               endif
+               !!
+               !! community respiration (does not include CaCO3 terms - 
+               !! obviously!)
+               fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod
+               !!
+               !! CaCO3
+               fc_prod = fc_prod - ftempca(ji,jj) + freminca(ji,jj)
+               !! 
+               !! riverine flux
+               if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then
+                  fc_prod = fc_prod + f_riv_c(ji,jj)
+               endif
+               !!
+               btra(ji,jj,jpdic_lc) = b0 * ( fc_prod + fc_cons )
+               !! consumption of dissolved carbon
+               fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fc_cons )
+               !! production of dissolved carbon
+               fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
+                                                       fc_prod )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! alkalinity
+               !! CaCO3 dissolution
+               fa_prod = 2.0 * freminca(ji,jj)
+               !! CaCO3 production
+               fa_cons = - 2.0 * ftempca(ji,jj)
+               !! 
+               !! riverine flux
+               if ( jriver_alk .gt. 0 ) then
+                  f_riv_loc_alk(ji,jj) = f_riv_alk(ji,jj) *                  &
+                                         friver_dep(jk,mbathy(ji,jj)) /      &
+                                         fse3t(ji,jj,jk)
+                  fa_prod = fa_prod + f_riv_loc_alk(ji,jj)
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
+                   ibenthic.eq.1) then
+                  fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) /            &
+                                       fse3t(ji,jj,jk))
+               endif
+               !!
+               btra(ji,jj,jpalk_lc) = b0 * ( fa_prod + fa_cons )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !!----------------------------------------------------------
+               !! oxygen (has protection at low O2 concentrations; 
+               !! OCMIP-2 style)
+               fo2_prod(ji,jj) =                                             &
+                                     ! Pn primary production, N
+                                 (xthetanit * fprn(ji,jj) * zphn(ji,jj)) +   &
+                                     ! Pd primary production, N
+                                 (xthetanit * fprd(ji,jj) * zphd(ji,jj)) +   &
+                                     ! Pn primary production, C
+                                 (xthetarem * xthetapn * fprn(ji,jj) *       &
+                                  zphn(ji,jj)) +                             &
+                                     ! Pd primary production, C
+                                  (xthetarem * xthetapd * fprd(ji,jj) *      &
+                                   zphd(ji,jj))
+               fo2_ncons(ji,jj) =                                            &
+                                     ! Pn messy feeding remin., N 
+                                   - (xthetanit * xphi * fgmipn(ji,jj))      &
+                                     ! D  messy feeding remin., N
+                                   - (xthetanit * xphi * fgmid(ji,jj))       &
+                                     ! Pn messy feeding remin., N
+                                   - (xthetanit * xphi * fgmepn(ji,jj))      &
+                                     ! Pd messy feeding remin., N
+                                   - (xthetanit * xphi * fgmepd(ji,jj))      &
+                                     ! Zi messy feeding remin., N
+                                   - (xthetanit * xphi * fgmezmi(ji,jj))     &
+                                     ! D  messy feeding remin., N
+                                   - (xthetanit * xphi * fgmed(ji,jj))       &
+                                     ! microzoo excretion, N
+                                   - (xthetanit * fmiexcr(ji,jj))            &
+                                     ! mesozoo  excretion, N
+                                   - (xthetanit * fmeexcr(ji,jj))            &
+                                     ! slow detritus remin., N
+                                   - (xthetanit * fdd(ji,jj))                &
+                                     ! fast detritus remin., N
+                                   - (xthetanit * freminn(ji,jj))            &
+                                     ! Pn  losses, N
+                                   - (xthetanit * fdpn2(ji,jj))              &
+                                     ! Pd  losses, N
+                                   - (xthetanit * fdpd2(ji,jj))              &
+                                     ! Zmi losses, N
+                                   - (xthetanit * fdzmi2(ji,jj))             &
+                                     ! Zme losses, N
+                                   - (xthetanit * fdzme2(ji,jj))
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
+                   ibenthic.eq.1) then
+                  fo2_ncons(ji,jj) = fo2_ncons(ji,jj) -                      &
+                                     (xthetanit * f_benout_n(ji,jj) /        &
+                                      fse3t(ji,jj,jk))
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               fo2_ccons(ji,jj) =                                            &
+                                     ! Pn messy feeding remin., C
+                                  - (xthetarem * xthetapn * xphi *           &
+                                     fgmipn(ji,jj))                          &
+                                     ! D  messy feeding remin., C
+                                  - (xthetarem * xphi * fgmidc(ji,jj))       &
+                                     ! Pn messy feeding remin., C
+                                  - (xthetarem * xthetapn * xphi *           &
+                                     fgmepn(ji,jj))                          &
+                                     ! Pd messy feeding remin., C
+                                  - (xthetarem * xthetapd * xphi *           &
+                                     fgmepd(ji,jj))                          &
+                                     ! Zi messy feeding remin., C
+                                  - (xthetarem * xthetazmi * xphi *          &
+                                     fgmezmi(ji,jj))                         &
+                                     ! D  messy feeding remin., C
+                                  - (xthetarem * xphi * fgmedc(ji,jj))       &
+                                     ! microzoo respiration, C
+                                  - (xthetarem * fmiresp(ji,jj))             &
+                                     ! mesozoo  respiration, C
+                                  - (xthetarem * fmeresp(ji,jj))             &
+                                     ! slow detritus remin., C
+                                  - (xthetarem * fddc(ji,jj))                &
+                                     ! fast detritus remin., C
+                                  - (xthetarem * freminc(ji,jj))             &
+                                     ! Pn  losses, C
+                                  - (xthetarem * xthetapn * fdpn2(ji,jj))    &
+                                     ! Pd  losses, C
+                                  - (xthetarem * xthetapd * fdpd2(ji,jj))    &
+                                     ! Zmi losses, C
+                                  - (xthetarem * xthetazmi * fdzmi2(ji,jj))  &
+                                     ! Zme losses, C
+                                  - (xthetarem * xthetazme * fdzme2(ji,jj))
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
+                   ibenthic.eq.1) then
+                  fo2_ccons(ji,jj) = fo2_ccons(ji,jj) - (xthetarem *         &
+                                                         f_benout_c(ji,jj) / &
+                                                         fse3t(ji,jj,jk))
+               endif
+               fo2_cons(ji,jj) = fo2_ncons(ji,jj) + fo2_ccons(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! is this a suboxic zone?
+               !! deficient O2; production fluxes only
+               if (zoxy(ji,jj).lt.xo2min) then
+                  btra(ji,jj,jpoxy_lc) = b0 * fo2_prod(ji,jj)
+                  foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fse3t(ji,jj,jk) *  &
+                                                          fo2_prod(ji,jj) )
+                  foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fse3t(ji,jj,jk) *  &
+                                                          fo2_cons(ji,jj) )
+               else
+                  !! sufficient O2; production + consumption fluxes
+                  btra(ji,jj,jpoxy_lc) = b0 * ( fo2_prod(ji,jj) +               &
+                                             fo2_cons(ji,jj) )
+                  foxy_prod(ji,jj) = foxy_prod(ji,jj) +                      &
+                                     ( fse3t(ji,jj,jk) * fo2_prod(ji,jj) )
+                  foxy_cons(ji,jj) = foxy_cons(ji,jj) +                      &
+                                     ( fse3t(ji,jj,jk) * fo2_cons(ji,jj) )
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! air-sea fluxes (if this is the surface box)
+               if (jk.eq.1) then
+                  !!
+                  !! CO2 flux
+                  btra(ji,jj,jpdic_lc) = btra(ji,jj,jpdic_lc) + (b0 *              &
+                                                           f_co2flux(ji,jj))
+                  !!
+                  !! O2 flux (mol/m3/s -> mmol/m3/d)
+                  btra(ji,jj,jpoxy_lc) = btra(ji,jj,jpoxy_lc) + (b0 *              &
+                                                           f_o2flux(ji,jj))
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+# endif
+
+# if defined key_debug_medusa
+! I DON'T THIS IS MUCH USE, NOW IT'S BEEN PULLED OUT OF THE MAIN DO LOOP
+! - marc 5/5/17
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !! report state variable fluxes (not including 
+               !! fast-sinking detritus)
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpchn_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpchn_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpchd_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpchd_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpphn_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpphn_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpphd_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpphd_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jppds_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jppds_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpzmi_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpzmi_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpzme_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpzme_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdet_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpdet_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdin_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpdin_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpsil_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpsil_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpfer_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpfer_lc)
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdtc_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpdtc_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdic_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpdic_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpalk_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpalk_lc)
+                  IF (lwp) write (numout,*) 'btra(ji,jj,jpoxy_lc)(',jk,')  = ', &
+                                            btra(ji,jj,jpoxy_lc)
+#  endif
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+# endif
+
+      !!----------------------------------------------------------
+      !! Integrate calculated fluxes for mass balance
+      !!----------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! === nitrogen ===
+               fflx_n(ji,jj)  = fflx_n(ji,jj) + fse3t(ji,jj,jk) *            &
+                                ( btra(ji,jj,jpphn_lc) + btra(ji,jj,jpphd_lc) +    &
+                                  btra(ji,jj,jpzmi_lc) + btra(ji,jj,jpzme_lc) +    &
+                                  btra(ji,jj,jpdet_lc) + btra(ji,jj,jpdin_lc) )
+               !! === silicon ===
+               fflx_si(ji,jj) = fflx_si(ji,jj) + fse3t(ji,jj,jk) *           &
+                                ( btra(ji,jj,jppds_lc) + btra(ji,jj,jpsil_lc) )
+               !! === iron ===
+               fflx_fe(ji,jj) = fflx_fe(ji,jj) + fse3t(ji,jj,jk) *           &
+                                ( (xrfn *                                    &
+                                   (btra(ji,jj,jpphn_lc) + btra(ji,jj,jpphd_lc) +  &
+                                    btra(ji,jj,jpzmi_lc) + btra(ji,jj,jpzme_lc) +  &
+                                    btra(ji,jj,jpdet_lc))) + btra(ji,jj,jpfer_lc) )
+# if defined key_roam
+               !! === carbon ===
+               fflx_c(ji,jj)  = fflx_c(ji,jj) + fse3t(ji,jj,jk) *            &
+                                ( (xthetapn * btra(ji,jj,jpphn_lc)) +           &
+                                  (xthetapd * btra(ji,jj,jpphd_lc)) +           &
+                                  (xthetazmi * btra(ji,jj,jpzmi_lc)) +          &
+                                  (xthetazme * btra(ji,jj,jpzme_lc)) +          &
+                                  btra(ji,jj,jpdtc_lc) + btra(ji,jj,jpdic_lc) )
+               !! === alkalinity ===
+               fflx_a(ji,jj)  = fflx_a(ji,jj) + fse3t(ji,jj,jk) *            &
+                                btra(ji,jj,jpalk_lc)
+               !! === oxygen ===
+               fflx_o2(ji,jj) = fflx_o2(ji,jj) + fse3t(ji,jj,jk) *           &
+                                btra(ji,jj,jpoxy_lc)
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!----------------------------------------------------------
+      !! Apply calculated tracer fluxes
+      !!----------------------------------------------------------
+      !!
+      !! units: [unit of tracer] per second (fluxes are calculated 
+      !! above per day)
+      !!
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               ibio_switch = 1
+# if defined key_gulf_finland
+               !! AXY (17/05/13): fudge in a Gulf of Finland correction; 
+               !!                 uses longitude-latitude range to 
+               !!                 establish if this is a Gulf of Finland 
+               !!                 grid cell; if so, then BGC fluxes are 
+               !!                 ignored (though still calculated); for 
+               !!                 reference, this is meant to be a 
+               !!                 temporary fix to see if all of my 
+               !!                 problems can be done away with if I 
+               !!                 switch off BGC fluxes in the Gulf of 
+               !!                 Finland, which currently appears the 
+               !!                 source of trouble
+               if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and.    &
+                    gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then
+                  ibio_switch = 0
+               endif
+# endif               
+               if (ibio_switch.eq.1) then
+                  tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) +                &
+                                        (btra(ji,jj,jpchn_lc) / 86400.)
+                  tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) +                &
+                                        (btra(ji,jj,jpchd_lc) / 86400.)
+                  tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) +                &
+                                        (btra(ji,jj,jpphn_lc) / 86400.)
+                  tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) +                &
+                                        (btra(ji,jj,jpphd_lc) / 86400.)
+                  tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) +                &
+                                        (btra(ji,jj,jppds_lc) / 86400.)
+                  tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) +                &
+                                        (btra(ji,jj,jpzmi_lc) / 86400.)
+                  tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) +                &
+                                        (btra(ji,jj,jpzme_lc) / 86400.)
+                  tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) +                &
+                                        (btra(ji,jj,jpdet_lc) / 86400.)
+                  tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) +                &
+                                        (btra(ji,jj,jpdin_lc) / 86400.)
+                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +                &
+                                        (btra(ji,jj,jpsil_lc) / 86400.)
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +                &
+                                        (btra(ji,jj,jpfer_lc) / 86400.)
+# if defined key_roam
+                  tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) +                &
+                                        (btra(ji,jj,jpdtc_lc) / 86400.)
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +                &
+                                        (btra(ji,jj,jpdic_lc) / 86400.)
+                  tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) +                &
+                                        (btra(ji,jj,jpalk_lc) / 86400.)
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) +                &
+                                        (btra(ji,jj,jpoxy_lc) / 86400.)
+# endif
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+
+               !! AXY (18/11/16): CMIP6 diagnostics
+               IF( med_diag%FBDDTALK%dgsave )  THEN
+                  fbddtalk(ji,jj)  =  fbddtalk(ji,jj)  +                     &
+                                      (btra(ji,jj,jpalk_lc) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FBDDTDIC%dgsave )  THEN
+                  fbddtdic(ji,jj)  =  fbddtdic(ji,jj)  +                     &
+                                      (btra(ji,jj,jpdic_lc) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FBDDTDIFE%dgsave ) THEN
+                  fbddtdife(ji,jj) =  fbddtdife(ji,jj) +                     &
+                                      (btra(ji,jj,jpfer_lc) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FBDDTDIN%dgsave )  THEN
+                  fbddtdin(ji,jj)  =  fbddtdin(ji,jj)  +                     &
+                                      (btra(ji,jj,jpdin_lc) * fse3t(ji,jj,jk))
+               ENDIF
+               IF( med_diag%FBDDTDISI%dgsave ) THEN
+                  fbddtdisi(ji,jj) =  fbddtdisi(ji,jj) +                     &
+                                      (btra(ji,jj,jpsil_lc) * fse3t(ji,jj,jk))
+               ENDIF
+	       !!
+               IF( med_diag%BDDTALK3%dgsave )  THEN
+                  bddtalk3(ji,jj,jk)  =  btra(ji,jj,jpalk_lc)
+               ENDIF
+               IF( med_diag%BDDTDIC3%dgsave )  THEN
+                  bddtdic3(ji,jj,jk)  =  btra(ji,jj,jpdic_lc)
+               ENDIF
+               IF( med_diag%BDDTDIFE3%dgsave ) THEN
+                  bddtdife3(ji,jj,jk) =  btra(ji,jj,jpfer_lc)
+               ENDIF
+               IF( med_diag%BDDTDIN3%dgsave )  THEN
+                  bddtdin3(ji,jj,jk)  =  btra(ji,jj,jpdin_lc)
+               ENDIF
+               IF( med_diag%BDDTDISI3%dgsave ) THEN
+                  bddtdisi3(ji,jj,jk) =  btra(ji,jj,jpsil_lc)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+
+#   if defined key_debug_medusa
+      IF (lwp) write (numout,*) '------'
+      IF (lwp) write (numout,*) 'bio_medusa_update: end all calculations'
+      IF (lwp) write (numout,*) 'bio_medusa_update: now outputs kt = ', kt
+      CALL flush(numout)
+#   endif
+
+# if defined key_axy_nancheck
+      !!----------------------------------------------------------
+      !! Check calculated tracer fluxes
+      !!----------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               DO jn = 1,jp_medusa
+                  fq0 = btra(ji,jj,jn)
+                  !! AXY (30/01/14): "isnan" problem on HECTOR
+                  !! if (fq0 /= fq0 ) then
+                  if ( ieee_is_nan( fq0 ) ) then
+                     !! there's a NaN here
+                     if (lwp) write(numout,*) 'NAN detected in btra(ji,jj,',  &
+                        ji, ',', jj, ',', jk, ',', jn, ') at time', kt
+		     CALL ctl_stop( 'trcbio_medusa, NAN in btra field' )
+                  endif
+               ENDDO
+               DO jn = jp_msa0,jp_msa1
+                  fq0 = tra(ji,jj,jk,jn)
+                  !! AXY (30/01/14): "isnan" problem on HECTOR
+                  !! if (fq0 /= fq0 ) then
+                  if ( ieee_is_nan( fq0 ) ) then
+                     !! there's a NaN here
+                     if (lwp) write(numout,*) 'NAN detected in tra(', ji, &
+                        ',', jj, ',', jk, ',', jn, ') at time', kt
+   		     CALL ctl_stop( 'trcbio_medusa, NAN in tra field' )
+                  endif
+               ENDDO
+               CALL flush(numout)
+            ENDIF
+         ENDDO
+      ENDDO
+# endif
+
+
+   END SUBROUTINE bio_medusa_update
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE bio_medusa_update( )                    ! Empty routine
+      WRITE(*,*) 'bio_medusa_update: You should not have seen this print! error?'
+   END SUBROUTINE bio_medusa_update
+#endif 
+
+   !!======================================================================
+END MODULE bio_medusa_update_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/carb_chem.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/carb_chem.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/carb_chem.F90	(revision 9824)
@@ -0,0 +1,264 @@
+MODULE carb_chem_mod
+   !!======================================================================
+   !!                         ***  MODULE carb_chem_mod  ***
+   !! Calculate the carbon chemistry for the whole ocean
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                                   key_roam?
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   carb_chem        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE carb_chem( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE carb_chem  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - ...
+      !!----------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: f_co2flux, f_co3, f_dcf,               &
+                                   f_h2co3, f_hco3, f_henry,              &
+                                   f_kw660, f_omarg, f_omcal,             &
+                                   f_pco2atm, f_pco2w, f_ph, f_pp0,       &
+                                   f_TALK, f_TDIC, f_xco2a,               &
+# if defined key_mocsy
+                                   zpho,                                  &
+# endif
+                                   zalk, zdic, zsal, zsil, ztmp 
+      USE dom_oce,           ONLY: gdept_0, gdept_n, gdepw_0, gdepw_n,    &
+                                   gphit, mbathy, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+      USE oce,               ONLY: PCO2a_in_cpl, tsb, tsn
+      USE par_kind,          ONLY: wp
+      USE par_medusa,        ONLY: jpalk, jpdic, jpdin, jpsil 
+      USE par_oce,           ONLY: jp_sal, jp_tem, jpi, jpim1, jpj,       &
+                                   jpjm1, jpk
+      USE sbc_oce,           ONLY: lk_oasis
+      USE sms_medusa,        ONLY: f2_ccd_arg, f2_ccd_cal, f3_co3,        &
+                                   f3_h2co3, f3_hco3, f3_omarg,           &
+                                   f3_omcal, f3_pH
+      USE trc,               ONLY: trn
+
+# if defined key_mocsy
+      USE mocsy_wrapper,     ONLY: mocsy_interface
+# else
+      USE trcco2_medusa,     ONLY: trc_co2_medusa
+# endif
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+ 
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) ::    kt
+
+      !! Flags to help with calculating the position of the CCD
+      INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg
+
+      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
+      REAL(wp) :: f_rhosw
+      !! Output arguments from mocsy_interface, which aren't used
+      REAL(wp) :: f_fco2w_dum, f_BetaD_dum, f_opres_dum
+      REAL(wp) :: f_insitut_dum, f_fco2atm_dum
+      REAL(wp) :: f_schmidtco2_dum, f_kwco2_dum, f_K0_dum
+      REAL(wp) :: f_co2starair_dum, f_dpco2_dum
+      !! temporary variables
+      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4
+
+      INTEGER :: iters
+      !! Loop variables
+      INTEGER :: ji, jj, jk
+
+      !!----------------------------------------------------------------------
+      !! Calculate the carbonate chemistry for the whole ocean on the first
+      !! simulation timestep and every month subsequently; the resulting 3D
+      !! field of omega calcite is used to determine the depth of the CCD
+      !!----------------------------------------------------------------------
+      !!
+!      IF(lwp) WRITE(numout,*)                                               &
+!              ' MEDUSA calculating all carbonate chemistry at kt =', kt
+!         CALL flush(numout)
+      !! blank flags
+      i2_omcal(:,:) = 0
+      i2_omarg(:,:) = 0
+
+      !! Loop over levels
+      DO jk = 1,jpk
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !! OPEN wet point IF..THEN loop
+               IF (tmask(ji,jj,jk).eq.1) THEN
+                  !! Do carbonate chemistry
+                  !!
+                  !! Set up required state variables.
+                  !! dissolved inorganic carbon
+                  zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic))
+                  !! alkalinity
+                  zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk))
+                  !! temperature
+                  ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem)
+                  !! salinity
+                  zsal(ji,jj) = tsn(ji,jj,jk,jp_sal)
+#  if defined key_mocsy
+                  !! silicic acid
+                  zsil(ji,jj) = max(0.,trn(ji,jj,jk,jpsil))
+                  !! phosphate via DIN and Redfield
+                  zpho(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 
+#  endif
+		  !!
+		  !! AXY (28/02/14): check input fields
+		  if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then
+                     IF (lwp) WRITE(numout,*) ' carb_chem: T WARNING 3D, ',  &
+                        tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem),          &
+                        ' at (', ji, ',', jj, ',', jk, ') at time', kt
+	             IF(lwp) WRITE(numout,*)                                 &
+                        ' carb_chem: T SWITCHING 3D, ',                      &
+			tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem)
+                     ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem)     !! temperature
+                  endif
+		  if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then
+                     IF (lwp) WRITE(numout,*) ' carb_chem: S WARNING 3D, ',  &
+                        tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal),          &
+                        ' at (', ji, ',', jj, ',', jk, ') at time', kt
+                  endif
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! Blank input variables not used at this stage (they 
+         !! relate to air-sea flux)
+         f_kw660(:,:) = 1.0
+         f_pp0(:,:)   = 1.0
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk).eq.1) THEN
+                  !! calculate carbonate chemistry at grid cell midpoint
+#  if defined key_mocsy
+                  !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
+                  !!                 chemistry package
+                  CALL mocsy_interface(ztmp(ji,jj),zsal(ji,jj),zalk(ji,jj), &
+                                       zdic(ji,jj),zsil(ji,jj),zpho(ji,jj), &
+                                       f_pp0(ji,jj),fsdept(ji,jj,jk),       &
+                                       gphit(ji,jj),f_kw660(ji,jj),         &
+                                       f_xco2a(ji,jj),1,f_ph(ji,jj),        &
+                                       f_pco2w(ji,jj),f_fco2w_dum,          &
+                                       f_h2co3(ji,jj),f_hco3(ji,jj),        &
+                                       f_co3(ji,jj),f_omarg(ji,jj),         &
+                                       f_omcal(ji,jj),f_BetaD_dum,          &
+                                       f_rhosw,f_opres_dum,                 &
+                                       f_insitut_dum,f_pco2atm(ji,jj),      &
+                                       f_fco2atm_dum,f_schmidtco2_dum,      &
+                                       f_kwco2_dum,f_K0_dum,                &
+                                       f_co2starair_dum,f_co2flux(ji,jj),   & 
+                                       f_dpco2_dum)
+                  !!
+                  !! mmol / m3 -> umol / kg
+                  f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw) * 1000.
+                  !! meq / m3 -> ueq / kg
+                  f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw) * 1000.
+                  f_dcf(ji,jj)  = f_rhosw
+#  else
+                  !! AXY (22/06/15): use old PML carbonate chemistry 
+                  !! package (the MEDUSA-2 default)
+                  CALL trc_co2_medusa(ztmp(ji,jj),zsal(ji,jj),zdic(ji,jj),  &
+                                      zalk(ji,jj),fsdept(ji,jj,jk),         &
+                                      f_kw660(ji,jj),f_xco2a(ji,jj),        &
+                                      f_ph(ji,jj),                          &
+                                      f_pco2w(ji,jj),f_h2co3(ji,jj),        &
+                                      f_hco3(ji,jj),f_co3(ji,jj),           &
+                                      f_omcal(ji,jj),f_omarg(ji,jj),        &
+                                      f_co2flux(ji,jj),f_TDIC(ji,jj),       &
+                                      f_TALK(ji,jj),f_dcf(ji,jj),           &
+                                      f_henry(ji,jj),iters)
+                  !! 
+                  !! AXY (28/02/14): check output fields
+                  IF (iters .eq. 25) THEN
+                     IF(lwp) WRITE(numout,*)                                &
+                        ' carb_chem: 3D ITERS WARNING, ', iters, ' AT (',   &
+                        ji, ', ', jj, ', ', jk, ') AT ', kt
+                  ENDIF
+#  endif
+                  !!
+                  !! store 3D outputs
+                  f3_pH(ji,jj,jk)    = f_ph(ji,jj)
+                  f3_h2co3(ji,jj,jk) = f_h2co3(ji,jj)
+                  f3_hco3(ji,jj,jk)  = f_hco3(ji,jj)
+                  f3_co3(ji,jj,jk)   = f_co3(ji,jj)
+                  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) == 0 .and. f_omcal(ji,jj) < 1.0) then
+                     if (jk .eq. 1) then
+                        f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk)
+                     else
+                        fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj)
+                        fq1 = f3_omcal(ji,jj,jk-1) - 1.0
+                        fq2 = fq1 / (fq0 + tiny(fq0))
+                        fq3 = fsdept(ji,jj,jk) - fsdept(ji,jj,jk-1)
+                        fq4 = fq2 * fq3
+                        f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4
+                     endif
+                     i2_omcal(ji,jj)   = 1
+                  endif
+                  if ( i2_omcal(ji,jj) == 0 .and. jk == mbathy(ji,jj) ) then
+                     !! reached seafloor and still no dissolution; set 
+                     !! to seafloor (W-point)
+                     f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1)
+                     i2_omcal(ji,jj)   = 1
+                  endif
+                  !!
+                  !! CCD calculation: aragonite
+                  if (i2_omarg(ji,jj) == 0 .and. f_omarg(ji,jj) < 1.0) then
+                     if (jk .eq. 1) then
+                        f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk)
+                     else
+                        fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj)
+                        fq1 = f3_omarg(ji,jj,jk-1) - 1.0
+                        fq2 = fq1 / (fq0 + tiny(fq0))
+                        fq3 = fsdept(ji,jj,jk) - fsdept(ji,jj,jk-1)
+                        fq4 = fq2 * fq3
+                        f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4
+                     endif
+                     i2_omarg(ji,jj)   = 1
+                  endif
+                  if ( i2_omarg(ji,jj) == 0 .and. jk == mbathy(ji,jj) ) then
+                     !! reached seafloor and still no dissolution; set 
+                     !! to seafloor (W-point)
+                     f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1)
+                     i2_omarg(ji,jj)   = 1
+                  endif
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE carb_chem
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   None key_roam?
+   !!======================================================================
+CONTAINS
+   SUBROUTINE carb_chem( )                    ! Empty routine
+      WRITE(*,*) 'carb_chem: You should not have seen this print! error?'
+   END SUBROUTINE carb_chem
+#endif 
+
+   !!======================================================================
+END MODULE carb_chem_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus.F90	(revision 9824)
@@ -0,0 +1,208 @@
+MODULE detritus_mod
+   !!======================================================================
+   !!                         ***  MODULE detritus_mod  ***
+   !! Calculates detritus processes and fast-sinking detritus
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Revise slow-sinking of detritus
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   detritus        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE detritus( jk, iball  )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE detritus  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - Calculates detritus processes
+      !!  - Fast-sinking detritus 
+      !!-------------------------------------------------------------------
+      USE bio_medusa_mod,         ONLY: f_sbenin_c, f_sbenin_fe,           &
+                                        f_sbenin_n, fdd,                   &
+                                        idf, idfval,                       &   
+                                        fslowsink,                         &
+                                        fslowgain, fslowloss,              &
+# if defined key_roam
+                                        fslowsinkc,                        &
+                                        fslowgainc, fslowlossc,            &
+                                        fddc,                              &
+# endif
+                                        fun_T, fun_Q10, zdet, zdtc
+      USE detritus_fast_sink_mod, ONLY: detritus_fast_sink
+      USE dom_oce,                ONLY: mbathy, e3t_0, e3t_n, gphit, tmask
+      USE in_out_manager,         ONLY: lwp, numout
+      USE par_oce,                ONLY: jpim1, jpjm1
+      USE sms_medusa,             ONLY: jmd, jorgben, jsfd, vsed,          &
+                                        xrfn, xmd, xmdc, xthetad
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+      !! Fast detritus ballast scheme (0 = no; 1 = yes)
+      INTEGER, INTENT( in ) :: iball
+
+      INTEGER :: ji, jj
+
+      !!------------------------------------------------------------------
+      !! Detritus remineralisation
+      !! Constant or temperature-dependent
+      !!------------------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               if (jmd.eq.1) then
+                  !! temperature-dependent
+                  fdd(ji,jj)  = xmd  * fun_T(ji,jj) * zdet(ji,jj)
+# if defined key_roam
+                  fddc(ji,jj) = xmdc * fun_T(ji,jj) * zdtc(ji,jj)
+# endif
+               elseif (jmd.eq.2) then
+                  !! AXY (16/05/13): add in Q10-based parameterisation 
+                  !! (def in nmlst)
+                  !! temperature-dependent
+                  fdd(ji,jj)  = xmd  * fun_Q10(ji,jj) * zdet(ji,jj)
+#if defined key_roam
+                  fddc(ji,jj) = xmdc * fun_Q10(ji,jj) * zdtc(ji,jj)
+#endif
+               else
+                  !! temperature-independent
+                  fdd(ji,jj)  = xmd  * zdet(ji,jj)
+# if defined key_roam
+                  fddc(ji,jj) = xmdc * zdtc(ji,jj)
+# endif
+               endif
+               !!
+               !! AXY (22/07/09): accelerate detrital remineralisation 
+               !! in the bottom box
+               if ((jk.eq.mbathy(ji,jj)) .and. jsfd.eq.1) then
+                  fdd(ji,jj)  = 1.0  * zdet(ji,jj)
+# if defined key_roam
+                  fddc(ji,jj) = 1.0  * zdtc(ji,jj)
+# endif
+               endif
+               
+# if defined key_debug_medusa
+               !! report plankton mortality and remineralisation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+! I've removed the lines below, because the variables are not in this
+! routine. If these debug prints need to stay, they should probably be
+! moved - marc 27/4/17
+!                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme(ji,jj)
+                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd(ji,jj)
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc(ji,jj)
+#  endif
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------------------
+               !! Detritus sinking (AXY, 08/08/18)
+	       !! Replaces slow-sinking done in trcsed_medusa.F90
+               !!
+               !! Uses the fslowsink variable to carry slow-sinking detritus from one
+               !! grid level to the next, variable fslowgain to "add" detritus sinking
+               !! from above and variable fslowloss to "subtract" detritus sinking out
+               !! to below; these variables appear in the differential equations of
+               !! detrital nitrogen and carbon below
+               !!----------------------------------------------------------------------
+               !!
+               fslowgain(ji,jj)  = fslowsink(ji,jj) / fse3t(ji,jj,jk)                  ! = mmol N / m3 / d
+               if (jk.lt.mbathy(ji,jj)) then
+                  fslowloss(ji,jj)  = (zdet(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol N / m3 / d
+               else
+                  fslowloss(ji,jj)  = 0.                                               ! = mmol N / m3 / d
+               endif
+               fslowsink(ji,jj) = fslowloss(ji,jj) * fse3t(ji,jj,jk)                   ! = mmol N / m2 / d
+               !!
+#  if defined key_roam
+               fslowgainc(ji,jj) = fslowsinkc(ji,jj) / fse3t(ji,jj,jk)                 ! = mmol C / m3 / d
+               if (jk.lt.mbathy(ji,jj)) then
+                  fslowlossc(ji,jj) = (zdtc(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol C / m3 / d
+               else
+                  fslowlossc(ji,jj) = 0.                                               ! = mmol C / m3 / d
+               endif
+               fslowsinkc(ji,jj) = fslowlossc(ji,jj) * fse3t(ji,jj,jk)                 ! = mmol C / m2 / d
+#  endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!---------------------------------------------------------
+               !! Detritus addition to benthos
+               !! If activated, slow detritus in the bottom box will enter
+               !! the benthic pool
+               !!---------------------------------------------------------
+               !!
+               if ((jk.eq.mbathy(ji,jj)) .and. jorgben.eq.1) then
+                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool!
+                  !!
+                  f_sbenin_n(ji,jj)  = (zdet(ji,jj) * vsed * 86400.)
+                  f_sbenin_fe(ji,jj) = (zdet(ji,jj) * vsed * 86400. * xrfn)
+# if defined key_roam
+                  f_sbenin_c(ji,jj)  = (zdtc(ji,jj) * vsed * 86400.)
+# else
+                  f_sbenin_c(ji,jj)  = (zdet(ji,jj) * vsed * 86400. * xthetad)
+# endif
+               endif
+
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!------------------------------------------------------------------
+      !! Fast-sinking detritus
+      !!------------------------------------------------------------------
+      CALL detritus_fast_sink( jk, iball )
+
+   END SUBROUTINE detritus
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE detritus( )                    ! Empty routine
+      WRITE(*,*) 'detritus: You should not have seen this print! error?'
+   END SUBROUTINE detritus
+#endif 
+
+   !!======================================================================
+END MODULE detritus_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus_fast_sink.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus_fast_sink.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/detritus_fast_sink.F90	(revision 9824)
@@ -0,0 +1,973 @@
+MODULE detritus_fast_sink_mod
+   !!======================================================================
+   !!                         ***  MODULE detritus_fast_sink_mod  ***
+   !! Calculates fast-sinking detritus
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   detritus_fast_sink        ! Called in detritus.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE detritus_fast_sink( jk, iball )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE detritus_fast_sink  ***
+      !! This called from DETRITUS and calculates the fast-sinking detritus 
+      !!-------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: b0,                                     &
+                                   f_benout_c, f_benout_ca, f_benout_fe,   &
+                                   f_benout_lyso_ca, f_benout_n,           &
+                                   f_benout_si,                            &
+                                   f_fbenin_c, f_fbenin_ca, f_fbenin_fe,   &
+                                   f_fbenin_n, f_fbenin_si, f_omcal,       &
+                                   fccd, fdep1, fdd,                       &
+                                   fdpd, fdpd2, fdpds, fdpds2,             &
+                                   fdpn, fdpn2,                            &
+                                   fdzme, fdzme2, fdzmi, fdzmi2,           &
+                                   ffast2slowc, ffast2slown,               &
+                                   ffastc, ffastca, ffastfe, ffastn,       &
+                                   ffastsi,                                &
+                                   fgmed, fgmepd, fgmepds, fgmepn,         &
+                                   fgmezmi,                                &
+                                   fgmid, fgmipn,                          &
+                                   ficme, ficmi,                           &
+                                   fifd_fe, fifd_n, fifd_si,               &
+                                   finme, finmi,                           &
+                                   fmeexcr, fmiexcr,                       &
+                                   fofd_fe, fofd_n, fofd_si,               &
+                                   fregen, fregenfast, fregenfastsi,       &
+                                   fregensi,                               &
+                                   freminc, freminca, freminfe,            &
+                                   freminn, freminsi,                      &
+                                   fsdiss,                                 &
+                                   fsedc, fsedca, fsedn, fsedfe, fsedsi,   &
+                                   fslowc, fslowcflux,                     &
+                                   fslown, fslownflux,                     &
+                                   ftempc, ftempca, ftempfe, ftempn,       &
+                                   ftempsi,                                &
+# if defined key_roam
+                                   fifd_c, fofd_c, fregenfastc,            &
+# endif
+                                   idf, idfval,                            &
+                                   zdet, zdtc
+      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n,         &
+                                   gphit, mbathy, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+      USE oce,               ONLY: tsn
+      USE par_kind,          ONLY: wp
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1
+      USE sms_medusa,        ONLY: f2_ccd_cal, f3_omcal,                   &
+                                   jexport, jfdfate, jinorgben, jocalccd,  &
+                                   jorgben, jp_tem, jrratio,               &
+                                   ocal_ccd, vsed,                         &
+                                   xbetac, xbetan,                         &
+                                   xcaco3a, xcaco3b,                       &
+                                   xfastc, xfastca, xfastsi,               &
+                                   xfdfrac1, xfdfrac2, xfdfrac3,           &
+                                   xmassc, xmassca, xmasssi,               &
+                                   xphi, xprotca, xprotsi,                 &
+                                   xrfn, xridg_r0,                         &
+                                   xsedc, xsedca, xsedfe,xsedn, xsedsi,    &
+                                   xthetapd, xthetapn,                     &
+                                   xthetazme, xthetazmi,                   &
+                                   zn_sed_c, zn_sed_ca, zn_sed_fe,         &
+                                   zn_sed_n, zn_sed_si
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+      !! Fast detritus ballast scheme (0 = no; 1 = yes)
+      INTEGER, INTENT( in ) :: iball
+
+      !! Loop variables
+      INTEGER :: ji, jj
+
+      REAL(wp) :: fb_val, fl_sst
+      !! Particle flux
+      REAL(wp) :: fcaco3
+      REAL(wp) :: fprotf
+      REAL(wp), DIMENSION(jpi,jpj) :: fccd_dep
+      !! temporary variables
+      REAL(wp) :: fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8
+
+      !! The two sections below, slow detritus creation and Nutrient 
+      !! regeneration are moved from just above the CALL to DETRITUS
+      !! in trcbio_medusa.F90.
+      !!---------------------------------------------------------
+      !! Slow detritus creation
+      !!---------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               !! this variable integrates the creation of slow sinking 
+               !! detritus to allow the split between fast and slow 
+               !! detritus to be diagnosed
+               fslown(ji,jj)  = fdpn(ji,jj) + fdzmi(ji,jj) +                 &
+                                ((1.0 - xfdfrac1) * fdpd(ji,jj)) +           &
+                                ((1.0 - xfdfrac2) * fdzme(ji,jj)) +          &
+                                ((1.0 - xbetan) *                            &
+                                 (finmi(ji,jj) + finme(ji,jj)))
+               !!
+               !! this variable records the slow detrital sinking flux at 
+               !! this particular depth; it is used in the output of this 
+               !! flux at standard depths in the diagnostic outputs; 
+               !! needs to be adjusted from per second to per day because 
+               !! of parameter vsed
+               fslownflux(ji,jj) = zdet(ji,jj) * vsed * 86400.
+# if defined key_roam
+               !!
+               !! and the same for detrital carbon
+               fslowc(ji,jj)  = (xthetapn * fdpn(ji,jj)) +                   &
+                                (xthetazmi * fdzmi(ji,jj)) +                 &
+                                (xthetapd * (1.0 - xfdfrac1) *               &
+                                 fdpd(ji,jj)) +                              &
+                                (xthetazme * (1.0 - xfdfrac2) *              &
+                                 fdzme(ji,jj)) +                             &
+                                ((1.0 - xbetac) * (ficmi(ji,jj) +            &
+                                                   ficme(ji,jj)))
+               !!
+               !! this variable records the slow detrital sinking flux 
+               !! at this particular depth; it is used in the output of 
+               !! this flux at standard depths in the diagnostic 
+               !! outputs; needs to be adjusted from per second to per 
+               !! day because of parameter vsed
+               fslowcflux(ji,jj) = zdtc(ji,jj) * vsed * 86400.
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!---------------------------------------------------------
+      !! Nutrient regeneration
+      !! this variable integrates total nitrogen regeneration down the
+      !! watercolumn; its value is stored and output as a 2D diagnostic;
+      !! the corresponding dissolution flux of silicon (from sources
+      !! other than fast detritus) is also integrated; note that,
+      !! confusingly, the linear loss terms from plankton compartments
+      !! are labelled as fdX2 when one might have expected fdX or fdX1
+      !!---------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !!
+               !! nitrogen
+               fregen(ji,jj) =                                             &
+                                     ! messy feeding
+                               (((xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) + &
+                                 (xphi *                                   &
+                                  (fgmepn(ji,jj) + fgmepd(ji,jj) +         &
+                                   fgmezmi(ji,jj) + fgmed(ji,jj))) +       &
+                                     ! excretion + D remin.
+                                 fmiexcr(ji,jj) + fmeexcr(ji,jj) +         &
+                                 fdd(ji,jj) +                              &
+                                     ! linear mortality
+                                 fdpn2(ji,jj) + fdpd2(ji,jj) +             &
+                                 fdzmi2(ji,jj) + fdzme2(ji,jj)) *          &
+                                fse3t(ji,jj,jk))
+               !!
+               !! silicon
+               fregensi(ji,jj) =                                           &
+                                     ! dissolution + non-lin. mortality
+                                 ((fsdiss(ji,jj) +                         &
+                                   ((1.0 - xfdfrac1) * fdpds(ji,jj)) +     &
+                                     ! egestion by zooplankton
+                                   ((1.0 - xfdfrac3) * fgmepds(ji,jj)) +   &
+                                     ! linear mortality
+                                   fdpds2(ji,jj)) * fse3t(ji,jj,jk))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!-------------------------------------------------------------------
+      !! Fast-sinking detritus terms
+      !! "local" variables declared so that conservation can be checked;
+      !! the calculated terms are added to the fast-sinking flux later on
+      !! only after the flux entering this level has experienced some
+      !! remineralisation
+      !! note: these fluxes need to be scaled by the level thickness
+      !!-------------------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+
+               !! nitrogen:   diatom and mesozooplankton mortality
+               ftempn(ji,jj)  = b0 * ((xfdfrac1 * fdpd(ji,jj))  +            &
+                                      (xfdfrac2 * fdzme(ji,jj)))
+               !!
+               !! silicon:    diatom mortality and grazed diatoms
+               ftempsi(ji,jj) = b0 * ((xfdfrac1 * fdpds(ji,jj)) +            &
+                                      (xfdfrac3 * fgmepds(ji,jj)))
+               !!
+               !! iron:       diatom and mesozooplankton mortality
+               ftempfe(ji,jj) = b0 * (((xfdfrac1 * fdpd(ji,jj)) +            &
+                                       (xfdfrac2 * fdzme(ji,jj))) * xrfn)
+               !!
+               !! carbon:     diatom and mesozooplankton mortality
+               ftempc(ji,jj)  = b0 * ((xfdfrac1 * xthetapd * fdpd(ji,jj)) +  & 
+                                      (xfdfrac2 * xthetazme * fdzme(ji,jj)))
+               !!
+            ENDIF
+         ENDDO
+      ENDDO
+
+# if defined key_roam
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               if (jrratio.eq.0) then
+                  !! CaCO3:      latitudinally-based fraction of total 
+                  !!             primary production
+                  !!               0.10 at equator; 0.02 at pole
+                  fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                  &
+                                      ((90.0 - abs(gphit(ji,jj))) / 90.0))
+               elseif (jrratio.eq.1) then
+                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 1
+                  !!             this uses SURFACE omega calcite to regulate 
+                  !!             rain ratio
+                  if (f_omcal(ji,jj).ge.1.0) then
+                     fq1 = (f_omcal(ji,jj) - 1.0)**0.81
+                  else
+                     fq1 = 0.
+                  endif
+                  fcaco3 = xridg_r0 * fq1
+               elseif (jrratio.eq.2) then
+                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 2
+                  !!             this uses FULL 3D omega calcite to regulate
+                  !!             rain ratio
+                  if (f3_omcal(ji,jj,jk).ge.1.0) then
+                     fq1 = (f3_omcal(ji,jj,jk) - 1.0)**0.81
+                  else
+                     fq1 = 0.
+                  endif
+                  fcaco3 = xridg_r0 * fq1
+               endif
+# else
+               !! CaCO3:      latitudinally-based fraction of total primary
+               !!              production
+               !!               0.10 at equator; 0.02 at pole
+               fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                      &
+                                   ((90.0 - abs(gphit(ji,jj))) / 90.0))
+# endif
+               !! AXY (09/03/09): convert CaCO3 production from function of 
+               !! primary production into a function of fast-sinking material; 
+               !! technically, this is what Dunne et al. (2007) do anyway; they 
+               !! convert total primary production estimated from surface 
+               !! chlorophyll to an export flux for which they apply conversion 
+               !! factors to estimate the various elemental fractions (Si, Ca)
+               ftempca(ji,jj) = ftempc(ji,jj) * fcaco3
+
+# if defined key_debug_medusa
+               !! integrate total fast detritus production
+               if (idf.eq.1) then
+                  fifd_n(ji,jj)  = fifd_n(ji,jj)  + (ftempn(ji,jj)  *         &
+                                                     fse3t(ji,jj,jk))
+                  fifd_si(ji,jj) = fifd_si(ji,jj) + (ftempsi(ji,jj) *         &
+                                                     fse3t(ji,jj,jk))
+                  fifd_fe(ji,jj) = fifd_fe(ji,jj) + (ftempfe(ji,jj) *         &
+                                                     fse3t(ji,jj,jk))
+#  if defined key_roam
+                  fifd_c(ji,jj)  = fifd_c(ji,jj)  + (ftempc(ji,jj)  *         &
+                                                     fse3t(ji,jj,jk))
+#  endif
+               endif
+
+               !! report quantities of fast-sinking detritus for each component
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+! These variables are not in this routine - marc 28/4/17
+!                  IF (lwp) write (numout,*) 'fdpd(',jk,')    = ', fdpd(ji,jj)
+!                  IF (lwp) write (numout,*) 'fdzme(',jk,')   = ', fdzme(ji,jj)
+                  IF (lwp) write (numout,*) 'ftempn(',jk,')  = ', ftempn(ji,jj)
+                  IF (lwp) write (numout,*) 'ftempsi(',jk,') = ', ftempsi(ji,jj)
+                  IF (lwp) write (numout,*) 'ftempfe(',jk,') = ', ftempfe(ji,jj)
+                  IF (lwp) write (numout,*) 'ftempc(',jk,')  = ', ftempc(ji,jj)
+                  IF (lwp) write (numout,*) 'ftempca(',jk,') = ', ftempca(ji,jj)
+                  IF (lwp) write (numout,*) 'flat(',jk,')    = ',             &
+                                            abs(gphit(ji,jj))
+                  IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !!----------------------------------------------------------
+      !! This version of MEDUSA offers a choice of three methods for
+      !! handling the remineralisation of fast detritus.  All three
+      !! do so in broadly the same way:
+      !!
+      !!   1.  Fast detritus is stored as a 2D array  [ ffastX  ]
+      !!   2.  Fast detritus is added level-by-level  [ ftempX  ]
+      !!   3.  Fast detritus is not remineralised in the top box 
+      !!       [ freminX ]
+      !!   4.  Remaining fast detritus is remineralised in the 
+      !!       bottom  [ fsedX   ] box
+      !!
+      !! The three remineralisation methods are:
+      !!   
+      !!   1.  Ballast model (i.e. that published in Yool et al., 
+      !!       2011)
+      !!  (1b. Ballast-sans-ballast model)
+      !!   2.  Martin et al. (1987)
+      !!   3.  Henson et al. (2011)
+      !! 
+      !! The first of these couples C, N and Fe remineralisation to
+      !! the remineralisation of particulate Si and CaCO3, but the 
+      !! latter two treat remineralisation of C, N, Fe, Si and CaCO3
+      !! completely separately.  At present a switch within the code
+      !! regulates which submodel is used, but this should be moved
+      !! to the namelist file.
+      !! 
+      !! The ballast-sans-ballast submodel is an original development
+      !! feature of MEDUSA in which the ballast submodel's general
+      !! framework and parameterisation is used, but in which there
+      !! is no protection of organic material afforded by ballasting
+      !! minerals.  While similar, it is not the same as the Martin 
+      !! et al. (1987) submodel.
+      !!
+      !! Since the three submodels behave the same in terms of
+      !! accumulating sinking material and remineralising it all at
+      !! the seafloor, these portions of the code below are common to
+      !! all three.
+      !!----------------------------------------------------------
+      if (jexport.eq.1) then
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  !!=======================================================
+                  !! BALLAST SUBMODEL
+                  !!=======================================================
+                  !! 
+                  !!-------------------------------------------------------
+                  !! Fast-sinking detritus fluxes, pt. 1: REMINERALISATION
+                  !! aside from explicitly modelled, slow-sinking detritus, the
+                  !! model includes an implicit representation of detrital
+                  !! particles that sink too quickly to be modelled with
+                  !! explicit state variables; this sinking flux is instead
+                  !! instantaneously remineralised down the water column using
+                  !! the version of Armstrong et al. (2002)'s ballast model
+                  !! used by Dunne et al. (2007); the version of this model
+                  !! here considers silicon and calcium carbonate ballast
+                  !! minerals; this section of the code redistributes the fast
+                  !! sinking material generated locally down the water column;
+                  !! this differs from Dunne et al. (2007) in that fast sinking
+                  !! material is distributed at *every* level below that it is
+                  !! generated, rather than at every level below some fixed
+                  !! depth; this scheme is also different in that sinking 
+                  !! material generated in one level is aggregated with that 
+                  !! generated by shallower levels; this should make the 
+                  !! ballast model more self-consistent (famous last words)
+                  !!-------------------------------------------------------
+                  !!
+                  if (jk.eq.1) then
+                     !! this is the SURFACE OCEAN BOX (no remineralisation)
+                     !!
+                     freminc(ji,jj)  = 0.0
+                     freminn(ji,jj)  = 0.0
+                     freminfe(ji,jj) = 0.0
+                     freminsi(ji,jj) = 0.0
+                     freminca(ji,jj) = 0.0
+                  elseif (jk.le.mbathy(ji,jj)) then
+                     !! this is an OCEAN BOX (remineralise some material)
+                     !!
+                     !! set up CCD depth to be used depending on user choice
+                     if (jocalccd.eq.0) then
+                        !! use default CCD field
+                        fccd_dep(ji,jj) = ocal_ccd(ji,jj)
+                     elseif (jocalccd.eq.1) then
+                        !! use calculated CCD field
+                        fccd_dep(ji,jj) = f2_ccd_cal(ji,jj)
+                     endif
+                     !!
+                     !! === organic carbon ===
+                     !! how much organic C enters this box        (mol)
+                     fq0      = ffastc(ji,jj)
+                     if (iball.eq.1) then
+                        !! how much it weighs
+                        fq1      = (fq0 * xmassc)
+                        !! how much CaCO3 enters this box
+                        fq2      = (ffastca(ji,jj) * xmassca)
+                        !! how much  opal enters this box
+                        fq3      = (ffastsi(ji,jj) * xmasssi)
+                        !! total protected organic C
+                        fq4      = (fq2 * xprotca) + (fq3 * xprotsi)
+                        !! This next term is calculated for C but used for
+                        !! N and Fe as well
+                        !! It needs to be protected in case ALL C is protected
+                        if (fq4.lt.fq1) then
+                           !! protected fraction of total organic C (non-dim)
+                           fprotf   = (fq4 / (fq1 + tiny(fq1)))
+                        else
+                           !! all organic C is protected (non-dim)
+                           fprotf   = 1.0
+                        endif
+                        !! unprotected fraction of total organic C (non-dim)
+                        fq5      = (1.0 - fprotf)
+                        !! how much organic C is unprotected (mol)
+                        fq6      = (fq0 * fq5)
+                        !! how much unprotected C leaves this box (mol)
+                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
+                        !! how much total C leaves this box (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))
+                        !! C remineralisation in this box (mol)
+                        freminc(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk)
+                        ffastc(ji,jj) = fq8
+# if defined key_debug_medusa
+                        !! report in/out/remin fluxes of carbon for this level
+                           if (idf.eq.1.AND.idfval.eq.1) then
+                              IF (lwp) write (numout,*)                       &
+                                       '------------------------------'
+                              IF (lwp) write (numout,*) 'totalC(',jk,')  = ', &
+                                       fq1
+                              IF (lwp) write (numout,*) 'prtctC(',jk,')  = ', &
+                                       fq4
+                              IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', &
+                                       fprotf
+                              IF (lwp) write (numout,*)                       &
+                                       '------------------------------'
+                              IF (lwp) write (numout,*) 'IN   C(',jk,')  = ', &
+                                       fq0
+                              IF (lwp) write (numout,*) 'LOST C(',jk,')  = ', &
+                                       freminc(ji,jj) * fse3t(ji,jj,jk)
+                              IF (lwp) write (numout,*) 'OUT  C(',jk,')  = ', &
+                                       fq8
+                              IF (lwp) write (numout,*) 'NEW  C(',jk,')  = ', &
+                                       ftempc(ji,jj) * fse3t(ji,jj,jk)
+                           endif
+# endif
+                        else
+                        !! how much organic C leaves this box (mol)
+                        fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastc))
+                        !! C remineralisation in this box (mol)
+                        freminc(ji,jj)  = (fq0 - fq1) / fse3t(ji,jj,jk)
+                        ffastc(ji,jj)  = fq1
+                     endif
+                     !!
+                     !! === organic nitrogen ===
+                     !! how much organic N enters this box (mol)
+                     fq0      = ffastn(ji,jj)
+                     if (iball.eq.1) then
+                        !! unprotected fraction of total organic N (non-dim)
+                        fq5      = (1.0 - fprotf)
+                        !! how much organic N is unprotected (mol)
+                        fq6      = (fq0 * fq5)
+                        !! how much unprotected N leaves this box (mol)
+                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
+                        !! how much total N leaves this box (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))
+                        !! N remineralisation in this box (mol)
+                        freminn(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk)
+                        ffastn(ji,jj)  = fq8
+# if defined key_debug_medusa
+                        !! report in/out/remin fluxes of carbon for this level
+                        if (idf.eq.1.AND.idfval.eq.1) then
+                           IF (lwp) write (numout,*)                          &
+                                    '------------------------------'
+                           IF (lwp) write (numout,*) 'totalN(',jk,')  = ', fq1
+                           IF (lwp) write (numout,*) 'prtctN(',jk,')  = ', fq4
+                           IF (lwp) write (numout,*) 'fprotf(',jk,')  = ',    &
+                                    fprotf
+                           IF (lwp) write (numout,*)                          &
+                                    '------------------------------'
+                           if (freminn(ji,jj) < 0.0) then
+                              IF (lwp) write (numout,*) '** FREMIN ERROR **'
+                           endif
+                           IF (lwp) write (numout,*) 'IN   N(',jk,')  = ', fq0
+                           IF (lwp) write (numout,*) 'LOST N(',jk,')  = ',    &
+                                    freminn(ji,jj) * fse3t(ji,jj,jk)
+                           IF (lwp) write (numout,*) 'OUT  N(',jk,')  = ', fq8
+                           IF (lwp) write (numout,*) 'NEW  N(',jk,')  = ',    &
+                                    ftempn(ji,jj) * fse3t(ji,jj,jk)
+                        endif
+# endif
+                     else
+                        !! how much organic N leaves this box (mol)
+                        fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastc))
+                        !! N remineralisation in this box (mol)
+                        freminn(ji,jj)  = (fq0 - fq1) / fse3t(ji,jj,jk)
+                        ffastn(ji,jj)  = fq1
+                     endif
+                     !!
+                     !! === organic iron ===
+                     !! how much organic Fe enters this box (mol)
+                     fq0      = ffastfe(ji,jj)
+                     if (iball.eq.1) then
+                        !! unprotected fraction of total organic Fe (non-dim)
+                        fq5      = (1.0 - fprotf)
+                        !! how much organic Fe is unprotected (mol)
+                        fq6      = (fq0 * fq5)
+                        !! how much unprotected Fe leaves this box (mol)
+                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
+                        !! how much total Fe leaves this box (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))
+                        !! Fe remineralisation in this box (mol)
+                        freminfe(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk)
+                        ffastfe(ji,jj) = fq8
+                     else
+                        !! how much total Fe leaves this box (mol)
+                        fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastc))
+                        !! Fe remineralisation in this box (mol)
+                        freminfe(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                        ffastfe(ji,jj) = fq1
+                     endif
+                     !!
+                     !! === biogenic silicon ===
+                     !! how much  opal centers this box (mol)
+                     fq0      = ffastsi(ji,jj)
+                     !! how much  opal leaves this box (mol)
+                     fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastsi))
+                     !! Si remineralisation in this box (mol)
+                     freminsi(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     ffastsi(ji,jj) = fq1
+                     !!
+                     !! === biogenic calcium carbonate ===
+                     !! how much CaCO3 enters this box (mol)
+                     fq0      = ffastca(ji,jj)
+                     if (fsdepw(ji,jj,jk).le.fccd_dep(ji,jj)) then
+                        !! whole grid cell above CCD
+                        !! above lysocline, no Ca dissolves (mol)
+                        fq1      = fq0
+                        !! above lysocline, no Ca dissolves (mol)
+                        freminca(ji,jj) = 0.0
+                        !! which is the last level above the CCD?    (#)
+                        fccd(ji,jj) = real(jk)
+                     elseif (fsdepw(ji,jj,jk).ge.fccd_dep(ji,jj)) then
+                        !! whole grid cell below CCD
+                        !! how much CaCO3 leaves this box (mol)
+                        fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastca))
+                        !! Ca remineralisation in this box (mol)
+                        freminca(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     else
+                        !! partial grid cell below CCD
+                        !! amount of grid cell below CCD (m)
+                        fq2      = fdep1(ji,jj) - fccd_dep(ji,jj)
+                        !! how much CaCO3 leaves this box (mol)
+                        fq1      = fq0 * exp(-(fq2 / xfastca))
+                        !! Ca remineralisation in this box (mol)
+                        freminca(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     endif
+                     ffastca(ji,jj) = fq1 
+                  else
+                     !! this is BELOW THE LAST OCEAN BOX (do nothing)
+                     freminc(ji,jj)  = 0.0
+                     freminn(ji,jj)  = 0.0
+                     freminfe(ji,jj) = 0.0
+                     freminsi(ji,jj) = 0.0
+                     freminca(ji,jj) = 0.0              
+                  endif
+               ENDIF
+            ENDDO
+         ENDDO
+      elseif (jexport.eq.2.or.jexport.eq.3) then
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  if (jexport.eq.2) then
+                     !!====================================================
+                     !! MARTIN ET AL. (1987) SUBMODEL
+                     !!====================================================
+                     !! 
+                     !!----------------------------------------------------
+                     !! This submodel uses the classic Martin et al. (1987) 
+                     !! curve to determine the attenuation of fast-sinking 
+                     !! detritus down the water column.  All three organic 
+                     !! elements, C, N and Fe, are handled identically, and 
+                     !! their quantities in sinking particles attenuate 
+                     !! according to a power relationship governed by 
+                     !! parameter "b".  This is assigned a canonical value 
+                     !! of -0.858.  Biogenic opal and calcium carbonate are
+                     !! attentuated using the same function as in the
+                     !! ballast submodel
+                     !!----------------------------------------------------
+                     !!
+                     fb_val = -0.858
+                  elseif (jexport.eq.3) then
+                     !!====================================================
+                     !! HENSON ET AL. (2011) SUBMODEL
+                     !!====================================================
+                     !!
+                     !!----------------------------------------------------
+                     !! This submodel reconfigures the Martin et al. (1987) 
+                     !! curve by allowing the "b" value to vary 
+                     !! geographically.  Its value is set, following Henson 
+                     !! et al. (2011), as a function of local sea surface 
+                     !! temperature:
+                     !!   b = -1.06 + (0.024 * SST)
+                     !! This means that remineralisation length scales are 
+                     !! longer in warm, tropical areas and shorter in cold, 
+                     !! polar areas.  This does seem back-to-front (i.e. 
+                     !! one would expect GREATER remineralisation in warmer 
+                     !! waters), but is an outcome of analysis of sediment 
+                     !! trap data, and it may reflect details of ecosystem 
+                     !! structure that pertain to particle production
+                     !! rather than simply Q10.
+                     !!----------------------------------------------------
+                     !!
+                     fl_sst = tsn(ji,jj,1,jp_tem)
+                     fb_val = -1.06 + (0.024 * fl_sst)
+                  endif
+                  !!   
+                  if (jk.eq.1) then
+                     !! this is the SURFACE OCEAN BOX (no remineralisation)
+                     !!
+                     freminc(ji,jj)  = 0.0
+                     freminn(ji,jj)  = 0.0
+                     freminfe(ji,jj) = 0.0
+                     freminsi(ji,jj) = 0.0
+                     freminca(ji,jj) = 0.0
+                  elseif (jk.le.mbathy(ji,jj)) then
+                     !! this is an OCEAN BOX (remineralise some material)
+                     !!
+                     !! === organic carbon ===
+                     !! how much organic C enters this box (mol)
+                     fq0      = ffastc(ji,jj)
+                     !! how much organic C leaves this box (mol)
+                     fq1      = fq0 * ((fdep1(ji,jj)/fsdepw(ji,jj,jk))**fb_val)
+                     !! C remineralisation in this box (mol)
+                     freminc(ji,jj)  = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     ffastc(ji,jj)  = fq1
+                     !!
+                     !! === organic nitrogen ===
+                     !! how much organic N enters this box (mol)
+                     fq0      = ffastn(ji,jj)
+                     !! how much organic N leaves this box (mol)
+                     fq1      = fq0 * ((fdep1(ji,jj)/fsdepw(ji,jj,jk))**fb_val)
+                     !! N remineralisation in this box (mol)
+                     freminn(ji,jj)  = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     ffastn(ji,jj)  = fq1
+                     !!
+                     !! === organic iron ===
+                     !! how much organic Fe enters this box (mol)
+                     fq0      = ffastfe(ji,jj)
+                     !! how much organic Fe leaves this box (mol)
+                     fq1      = fq0 * ((fdep1(ji,jj)/fsdepw(ji,jj,jk))**fb_val)
+                     !! Fe remineralisation in this box (mol)
+                     freminfe(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     ffastfe(ji,jj) = fq1
+                     !!
+                     !! === biogenic silicon ===
+                     !! how much  opal centers this box (mol)
+                     fq0      = ffastsi(ji,jj)
+                     !! how much  opal leaves this box (mol)
+                     fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastsi))
+                     !! Si remineralisation in this box (mol)
+                     freminsi(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     ffastsi(ji,jj) = fq1
+                     !!
+                     !! === biogenic calcium carbonate ===
+                     !! how much CaCO3 enters this box (mol)
+                     fq0      = ffastca(ji,jj)
+                     if (fsdepw(ji,jj,jk).le.ocal_ccd(ji,jj)) then
+                        !! whole grid cell above CCD
+                        !! above lysocline, no Ca dissolves (mol)
+                        fq1      = fq0
+                        !! above lysocline, no Ca dissolves (mol)
+                        freminca(ji,jj) = 0.0
+                        !! which is the last level above the CCD?    (#)
+                        fccd(ji,jj) = real(jk)
+                     elseif (fsdepw(ji,jj,jk).ge.ocal_ccd(ji,jj)) then
+                        !! whole grid cell below CCD
+                        !! how much CaCO3 leaves this box (mol)
+                        fq1      = fq0 * exp(-(fse3t(ji,jj,jk) / xfastca))
+                        !! Ca remineralisation in this box (mol)
+                        freminca(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     else
+                        !! partial grid cell below CCD
+                        !! amount of grid cell below CCD (m)
+                        fq2      = fdep1(ji,jj) - ocal_ccd(ji,jj)
+                        !! how much CaCO3 leaves this box (mol)
+                        fq1      = fq0 * exp(-(fq2 / xfastca))
+                        !! Ca remineralisation in this box (mol)
+                        freminca(ji,jj) = (fq0 - fq1) / fse3t(ji,jj,jk)
+                     endif
+                     ffastca(ji,jj) = fq1 
+                  else
+                     !! this is BELOW THE LAST OCEAN BOX (do nothing)
+                     freminc(ji,jj)  = 0.0
+                     freminn(ji,jj)  = 0.0
+                     freminfe(ji,jj) = 0.0
+                     freminsi(ji,jj) = 0.0
+                     freminca(ji,jj) = 0.0              
+                  endif
+               ENDIF
+            ENDDO
+         ENDDO
+      endif
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Fast-sinking detritus fluxes, pt. 2: UPDATE FAST FLUXES
+               !! here locally calculated additions to the fast-sinking 
+               !! flux are added to the total fast-sinking flux; this is 
+               !! done here such that material produced in a particular 
+               !! layer is only remineralised below this layer
+               !!----------------------------------------------------------
+               !!
+               !! add sinking material generated in this layer to running 
+               !! totals
+               !!
+               !! === organic carbon === 
+               !! (diatom and mesozooplankton mortality)
+               ffastc(ji,jj)  = ffastc(ji,jj)  + (ftempc(ji,jj)  *           &
+                                                  fse3t(ji,jj,jk))
+               !!
+               !! === organic nitrogen ===
+               !! (diatom and mesozooplankton mortality)
+               ffastn(ji,jj)  = ffastn(ji,jj)  + (ftempn(ji,jj)  *           &
+                                                  fse3t(ji,jj,jk))
+               !!
+               !! === organic iron ===
+               !! (diatom and mesozooplankton mortality)
+               ffastfe(ji,jj) = ffastfe(ji,jj) + (ftempfe(ji,jj) *          &
+                                                  fse3t(ji,jj,jk))
+               !!
+               !! === biogenic silicon ===
+               !! (diatom mortality and grazed diatoms)
+               ffastsi(ji,jj) = ffastsi(ji,jj) + (ftempsi(ji,jj) *          &
+                                                  fse3t(ji,jj,jk))
+               !!
+               !! === biogenic calcium carbonate ===
+               !! (latitudinally-based fraction of total primary production)
+               ffastca(ji,jj) = ffastca(ji,jj) + (ftempca(ji,jj) *          &
+                                                  fse3t(ji,jj,jk))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Fast-sinking detritus fluxes, pt. 3: SEAFLOOR
+               !! remineralise all remaining fast-sinking detritus to dissolved
+               !! nutrients; the sedimentation fluxes calculated here allow the
+               !! separation of what's remineralised sinking through the final
+               !! ocean box from that which is added to the final box by the
+               !! remineralisation of material that reaches the seafloor (i.e.
+               !! the model assumes that *all* material that hits the seafloor
+               !! is remineralised and that none is permanently buried; hey,
+               !! this is a giant GCM model that can't be run for long enough
+               !! to deal with burial fluxes!)
+               !!
+               !! in a change to this process, in part so that MEDUSA behaves
+               !! a little more like ERSEM et al., fast-sinking detritus (N, Fe
+               !! and C) is converted to slow sinking detritus at the seafloor
+               !! instead of being remineralised; the rationale is that in
+               !! shallower shelf regions (... that are not fully mixed!) this
+               !! allows the detrital material to return slowly to dissolved 
+               !! nutrient rather than instantaneously as now; the alternative
+               !! would be to explicitly handle seafloor organic material - a
+               !! headache I don't wish to experience at this point; note that
+               !! fast-sinking Si and Ca detritus is just remineralised as 
+               !! per usual
+               !! 
+               !! AXY (13/01/12)
+               !! in a further change to this process, again so that MEDUSA is
+               !! a little more like ERSEM et al., material that reaches the
+               !! seafloor can now be added to sediment pools and stored for
+               !! slow release; there are new 2D arrays for organic nitrogen,
+               !! iron and carbon and inorganic silicon and carbon that allow
+               !! fast and slow detritus that reaches the seafloor to be held
+               !! and released back to the water column more slowly; these
+               !! arrays are transferred via the tracer restart files between
+               !! repeat submissions of the model
+               !!----------------------------------------------------------
+               !! 
+               ffast2slowc(ji,jj)  = 0.0
+               ffast2slown(ji,jj)  = 0.0
+! I don't think this is used - marc 10/4/17
+!               ffast2slowfe(ji,jj) = 0.0
+               !!
+               if (jk.eq.mbathy(ji,jj)) then
+                  !! this is the BOTTOM OCEAN BOX (remineralise everything)
+                  !!
+                  !! AXY (17/01/12): tweaked to include benthos pools
+                  !! 
+                  !! === organic carbon ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     !! C remineralisation in this box (mol/m3)
+                     freminc(ji,jj)  = freminc(ji,jj) + (ffastc(ji,jj) /     &
+                                                         fse3t(ji,jj,jk))
+                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+                     !! fast C -> slow C (mol/m3)
+                     ffast2slowc(ji,jj) = ffastc(ji,jj) / fse3t(ji,jj,jk)
+                     fslowc(ji,jj)      = fslowc(ji,jj) + ffast2slowc(ji,jj)
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     !! fast C -> benthic C (mol/m2)
+                     f_fbenin_c(ji,jj)  = ffastc(ji,jj)
+                  endif
+                  !! record seafloor C (mol/m2)
+                  fsedc(ji,jj)   = ffastc(ji,jj)
+                  ffastc(ji,jj)  = 0.0
+                  !!
+                  !! === organic nitrogen ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     !! N remineralisation in this box (mol/m3)
+                     freminn(ji,jj)  = freminn(ji,jj) + (ffastn(ji,jj) /     &
+                                                         fse3t(ji,jj,jk))
+                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+                     !! fast N -> slow N (mol/m3)
+                     ffast2slown(ji,jj) = ffastn(ji,jj) / fse3t(ji,jj,jk)
+                     fslown(ji,jj)      = fslown(ji,jj) + ffast2slown(ji,jj)
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     !! fast N -> benthic N (mol/m2)
+                     f_fbenin_n(ji,jj)  = ffastn(ji,jj)
+                  endif
+                  !! record seafloor N (mol/m2)
+                  fsedn(ji,jj)   = ffastn(ji,jj)
+                  ffastn(ji,jj)  = 0.0
+                  !!
+                  !! === organic iron ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     !! Fe remineralisation in this box (mol/m3)
+                     freminfe(ji,jj) = freminfe(ji,jj) + (ffastfe(ji,jj) /   &
+                                                          fse3t(ji,jj,jk))
+! I don't think ffast2slowfe is used - marc 10/4/17
+!                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+!                     !! fast Fe -> slow Fe (mol/m3)
+!                     ffast2slowfe(ji,jj) = ffastn(ji,jj) / fse3t(ji,jj,jk)
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     !! fast Fe -> benthic Fe (mol/m2)
+                     f_fbenin_fe(ji,jj) = ffastfe(ji,jj)
+                  endif
+                  !! record seafloor Fe (mol/m2)
+                  fsedfe(ji,jj)  = ffastfe(ji,jj)
+                  ffastfe(ji,jj) = 0.0
+                  !!
+                  !! === biogenic silicon ===
+                  if (jinorgben.eq.0) then
+                     !! Si remineralisation in this box (mol/m3)
+                     freminsi(ji,jj) = freminsi(ji,jj) + (ffastsi(ji,jj) /   &
+                                                          fse3t(ji,jj,jk))
+                  elseif (jinorgben.eq.1) then
+                     !! fast Si -> benthic Si
+                     f_fbenin_si(ji,jj) = ffastsi(ji,jj)
+                  endif
+                  !! record seafloor Si (mol/m2)
+                  fsedsi(ji,jj)   = ffastsi(ji,jj)
+                  ffastsi(ji,jj) = 0.0
+                  !!
+                  !! === biogenic calcium carbonate ===
+                  if (jinorgben.eq.0) then
+                     !! Ca remineralisation in this box (mol/m3)
+                     freminca(ji,jj) = freminca(ji,jj) + (ffastca(ji,jj) /   &
+                                                          fse3t(ji,jj,jk))
+                  elseif (jinorgben.eq.1) then
+                     !! fast Ca -> benthic Ca (mol/m2)
+                     f_fbenin_ca(ji,jj) = ffastca(ji,jj)
+                  endif
+                  !! record seafloor Ca (mol/m2)
+                  fsedca(ji,jj)   = ffastca(ji,jj)
+                  ffastca(ji,jj) = 0.0
+               endif
+
+# if defined key_debug_medusa
+               if (idf.eq.1) then
+                  !!-------------------------------------------------------
+                  !! Integrate total fast detritus remineralisation
+                  !!-------------------------------------------------------
+                  !!
+                  fofd_n(ji,jj)  = fofd_n(ji,jj)  + (freminn(ji,jj)  *       &
+                                                     fse3t(ji,jj,jk))
+                  fofd_si(ji,jj) = fofd_si(ji,jj) + (freminsi(ji,jj) *       &
+                                                     fse3t(ji,jj,jk))
+                  fofd_fe(ji,jj) = fofd_fe(ji,jj) + (freminfe(ji,jj) *       &
+                                                     fse3t(ji,jj,jk))
+#  if defined key_roam
+                  fofd_c(ji,jj)  = fofd_c(ji,jj)  + (freminc(ji,jj)  *       &
+                                                     fse3t(ji,jj,jk))
+#  endif
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Sort out remineralisation tally of fast-sinking detritus
+               !!----------------------------------------------------------
+               !!
+               !! update fast-sinking regeneration arrays
+               fregenfast(ji,jj)   = fregenfast(ji,jj)   +                  &
+                                     (freminn(ji,jj)  * fse3t(ji,jj,jk))
+               fregenfastsi(ji,jj) = fregenfastsi(ji,jj) +                  &
+                                     (freminsi(ji,jj) * fse3t(ji,jj,jk))
+# if defined key_roam
+               fregenfastc(ji,jj)  = fregenfastc(ji,jj)  +                  &
+                                     (freminc(ji,jj)  * fse3t(ji,jj,jk))
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Benthic remineralisation fluxes
+               !!----------------------------------------------------------
+               !!
+               if (jk.eq.mbathy(ji,jj)) then
+                  !!
+                  !! organic components
+                  if (jorgben.eq.1) then
+                     f_benout_n(ji,jj)  = xsedn  * zn_sed_n(ji,jj)
+                     f_benout_fe(ji,jj) = xsedfe * zn_sed_fe(ji,jj)
+                     f_benout_c(ji,jj)  = xsedc  * zn_sed_c(ji,jj)
+                  endif
+                  !!
+                  !! inorganic components
+                  if (jinorgben.eq.1) then
+                     f_benout_si(ji,jj) = xsedsi * zn_sed_si(ji,jj)
+                     f_benout_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj)
+                     !!
+                     !! account for CaCO3 that dissolves when it shouldn't
+                     if ( fsdepw(ji,jj,jk) .le. fccd_dep(ji,jj) ) then
+                        f_benout_lyso_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj)
+                     endif
+                  endif
+               endif
+               CALL flush(numout)
+
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE detritus_fast_sink
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE detritus_fast_sink( )                    ! Empty routine
+      WRITE(*,*) 'detritus_fast_sink: You should not have seen this print! error?'
+   END SUBROUTINE detritus_fast_sink
+#endif 
+
+   !!======================================================================
+END MODULE detritus_fast_sink_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/gas_transfer.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/gas_transfer.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/gas_transfer.F90	(revision 9824)
@@ -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$
+   !! 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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/iron_chem_scav.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/iron_chem_scav.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/iron_chem_scav.F90	(revision 9824)
@@ -0,0 +1,546 @@
+MODULE iron_chem_scav_mod
+   !!======================================================================
+   !!                         ***  MODULE iron_chem_scav_mod  ***
+   !! Calculate the iron chemistry and scavenging.
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   iron_chem_scav        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iron_chem_scav( jk )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE iron_chem_scav  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - 
+      !!-------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: ffastc, ffastca, ffastsi,              &
+                                   ffetop, ffebot, ffescav, xfree,        & 
+                                   zdet, zfer, zphd, zphn, zzme, zzmi,    &
+                                   idf, idfval                          
+      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n,        &
+                                   mbathy, tmask
+      USE par_kind,          ONLY: wp
+      USE in_out_manager,    ONLY: lwp, numout
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1
+      USE sms_medusa,        ONLY: i0500, jiron, xfe_sed, xfe_sol,        &
+                                   xfe_mass,                              &
+                                   xk_FeL, xk_sc_Fe, xLgT,                &
+                                   xmassc, xmassca, xmasssi,              &
+                                   xthetad, xthetapd, xthetapn,           &
+                                   xthetazme, xthetazmi,                  &
+                                   zirondep
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+
+      !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme
+      !! state variables for iron-ligand system
+      REAL(wp), DIMENSION(jpi,jpj) :: xFeT, xFeF, xFeL
+      REAL(wp) :: xLgF
+      !! iron-ligand parameters
+      REAL(wp) :: xb_coef_tmp, xb2M4ac
+      !! max Fe' parameters
+      REAL(wp) :: xmaxFeF,fdeltaFe
+      !!
+      !! local parameters for Moore et al. (2004) alternative scavenging 
+      !! scheme
+      REAL(wp) :: fbase_scav,fscal_sink,fscal_part,fscal_scav
+      !!
+      !! local parameters for Moore et al. (2008) alternative scavenging 
+      !! scheme
+      REAL(wp) :: fscal_csink,fscal_sisink,fscal_casink
+      !!
+      !! local parameters for Galbraith et al. (2010) alternative 
+      !! scavenging scheme.
+      !! organic portion of scavenging
+      REAL(wp) :: xCscav1, xCscav2, xk_org, xORGscav
+      !! inorganic portion of scavenging
+      REAL(wp) :: xk_inorg, xINORGscav
+
+      INTEGER :: ji, jj
+
+      !!------------------------------------------------------------------
+      !! Iron chemistry and fractionation
+      !! following the Parekh et al. (2004) scheme adopted by the Met.
+      !! Office, Medusa models total iron but considers "free" and
+      !! ligand-bound forms for the purposes of scavenging (only "free"
+      !! iron can be scavenged
+      !!------------------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+               xFeT(ji,jj) = zfer(ji,jj) * 1.e3
+               !!
+               !! calculate fractionation (based on Diat-HadOCC; in turn 
+               !! based on Parekh et al., 2004)
+               xb_coef_tmp = xk_FeL * (xLgT - xFeT(ji,jj)) - 1.0
+               xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) +              &
+                                  (4.0 * xk_FeL * xLgT)), 0.0)
+               !!
+               !! "free" ligand concentration
+               xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL
+               !!
+               !! ligand-bound iron concentration
+               xFeL(ji,jj) = xLgT - xLgF
+               !!
+               !! "free" iron concentration (and convert to mmol Fe / m3)
+               xFeF(ji,jj) = (xFeT(ji,jj) - xFeL(ji,jj)) * 1.e-3
+               xFree(ji,jj)= xFeF(ji,jj) / (zfer(ji,jj) + tiny(zfer(ji,jj)))
+            ENDIF
+         ENDDO
+      ENDDO
+
+
+      !!
+      !! scavenging of iron (multiple schemes); I'm only really 
+      !! happy with the first one at the moment - the others 
+      !! involve assumptions (sometimes guessed at by me) that 
+      !! are potentially questionable
+      !!
+      if (jiron.eq.1) then
+         !!------------------------------------------------------
+         !! Scheme 1: Dutkiewicz et al. (2005)
+         !! This scheme includes a single scavenging term based 
+         !! solely on a fixed rate and the availablility of 
+         !! "free" iron
+         !!------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  !! = mmol/m3/d
+                  ffescav(ji,jj)     = xk_sc_Fe * xFeF(ji,jj)
+                  !!
+                  !!------------------------------------------------------
+                  !!
+                  !! Mick's code contains a further (optional) implicit 
+                  !! "scavenging" of iron that sets an upper bound on 
+                  !! "free" iron concentration, and essentially caps the 
+                  !! concentration of total iron as xFeL + "free" iron; 
+                  !! since the former is constrained by a fixed total 
+                  !! ligand concentration (= 1.0 umol/m3), and the latter 
+                  !! isn't allowed above this upper bound, total iron is 
+                  !! constrained to a maximum of ...
+                  !!
+                  !!    xFeL(ji,jj) + min(xFeF(ji,jj), 0.3 umol/m3) = 1.0 + 0.3 
+                  !!                                  = 1.3 umol / m3
+                  !! 
+                  !! In Mick's code, the actual value of total iron is 
+                  !! reset to this sum (i.e. TFe = FeL + Fe'; but 
+                  !! Fe' <= 0.3 umol/m3); this isn't our favoured approach 
+                  !! to tracer updating here (not least because of the 
+                  !! leapfrog), so here the amount scavenged is augmented 
+                  !! by an additional amount that serves to drag total 
+                  !! iron back towards that expected from this limitation 
+                  !! on iron concentration ...
+                  !!
+                  !! = umol/m3
+                  xmaxFeF     = min((xFeF(ji,jj) * 1.e3), 0.3)
+                  !!
+                  !! Here, the difference between current total Fe and 
+                  !! (FeL + Fe') is calculated and added to the scavenging 
+                  !! flux already calculated above ...
+                  !!
+                  !! = mmol/m3
+                  fdeltaFe    = (xFeT(ji,jj) - (xFeL(ji,jj) + xmaxFeF)) * 1.e-3
+                  !!
+                  !! This assumes that the "excess" iron is dissipated 
+                  !! with a time-scale of 1 day; seems reasonable to me 
+                  !! ... (famous last words)
+                  !!
+                  !! = mmol/m3/d
+                  ffescav(ji,jj)     = ffescav(ji,jj) + fdeltaFe
+                  !!
+# if defined key_deep_fe_fix
+                  !! AXY (17/01/13)
+                  !! stop scavenging for iron concentrations below 
+                  !! 0.5 umol / m3 at depths greater than 1000 m; this 
+                  !! aims to end MEDUSA's continual loss of iron at depth 
+                  !! without impacting things at the surface too much; the 
+                  !! justification for this is that it appears to be what 
+                  !! Mick Follows et al. do in their work (as evidenced by 
+                  !! the iron initial condition they supplied me with); to 
+                  !! be honest, it looks like Follow et al. do this at
+                  !! shallower depths than 1000 m, but I'll stick with this
+                  !! for now; I suspect that this seemingly arbitrary
+                  !! approach effectively "parameterises" the 
+                  !! particle-based scavenging rates that other models use 
+                  !! (i.e. at depth there are no sinking particles, so 
+                  !! scavenging stops); it might be fun justifying this in 
+                  !! a paper though!
+                  !!
+                  if ((fsdepw(ji,jj,jk).gt.1000.) .and.                       &
+                       (xFeT(ji,jj).lt.0.5)) then
+                     ffescav(ji,jj) = 0.
+                  endif
+# endif
+               ENDIF
+            ENDDO
+         ENDDO
+      elseif (jiron.eq.2) then
+         !!------------------------------------------------------
+         !! Scheme 2: Moore et al. (2004)
+         !! This scheme includes a single scavenging term that 
+         !! accounts for both suspended and sinking particles in 
+         !! the water column; this term scavenges total iron rather 
+         !! than "free" iron
+         !!------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  !!
+                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+                  xFeT(ji,jj) = zfer(ji,jj) * 1.e3
+                  !!
+                  !! this has a base scavenging rate (12% / y) which is 
+                  !! modified by local particle concentration and sinking 
+                  !! flux (and dust - but I'm ignoring that here for now) 
+                  !! and which is accelerated when Fe concentration gets
+                  !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased 
+                  !! as concentrations below 0.4 nM (= 0.4 umol/m3 = 
+                  !! 0.0004 mmol/m3)
+                  !!
+                  !! base scavenging rate (0.12 / y)
+                  fbase_scav = 0.12 / 365.25
+                  !!
+                  !! calculate sinking particle part of scaling factor
+                  !! this takes local fast sinking carbon (mmol C / m2 / d)
+                  !! and gets it into nmol C / cm3 / s ("rdt" below is the 
+                  !! number of seconds in a model timestep)
+                  !!
+                  !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.)
+                  !!
+                  !! ... actually, re-reading Moore et al.'s equations, it 
+                  !! looks like he uses his sinking flux directly, without 
+                  !! scaling it by time-step or anything, so I'll copy this 
+                  !! here ...
+                  !!
+                  fscal_sink = ffastc(ji,jj) * 1.e2
+                  !!
+                  !! calculate particle part of scaling factor
+                  !! this totals up the carbon in suspended particles 
+                  !! (Pn, Pd, Zmi, Zme, D),
+                  !! which comes out in mmol C / m3 (= nmol C / cm3), and 
+                  !! then multiplies it by a magic factor, 0.002, to get it 
+                  !! into nmol C / cm2 / s
+                  !!
+                  fscal_part = ( (xthetapn * zphn(ji,jj)) +                  &
+                                 (xthetapd * zphd(ji,jj)) +                  &
+                                 (xthetazmi * zzmi(ji,jj)) +                 &
+                                 (xthetazme * zzme(ji,jj)) +                 &
+                                 (xthetad * zdet(ji,jj)) ) * 0.002
+                  !!
+                  !! calculate scaling factor for base scavenging rate
+                  !! this uses the (now correctly scaled) sinking flux and 
+                  !! standing
+                  !! particle concentration, divides through by some sort 
+                  !! of reference value (= 0.0066 nmol C / cm2 / s) and 
+                  !! then uses this, or not if its too high, to rescale the 
+                  !! base scavenging rate
+                  !!
+                  fscal_scav = fbase_scav *                                  &
+                               min(((fscal_sink + fscal_part) / 0.0066), 4.0)
+                  !!
+                  !! the resulting scavenging rate is then scaled further 
+                  !! according to the local iron concentration (i.e. 
+                  !! diminished in low iron regions; enhanced in high iron 
+                  !! regions; less alone in intermediate iron regions)
+                  !!
+                  if (xFeT(ji,jj).lt.0.4) then
+                     !!
+                     !! low iron region
+                     !!
+                     fscal_scav = fscal_scav * (xFeT(ji,jj) / 0.4)
+                     !!
+                  elseif (xFeT(ji,jj).gt.0.6) then
+                     !!
+                     !! high iron region
+                     !!
+                     fscal_scav = fscal_scav + ((xFeT(ji,jj) / 0.6) *        &
+                                                (6.0 / 1.4))
+                     !!
+                  else
+                     !!
+                     !! intermediate iron region: do nothing
+                     !!
+                  endif
+                  !! 
+                  !! apply the calculated scavenging rate ...
+                  !!
+                  ffescav(ji,jj) = fscal_scav * zfer(ji,jj)
+                  !!
+               ENDIF
+            ENDDO
+         ENDDO
+      elseif (jiron.eq.3) then
+         !!------------------------------------------------------
+         !! Scheme 3: Moore et al. (2008)
+         !! This scheme includes a single scavenging term that 
+         !! accounts for sinking particles in the water column, 
+         !! and includes organic C, biogenic opal, calcium 
+         !! carbonate and dust in this (though the latter is 
+         !! ignored here until I work out what units the incoming
+         !! "dust" flux is in); this term scavenges total iron 
+         !! rather than "free" iron
+         !!------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  !!
+                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+                  xFeT(ji,jj) = zfer(ji,jj) * 1.e3
+                  !!
+                  !! this has a base scavenging rate which is modified by 
+                  !! local particle sinking flux (including dust - but I'm 
+                  !! ignoring that here for now) and which is accelerated 
+                  !! when Fe concentration is > 0.6 nM (= 0.6 umol/m3 = 
+                  !! 0.0006 mmol/m3), and decreased as concentrations < 
+                  !! 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3)
+                  !!
+                  !! base scavenging rate (Fe_b in paper; units may be 
+                  !! wrong there)
+                  fbase_scav = 0.00384 ! (ng)^-1 cm
+                  !!
+                  !! calculate sinking particle part of scaling factor; 
+                  !! this converts mmol / m2 / d fluxes of organic carbon, 
+                  !! silicon and calcium carbonate into ng / cm2 / s 
+                  !! fluxes; it is assumed here that the mass conversions 
+                  !! simply consider the mass of the main element
+                  !! (C, Si and Ca) and *not* the mass of the molecules 
+                  !! that they are part of; Moore et al. (2008) is unclear 
+                  !! on the conversion that should be used
+                  !!
+                  !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s
+                  !! ng C  / cm2 / s
+                  fscal_csink  = (ffastc(ji,jj)  * 1.e6 * xmassc  *          &
+                                  1.e-4 / 86400.)
+                  !! ng Si / cm2 / s
+                  fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi *          &
+                                  1.e-4 / 86400.)
+                  !! ng Ca / cm2 / s
+                  fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca *          &
+                                  1.e-4 / 86400.)
+                  !! 
+                  !! sum up these sinking fluxes and convert to ng / cm 
+                  !! by dividing through by a sinking rate of 
+                  !! 100 m / d = 1.157 cm / s
+                  !! ng / cm
+                  fscal_sink   = ((fscal_csink * 6.) + fscal_sisink +        &
+                                  fscal_casink) / (100. * 1.e3 / 86400)
+                  !!
+                  !! now calculate the scavenging rate based upon the base 
+                  !! rate and this particle flux scaling; according to the 
+                  !! published units, the result actually has *no* units, 
+                  !! but as it must be expressed per unit time for it to 
+                  !! make any sense, I'm assuming a missing "per second"
+                  !! / s
+                  fscal_scav = fbase_scav * fscal_sink
+                  !!
+                  !! the resulting scavenging rate is then scaled further 
+                  !! according to the local iron concentration (i.e. 
+                  !! diminished in low iron regions; enhanced in high iron 
+                  !! regions; less alone in intermediate iron regions)
+                  !!
+                  if (xFeT(ji,jj).lt.0.5) then
+                     !!
+                     !! low iron region (0.5 instead of the 0.4 in Moore 
+                     !! et al., 2004)
+                     !!
+                     fscal_scav = fscal_scav * (xFeT(ji,jj) / 0.5)
+                     !!
+                  elseif (xFeT(ji,jj).gt.0.6) then
+                     !!
+                     !! high iron region (functional form different in 
+                     !! Moore et al., 2004)
+                     !!
+                     fscal_scav = fscal_scav + ((xFeT(ji,jj) - 0.6) * 0.00904)
+                     !!
+                  else
+                     !!
+                     !! intermediate iron region: do nothing
+                     !!
+                  endif
+                  !! 
+                  !! apply the calculated scavenging rate ...
+                  !!
+                  ffescav(ji,jj) = fscal_scav * zfer(ji,jj)
+               ENDIF
+            ENDDO
+         ENDDO
+      elseif (jiron.eq.4) then
+         !!------------------------------------------------------
+         !! Scheme 4: Galbraith et al. (2010)
+         !! This scheme includes two scavenging terms, one for 
+         !! organic, particle-based scavenging, and another for 
+         !! inorganic scavenging; both terms scavenge "free" iron 
+         !! only
+         !!------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  !!
+                  !! Galbraith et al. (2010) present a more straightforward 
+                  !! outline of the scheme in Parekh et al. (2005) ...
+                  !! 
+                  !! sinking particulate carbon available for scavenging
+                  !! this assumes a sinking rate of 100 m / d (Moore & 
+                  !! Braucher, 2008),
+                  xCscav1    = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3
+                  !! 
+                  !! scale by Honeyman et al. (1981) exponent coefficient
+                  !! multiply by 1.e-3 to express C flux in g C rather than 
+                  !! mg C
+                  xCscav2    = (xCscav1 * 1.e-3)**0.58
+                  !!
+                  !! multiply by Galbraith et al. (2010) scavenging rate
+                  xk_org     = 0.5 ! ((g C m/3)^-1) / d
+                  xORGscav   = xk_org * xCscav2 * xFeF(ji,jj)
+                  !!
+                  !! Galbraith et al. (2010) also include an inorganic bit ...
+                  !! 
+                  !! this occurs at a fixed rate, again based on the 
+                  !! availability of "free" iron
+                  !!
+                  !! k_inorg = 1000 d**-1 nmol Fe**-0.5 kg**-0.5
+                  !!
+                  !! to implement this here, scale xFeF by 1026 to put in 
+                  !! units of umol/m3 which approximately equal nmol/kg
+                  !!
+                  xk_inorg   = 1000. ! ((nmol Fe / kg)^1.5)
+                  xINORGscav = (xk_inorg * (xFeF(ji,jj) * 1026.)**1.5) * 1.e-3
+                  !!
+                  !! sum these two terms together
+                  ffescav(ji,jj) = xORGscav + xINORGscav
+               ENDIF
+            ENDDO
+         ENDDO
+      else
+         !!------------------------------------------------------
+         !! No Scheme: you coward!
+         !! This scheme puts its head in the sand and eskews any 
+         !! decision about how iron is removed from the ocean; 
+         !! prepare to get deluged in iron you fool!
+         !!------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  ffescav(ji,jj) = 0.
+               ENDIF
+            ENDDO
+         ENDDO
+      endif
+
+      !!---------------------------------------------------------
+      !! Other iron cycle processes
+      !!---------------------------------------------------------
+      !!
+      !! aeolian iron deposition
+      !! zirondep      is in mmol-Fe / m2 / day
+      !! ffetop(ji,jj) is in mmol-dissolved-Fe / m3 / day
+      if (jk == 1) then
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  ffetop(ji,jj)  = zirondep(ji,jj) * xfe_sol / fse3t(ji,jj,jk) 
+               ENDIF
+            ENDDO
+         ENDDO
+      else
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  ffetop(ji,jj)  = 0.0
+                ENDIF
+            ENDDO
+         ENDDO
+      endif
+      !!
+      !! seafloor iron addition
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               !! AXY (10/07/12): amended to only apply sedimentary flux up 
+               !! to ~500 m down
+               !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then
+               if ((jk.eq.mbathy(ji,jj)).AND.jk.le.i0500) then
+                  !! Moore et al. (2004) cite a coastal California value of 
+                  !! 5 umol/m2/d, but adopt a global value of 2 umol/m2/d 
+                  !! for all areas < 1100 m; here we use this latter value
+                  !! but apply it everywhere
+                  !! AXY (21/07/09): actually, let's just apply it below 
+                  !! 1100 m (levels 1-37)
+                  ffebot(ji,jj)  = (xfe_sed / fse3t(ji,jj,jk))
+               else
+                  ffebot(ji,jj)  = 0.0
+               endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !! AXY (16/12/09): remove iron addition/removal processes
+      !! For the purposes of the quarter degree run, the iron 
+      !! cycle is being pegged to the initial condition supplied 
+      !! by Mick Follows via restoration with a 30 day period;
+      !! iron addition at the seafloor is still permitted with 
+      !! the idea that this extra iron will be removed by the 
+      !! restoration away from the source
+      !! ffescav(ji,jj) = 0.0
+      !! ffetop(ji,jj)  = 0.0
+      !! ffebot(ji,jj)  = 0.0
+
+# if defined key_debug_medusa
+      !! report miscellaneous calculations
+      !! report miscellaneous calculations
+      if (idf.eq.1.AND.idfval.eq.1) then
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'xfe_sol  = ', xfe_sol
+                  IF (lwp) write (numout,*) 'xfe_mass = ', xfe_mass
+                  IF (lwp) write (numout,*) 'ffetop(',jk,')  = ', ffetop(ji,jj)
+                  IF (lwp) write (numout,*) 'ffebot(',jk,')  = ', ffebot(ji,jj)
+                  IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree(ji,jj)
+                  IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav(ji,jj)
+               ENDIF
+            ENDDO
+         ENDDO
+      endif
+# endif
+
+   END SUBROUTINE iron_chem_scav
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE iron_chem_scav( )                    ! Empty routine
+      WRITE(*,*) 'iron_chem_scav: You should not have seen this print! error?'
+   END SUBROUTINE iron_chem_scav
+#endif 
+
+   !!======================================================================
+END MODULE iron_chem_scav_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_gasflux.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_gasflux.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_gasflux.F90	(revision 9824)
@@ -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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_mainmod.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_mainmod.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_mainmod.F90	(revision 9824)
@@ -0,0 +1,2061 @@
+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
+  !       -> 'w14' means use Waters (2014) 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) or \b 'w14' (Waters et al., 2014)
+!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.) (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)
+        ELSEIF (trim(opK1K2) == 'w14') THEN
+!         Waters, Millero, Woosley (Mar. Chem., 165, 66-67, 2014) (seawater scale)
+          pK1o = 6320.813d0*invtk + 19.568224d0*dlogtk -126.34048d0
+          ma1 = 13.409160d0*sqrts + 0.031646d0*s - (5.1895e-5)*s2
+          mb1 = -531.3642d0*sqrts - 5.713d0*s
+          mc1 = -2.0669166d0*sqrts
+          pK1 = pK1o + ma1 + mb1*invtk + mc1*dlogtk
+          K1(i) = 10.0d0**(-pK1) 
+
+          pK2o = 5143.692d0*invtk + 14.613358d0*dlogtk -90.18333d0
+          ma2 = 21.225890d0*sqrts + 0.12450870d0*s - (3.7243e-4_r8)*s2
+          mb2 = -779.3444d0*sqrts - 19.91739d0*s
+          mc2 = -3.3534679d0*sqrts
+          pK2 = pK2o + ma2 + mb2*invtk + mc2*dlogtk
+          K2(i) = 10.0d0**(-pK2)
+        ELSE
+           PRINT *, "optK1K2 must be either 'l' or 'm10', or 'w14'"
+           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) :: 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
+
+! 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
+
+! 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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_phsolvers.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_phsolvers.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_phsolvers.F90	(revision 9824)
@@ -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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_singledouble.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_singledouble.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_singledouble.F90	(revision 9824)
@@ -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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_wrapper.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_wrapper.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/mocsy_wrapper.F90	(revision 9824)
@@ -0,0 +1,357 @@
+MODULE mocsy_wrapper
+   !!======================================================================
+   !!                         ***  MODULE mocsy_wrapper  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2015-06  (A. Yool)             added for UKESM project
+   !!  -   !  2017-04  (A. Yool)             alter optK1K2 to 'w14' option
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA carbonate chemistry
+   !!----------------------------------------------------------------------
+   !!   mocsy_wrapper
+   !!----------------------------------------------------------------------
+
+   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$
+   !! 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)
+!
+!=======================================================================
+!
+! AXY (05/04/17): alter options to include optK1K2 = 'w14'
+!
+! In conversation with Jim Orr, Waters (2014) is now the 
+! preferred option for optK1K2 in the case of global scale 
+! simulations since this formulation works over broader ranges
+! of temperature (0 < T < 50) and salinity (1 < S < 50).
+!
+! NOTE: *contrary* to the notice above, MEDUSA has now been
+! revised to remove the PML carbonate chemistry routine as part
+! of a wider code review. This routine is not anticipated to be 
+! used again, and has several out of date parameterisations 
+! relative to MOCSY. As a result, key_mocsy is no longer required.
+!
+        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
+!   
+!  initialise depth0 to 0
+   depth0 = 0.0
+   
+!> ======================================================================
+!  CONFIGURE OPTIONS
+!> ======================================================================
+!> OPTIONS: see complete documentation in 'vars' subroutine (in mocsy_mainmod.F90)
+!> AXY (05/04/17): optK1K2 switched from 'm10' to 'w14'
+!> 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 = 'w14'    ! Lueker et al. (2000) formulations for K1 & K2 (best practices)
+   optKf   = 'dg'     ! Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+!> 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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/par_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/par_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/par_medusa.F90	(revision 9824)
@@ -0,0 +1,106 @@
+MODULE par_medusa
+   !!======================================================================
+   !!                        ***  par_medusa  ***
+   !! TOP :   set the MEDUSA parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!		   -   !  2013-03  (A. Yool) updated for v3.5 NEMO
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces      !: 
+   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d   !:
+   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d   !:
+   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd  !:
+
+#if defined key_medusa
+   !!---------------------------------------------------------------------
+   !!   'key_medusa'                     user defined tracers (MEDUSA)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_medusa     = .TRUE.   !: PTS flag 
+# if defined key_roam
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  15      !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  225     !: additional 2d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  5       !: additional 3d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+# else
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  11      !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  90      !: additional 2d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  4       !: additional 3d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+# endif
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpchn  =  jp_lm + 1      !: non-diatom chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpchd  =  jp_lm + 2      !: diatom     chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphn  =  jp_lm + 3      !: non-diatom concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphd  =  jp_lm + 4      !: diatom     concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzmi  =  jp_lm + 5      !: microzooplankton concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzme  =  jp_lm + 6      !: mesozooplankton  concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdin  =  jp_lm + 7      !: dissolved inorganic nitrogen concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsil  =  jp_lm + 8      !: silicic acid concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpfer  =  jp_lm + 9      !: total iron concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdet  =  jp_lm + 10     !: slow-sinking detritus concentration
+   INTEGER, PUBLIC, PARAMETER ::   jppds  =  jp_lm + 11     !: diatom silicon concentration
+# if defined key_roam
+   INTEGER, PUBLIC, PARAMETER ::   jpdtc  =  jp_lm + 12     !: slow-sinking detritus carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdic  =  jp_lm + 13     !: dissolved inorganic carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpalk  =  jp_lm + 14     !: alkalinity
+   INTEGER, PUBLIC, PARAMETER ::   jpoxy  =  jp_lm + 15     !: dissolved oxygen concentration
+# endif
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpchn_lc  =  1      !: non-diatom chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpchd_lc  =  2      !: diatom     chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphn_lc  =  3      !: non-diatom concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphd_lc  =  4      !: diatom     concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzmi_lc  =  5      !: microzooplankton concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzme_lc  =  6      !: mesozooplankton  concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdin_lc  =  7      !: dissolved inorganic nitrogen concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsil_lc  =  8      !: silicic acid concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpfer_lc  =  9      !: total iron concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdet_lc  =  10     !: slow-sinking detritus concentration
+   INTEGER, PUBLIC, PARAMETER ::   jppds_lc  =  11     !: diatom silicon concentration
+# if defined key_roam
+   INTEGER, PUBLIC, PARAMETER ::   jpdtc_lc  =  12     !: slow-sinking detritus carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdic_lc  =  13     !: dissolved inorganic carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpalk_lc  =  14     !: alkalinity
+   INTEGER, PUBLIC, PARAMETER ::   jpoxy_lc  =  15     !: dissolved oxygen concentration
+# endif
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                           No user defined tracers (MEDUSA)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_medusa     = .FALSE.  !: MEDUSA flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  0       !: No MEDUSA tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  0       !: No MEDUSA additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  0       !: No MEDUSA additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0     = jp_lm     + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1     = jp_lm     + jp_medusa      !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_2d  = jp_lm_2d  + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_2d  = jp_lm_2d  + jp_medusa_2d   !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_3d  = jp_lm_3d  + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_3d  = jp_lm_3d  + jp_medusa_3d   !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_trd = jp_lm_trd + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_trd = jp_lm_trd + jp_medusa_trd  !: Last  index of MEDUSA passive tracers
+
+   !!======================================================================
+END MODULE par_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/phytoplankton.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/phytoplankton.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/phytoplankton.F90	(revision 9824)
@@ -0,0 +1,471 @@
+MODULE phytoplankton_mod
+   !!======================================================================
+   !!                         ***  MODULE phytoplankton_mod  ***
+   !! Calculates the phytoplankton growth
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!   -   ! 2017-08 (A. Yool)            Mean mixed layer chlorophyll
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   phytoplankton        ! Called in plankton.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE phytoplankton( jk )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE phytoplankton  ***
+      !! This called from PLANKTON and calculates the phytoplankton
+      !! growth.
+      !!----------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: fdep1, ffld, ffln2,                   &
+                                   fjlim_pd, fjlim_pn,                   &
+                                   fnld, fnln,                           &
+                                   fprd, fprd_ml, fprds,                 &
+                                   fprn, fprn_ml, frd, frn,              &
+                                   fsin, fsld, fsld2, fthetad, fthetan,  & 
+                                   ftot_det, ftot_dtc, ftot_pd,          &
+                                   ftot_pn, ftot_zme, ftot_zmi,          &
+                                   fun_Q10, fun_T, idf, idfval,          &
+                                   zchd, zchn, zdet, zdin, zdtc,         &
+                                   zfer, zpds, zphd, zphn, zsil,         &
+                                   zzme, zzmi, fchl_ml
+      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask
+      USE in_out_manager,    ONLY: lwp, numout
+      USE oce,               ONLY: tsn
+      USE par_kind,          ONLY: wp
+      USE par_oce,           ONLY: jp_tem, jpi, jpim1, jpj, jpjm1
+      USE phycst,            ONLY: rsmall
+      USE sms_medusa,        ONLY: jliebig, jphy, jq10,                  &
+                                   xald, xaln, xfld, xfln,               &
+                                   xnld, xnln, xnsi0, xpar,              &
+                                   xsin0, xsld, xthetam, xthetamd, xuif, &
+                                   xvpd, xvpn, xxi
+      USE zdfmxl,            ONLY: hmld
+      USE lbclnk,            ONLY: lbc_lnk
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+
+      INTEGER :: ji, jj
+
+      REAL(wp), DIMENSION(jpi,jpj) :: faln, fchn, fjln
+      REAL(wp), DIMENSION(jpi,jpj) :: fald, fchd, fjld
+      REAL(wp)                     :: fchn1, fchd1
+      !! AXY (03/02/11): add in Liebig terms
+      REAL(wp)                     :: fpnlim, fpdlim
+      !! AXY (16/07/09): add in Eppley curve functionality
+      REAL(wp)                     :: xvpnT,xvpdT
+      !! silicon cycle
+      REAL(wp)                     :: fnsi
+
+      REAL(wp)                     :: fsin1, fnsi1, fnsi2
+      REAL(wp)                     :: fq0
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Chlorophyll calculations
+               !!----------------------------------------------------------
+               !!
+               !! non-diatoms
+	       if (zphn(ji,jj).GT.rsmall) then
+                  fthetan(ji,jj) = max(tiny(zchn(ji,jj)),                    &
+                                       (zchn(ji,jj) * xxi) /                 &
+                                       (zphn(ji,jj) + tiny(zphn(ji,jj))))
+                  faln(ji,jj)    = xaln * fthetan(ji,jj)
+               else
+                  fthetan(ji,jj) = 0.
+                  faln(ji,jj)    = 0.
+               endif
+               !!
+               !! diatoms
+	       if (zphd(ji,jj).GT.rsmall) then
+                  fthetad(ji,jj) = max(tiny(zchd(ji,jj)),                   &
+                                       (zchd(ji,jj) * xxi) /                &
+                                       (zphd(ji,jj) + tiny(zphd(ji,jj))))
+                  fald(ji,jj)    = xald * fthetad(ji,jj)
+               else
+                  fthetad(ji,jj) = 0.
+                  fald(ji,jj)    = 0.
+               endif
+
+# if defined key_debug_medusa
+               !! report biological calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'faln(',jk,') = ', faln(ji,jj)
+                  IF (lwp) write (numout,*) 'fald(',jk,') = ', fald(ji,jj)
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Phytoplankton light limitation
+               !!----------------------------------------------------------
+               !!
+               !! It is assumed xpar is the depth-averaged (vertical layer) PAR 
+               !! Light limitation (check self-shading) in W/m2
+               !!
+               !! Note that there is no temperature dependence in phytoplankton
+               !! growth rate or any other function. 
+               !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to 
+               !! avoid NaNs in case of Phy==0.  
+               !!
+               !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and 
+               !! non-diat: 
+               !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012
+               !!
+               !! AXY (16/07/09)
+               !! temperature for new Eppley style phytoplankton growth
+               fun_T(ji,jj)   = 1.066**(1.0 * tsn(ji,jj,jk,jp_tem))
+               !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for
+               !!                 phytoplankton growth; remin. unaffected
+               fun_Q10(ji,jj) = jq10**((tsn(ji,jj,jk,jp_tem) - 0.0) / 10.0)
+               if (jphy.eq.1) then
+                  xvpnT = xvpn * fun_T(ji,jj)
+                  xvpdT = xvpd * fun_T(ji,jj)
+               elseif (jphy.eq.2) then
+                  xvpnT = xvpn * fun_Q10(ji,jj)
+                  xvpdT = xvpd * fun_Q10(ji,jj)
+               else
+                  xvpnT = xvpn
+                  xvpdT = xvpd
+               endif
+               !!
+               !! non-diatoms
+               fchn1 = (xvpnT * xvpnT) +                                     &
+                       (faln(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk) *         &
+                        xpar(ji,jj,jk))
+               if (fchn1.GT.rsmall) then
+                  fchn(ji,jj) = xvpnT / (sqrt(fchn1) + tiny(fchn1))
+               else
+                  fchn(ji,jj) = 0.
+               endif
+               !! non-diatom J term
+               fjln(ji,jj)     = fchn(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk)
+               fjlim_pn(ji,jj) = fjln(ji,jj) / xvpnT
+               !!
+               !! diatoms
+               fchd1 = (xvpdT * xvpdT) +                                     &
+                       (fald(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk) *         &
+                        xpar(ji,jj,jk))
+               if (fchd1.GT.rsmall) then
+                  fchd(ji,jj) = xvpdT / (sqrt(fchd1) + tiny(fchd1))
+               else
+                  fchd(ji,jj) = 0.
+               endif
+               !! diatom J term
+               fjld(ji,jj)    = fchd(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk)
+               fjlim_pd(ji,jj) = fjld(ji,jj) / xvpdT
+      
+# if defined key_debug_medusa
+               !! report phytoplankton light limitation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn(ji,jj)
+                  IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd(ji,jj)
+                  IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln(ji,jj)
+                  IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld(ji,jj)
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Phytoplankton nutrient limitation
+               !!----------------------------------------------------------
+               !!
+               !! non-diatoms (N, Fe).
+               !! non-diatom Qn term
+               fnln(ji,jj)  = zdin(ji,jj) / (zdin(ji,jj) + xnln)
+               !! non-diatom Qf term
+               ffln2(ji,jj) = zfer(ji,jj) / (zfer(ji,jj) + xfln)
+               !!
+               !! diatoms (N, Si, Fe).
+               !! diatom Qn term
+               fnld(ji,jj) = zdin(ji,jj) / (zdin(ji,jj) + xnld)
+               !! diatom Qs term
+               fsld(ji,jj) = zsil(ji,jj) / (zsil(ji,jj) + xsld)
+               !! diatom Qf term
+               ffld(ji,jj) = zfer(ji,jj) / (zfer(ji,jj) + xfld)
+
+# if defined key_debug_medusa
+               !! report phytoplankton nutrient limitation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln(ji,jj)
+                  IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld(ji,jj)
+                  IF (lwp) write (numout,*) 'ffln2(',jk,') = ', ffln2(ji,jj)
+                  IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld(ji,jj)
+                  IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld(ji,jj)
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Primary production (non-diatoms)
+               !! (note: still needs multiplying by phytoplankton 
+               !! concentration)
+               !!----------------------------------------------------------
+               !!
+               if (jliebig .eq. 0) then
+                  !! multiplicative nutrient limitation
+                  fpnlim = fnln(ji,jj) * ffln2(ji,jj)
+               elseif (jliebig .eq. 1) then
+                  !! Liebig Law (= most limiting) nutrient limitation
+                  fpnlim = min(fnln(ji,jj), ffln2(ji,jj))
+               endif
+               fprn(ji,jj) = fjln(ji,jj) * fpnlim
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Primary production (diatoms)
+               !! (note: still needs multiplying by phytoplankton 
+               !! concentration)
+               !!
+               !! Production here is split between nitrogen production and 
+               !! that of silicon; depending upon the "intracellular" ratio 
+               !! of Si:N, model diatoms will uptake nitrogen/silicon 
+               !! differentially; this borrows from the diatom model of 
+               !! Mongin et al. (2006)
+               !!----------------------------------------------------------
+               !!
+               if (jliebig .eq. 0) then
+                  !! multiplicative nutrient limitation
+                  fpdlim = fnld(ji,jj) * ffld(ji,jj)
+               elseif (jliebig .eq. 1) then
+                  !! Liebig Law (= most limiting) nutrient limitation
+                  fpdlim = min(fnld(ji,jj), ffld(ji,jj))
+               endif
+               !!
+	       if (zphd(ji,jj).GT.rsmall .AND. zpds(ji,jj).GT.rsmall) then
+                  !! "intracellular" elemental ratios
+                  ! fsin(ji,jj)  = zpds(ji,jj) / (zphd(ji,jj) +              &
+                  !                               tiny(zphd(ji,jj)))
+                  ! fnsi         = zphd(ji,jj) / (zpds(ji,jj) +              &
+                  !                               tiny(zpds(ji,jj)))
+                  fsin(ji,jj) = 0.0
+                  IF( zphd(ji,jj) .GT. rsmall) fsin(ji,jj)  = zpds(ji,jj) /  &
+                                                              zphd(ji,jj)
+                  fnsi = 0.0
+                  IF( zpds(ji,jj) .GT. rsmall) fnsi  = zphd(ji,jj) /         &
+                                                       zpds(ji,jj)
+                  !! AXY (23/02/10): these next variables derive from 
+                  !! Mongin et al. (2003)
+                  fsin1 = 3.0 * xsin0 !! = 0.6
+                  fnsi1 = 1.0 / fsin1 !! = 1.667
+                  fnsi2 = 1.0 / xsin0 !! = 5.0
+                  !!
+                  !! conditionalities based on ratios
+                  !! nitrogen (and iron and carbon)
+                  if (fsin(ji,jj).le.xsin0) then
+                     fprd(ji,jj)  = 0.0
+                     fsld2(ji,jj) = 0.0
+                  elseif (fsin(ji,jj).lt.fsin1) then
+                     fprd(ji,jj)  = xuif * ((fsin(ji,jj) - xsin0) /          &
+                                            (fsin(ji,jj) +                   &
+                                             tiny(fsin(ji,jj)))) *           &
+                                    (fjld(ji,jj) * fpdlim)
+                     fsld2(ji,jj) = xuif * ((fsin(ji,jj) - xsin0) /          &
+                                            (fsin(ji,jj) +                   &
+                                             tiny(fsin(ji,jj))))
+                  elseif (fsin(ji,jj).ge.fsin1) then
+                     fprd(ji,jj)  = (fjld(ji,jj) * fpdlim)
+                     fsld2(ji,jj) = 1.0
+                  endif
+                  !!
+                  !! silicon
+                  if (fsin(ji,jj).lt.fnsi1) then
+                     fprds(ji,jj) = (fjld(ji,jj) * fsld(ji,jj))
+                  elseif (fsin(ji,jj).lt.fnsi2) then
+                     fprds(ji,jj) = xuif * ((fnsi - xnsi0) /          &
+                                            (fnsi + tiny(fnsi))) *           &
+                                    (fjld(ji,jj) * fsld(ji,jj))
+                  else
+                     fprds(ji,jj) = 0.0
+                  endif     
+               else
+                  fsin(ji,jj)  = 0.0
+                  fnsi         = 0.0
+                  fprd(ji,jj)  = 0.0
+                  fsld2(ji,jj) = 0.0
+                  fprds(ji,jj) = 0.0
+               endif
+
+# if defined key_debug_medusa
+               !! report phytoplankton growth (including diatom silicon 
+               !! submodel)
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fsin(',jk,')   = ', fsin(ji,jj)
+                  IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi
+                  IF (lwp) write (numout,*) 'fsld2(',jk,')  = ', fsld2(ji,jj)
+                  IF (lwp) write (numout,*) 'fprn(',jk,')   = ', fprn(ji,jj)
+                  IF (lwp) write (numout,*) 'fprd(',jk,')   = ', fprd(ji,jj)
+                  IF (lwp) write (numout,*) 'fprds(',jk,')  = ', fprds(ji,jj)
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Mixed layer primary production
+               !! this block calculates the amount of primary production 
+               !! that occurs within the upper mixed layer; this allows the 
+               !! separate diagnosis of "sub-surface" primary production; it 
+               !! does assume that short-term variability in mixed layer 
+               !! depth doesn't mess with things though
+               !!----------------------------------------------------------
+               !!
+               if (fdep1(ji,jj).le.hmld(ji,jj)) then
+                  !! this level is entirely in the mixed layer
+                  fq0 = 1.0
+               elseif (fsdepw(ji,jj,jk).ge.hmld(ji,jj)) then
+                  !! this level is entirely below the mixed layer
+                  fq0 = 0.0
+               else
+                  !! this level straddles the mixed layer
+                  fq0 = (hmld(ji,jj) - fsdepw(ji,jj,jk)) / fse3t(ji,jj,jk)
+               endif
+               !!
+               fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn(ji,jj) * zphn(ji,jj) * &
+                                                  fse3t(ji,jj,jk) * fq0)
+               fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd(ji,jj) * zphd(ji,jj) * &
+                                                  fse3t(ji,jj,jk) * fq0)
+	       !! AXY (16/08/17)
+	       fchl_ml(ji,jj) = fchl_ml(ji,jj) + ((zchn(ji,jj) + zchd(ji,jj)) * &
+	                                          (fse3t(ji,jj,jk) * fq0) / hmld(ji,jj))
+            ENDIF
+         ENDDO
+      ENDDO
+      CALL lbc_lnk(fchl_ml(:,:),'T',1. )
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Vertical Integral --
+               !!----------------------------------------------------------
+               !! vertical integral non-diatom phytoplankton
+               ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+               !! vertical integral diatom phytoplankton
+               ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+               !! vertical integral microzooplankton
+               ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+               !! vertical integral mesozooplankton
+               ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+               !! vertical integral slow detritus, nitrogen
+               ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+               !! vertical integral slow detritus, carbon
+               ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc(ji,jj) *             &
+                                                    fse3t(ji,jj,jk))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! More chlorophyll calculations
+               !!----------------------------------------------------------
+               !!
+               !! frn(ji,jj) = (xthetam / fthetan(ji,jj)) *                   &
+               !!              (fprn(ji,jj) / (fthetan(ji,jj) * xpar(ji,jj,jk)))
+               !! frd(ji,jj) = (xthetam / fthetad(ji,jj)) *                   &
+               !!              (fprd(ji,jj) / (fthetad(ji,jj) * xpar(ji,jj,jk)))
+               frn(ji,jj) = (xthetam * fchn(ji,jj) * fnln(ji,jj) *            &
+                             ffln2(ji,jj)) / (fthetan(ji,jj) +                &
+                                             tiny(fthetan(ji,jj)))
+               !! AXY (12/05/09): there's potentially a problem here; fsld, 
+               !!   silicic acid limitation, is used in the following line 
+               !!   to regulate chlorophyll growth in a manner that is 
+               !!   inconsistent with its use in the regulation of biomass 
+               !!   growth; the Mongin term term used in growth is more
+               !!   complex than the simple multiplicative function used
+               !!   below
+               !! frd(ji,jj) = (xthetam * fchd(ji,jj) * fnld(ji,jj) *        &
+               !!               ffld(ji,jj) * fsld(ji,jj)) /                 &
+               !!               (fthetad(ji,jj) + tiny(fthetad(ji,jj)))
+               !! AXY (12/05/09): this replacement line uses the new 
+               !!   variable, fsld2, to regulate chlorophyll growth
+               frd(ji,jj) = (xthetamd * fchd(ji,jj) * fnld(ji,jj) *          &
+                             ffld(ji,jj) * fsld2(ji,jj)) /                   &
+                             (fthetad(ji,jj) + tiny(fthetad(ji,jj)))
+
+# if defined key_debug_medusa
+               !! report chlorophyll calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan(ji,jj)
+                  IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad(ji,jj)
+                  IF (lwp) write (numout,*) 'frn(',jk,')     = ', frn(ji,jj)
+                  IF (lwp) write (numout,*) 'frd(',jk,')     = ', frd(ji,jj)
+               endif
+# endif
+
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE phytoplankton
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE phytoplankton( )                    ! Empty routine
+      WRITE(*,*) 'phytoplankton: You should not have seen this print! error?'
+   END SUBROUTINE phytoplankton
+#endif 
+
+   !!======================================================================
+END MODULE phytoplankton_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/plankton.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/plankton.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/plankton.F90	(revision 9824)
@@ -0,0 +1,203 @@
+MODULE plankton_mod
+   !!======================================================================
+   !!                         ***  MODULE plankton_mod  ***
+   !! Calculate the carbon chemistry for the whole ocean
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   plankton        ! Called in trcbio_medusa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE plankton( jk )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE plankton  ***
+      !! This called from TRC_BIO_MEDUSA and 
+      !!  - Calculates phytoplankton growth
+      !!  - Zooplankton grazing
+      !!  - Plankton losses
+      !!-------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: fdpd, fdpd2, fdpds, fdpds2,             &
+                                   fdpn, fdpn2, fdzme, fdzme2,             &
+                                   fdzmi, fdzmi2, fsdiss, fsin,            &
+                                   zphd, zphn, zpds, zzme, zzmi
+      USE dom_oce,           ONLY: tmask
+      USE par_oce,           ONLY: jpim1, jpjm1
+      USE phytoplankton_mod, ONLY: phytoplankton
+      USE sms_medusa,        ONLY: jmpd, jmpn, jmzme, jmzmi,               &
+                                   xkphd, xkphn, xkzme, xkzmi,             &
+                                   xmetapd, xmetapn, xmetazme, xmetazmi,   &
+                                   xmpd, xmpn, xmzme, xmzmi, xsdiss
+      USE zooplankton_mod,   ONLY: zooplankton
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+
+      INTEGER :: ji, jj
+
+      !!-------------------------------------------------------------------
+      !! Calculate phytoplankton growth
+      !!-------------------------------------------------------------------
+      CALL phytoplankton( jk )
+
+      !!-------------------------------------------------------------------
+      !! Calculate zooplankton grazing
+      !!-------------------------------------------------------------------
+      CALL zooplankton( jk )
+
+      !!-------------------------------------------------------------------
+      !! Miscellaneous plankton losses
+      !!-------------------------------------------------------------------
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Plankton metabolic losses
+               !! Linear loss processes assumed to be metabolic in origin
+               !!----------------------------------------------------------
+               !!
+               fdpn2(ji,jj)  = xmetapn  * zphn(ji,jj)
+               fdpd2(ji,jj)  = xmetapd  * zphd(ji,jj)
+               fdpds2(ji,jj) = xmetapd  * zpds(ji,jj)
+               fdzmi2(ji,jj) = xmetazmi * zzmi(ji,jj)
+               fdzme2(ji,jj) = xmetazme * zzme(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Plankton mortality losses
+               !! EKP (26/02/09): phytoplankton hyperbolic mortality term 
+               !! introduced 
+               !! to improve performance in gyres
+               !!----------------------------------------------------------
+               !!
+               !! non-diatom phytoplankton
+               !! linear
+               if (jmpn.eq.1) fdpn(ji,jj) = xmpn * zphn(ji,jj)
+               !! quadratic
+               if (jmpn.eq.2) fdpn(ji,jj) = xmpn * zphn(ji,jj) * zphn(ji,jj)
+               !! hyperbolic
+               if (jmpn.eq.3) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
+                                            (zphn(ji,jj) /                   &
+                                             (xkphn + zphn(ji,jj)))
+               !! sigmoid
+               if (jmpn.eq.4) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
+                                            ((zphn(ji,jj) * zphn(ji,jj)) /   &
+                                             (xkphn + (zphn(ji,jj) *         &
+                                                       zphn(ji,jj))))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! diatom phytoplankton
+               !! linear
+               if (jmpd.eq.1) fdpd(ji,jj) = xmpd * zphd(ji,jj)
+               !! quadratic
+               if (jmpd.eq.2) fdpd(ji,jj) = xmpd * zphd(ji,jj) * zphd(ji,jj)
+               !! hyperbolic
+               if (jmpd.eq.3) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
+                                            (zphd(ji,jj) / (xkphd +          &
+                                                            zphd(ji,jj)))
+               !! sigmoid
+               if (jmpd.eq.4) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
+                                            ((zphd(ji,jj) * zphd(ji,jj)) /   &
+                                             (xkphd + (zphd(ji,jj) *         &
+                                                       zphd(ji,jj))))
+               fdpds(ji,jj) = fdpd(ji,jj) * fsin(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! microzooplankton
+               !! linear
+               if (jmzmi.eq.1) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj)
+               !! quadratic
+               if (jmzmi.eq.2) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
+                                              zzmi(ji,jj)
+               !! hyperbolic
+               if (jmzmi.eq.3) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
+                                              (zzmi(ji,jj) / (xkzmi +        &
+                                                              zzmi(ji,jj)))
+               !! sigmoid
+               if (jmzmi.eq.4) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) * &
+                  ((zzmi(ji,jj) * zzmi(ji,jj)) / (xkzmi + (zzmi(ji,jj) *     &
+                                                           zzmi(ji,jj))))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! mesozooplankton
+               !! linear
+               if (jmzme.eq.1) fdzme(ji,jj) = xmzme * zzme(ji,jj)
+               !! quadratic
+               if (jmzme.eq.2) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
+                                              zzme(ji,jj)
+               !! hyperbolic
+               if (jmzme.eq.3) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
+                                              (zzme(ji,jj) / (xkzme +        &
+                                                              zzme(ji,jj)))
+               !! sigmoid
+               if (jmzme.eq.4) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
+                                              ((zzme(ji,jj) * zzme(ji,jj)) / &
+                                               (xkzme + (zzme(ji,jj) *       &
+                                                         zzme(ji,jj))))
+            ENDIF
+         ENDDO
+      ENDDO
+
+      !! diatom frustule dissolution. This section is moved from just
+      !! below CALL to iron_chem_scav in trcbio_medusa.F90 - marc 9/5/17
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            IF (tmask(ji,jj,jk) == 1) THEN
+               fsdiss(ji,jj)  = xsdiss * zpds(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE plankton
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE plankton( )                    ! Empty routine
+      WRITE(*,*) 'plankton: You should not have seen this print! error?'
+   END SUBROUTINE plankton
+#endif 
+
+   !!======================================================================
+END MODULE plankton_mod
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/sms_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/sms_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/sms_medusa.F90	(revision 9824)
@@ -0,0 +1,436 @@
+MODULE sms_medusa 
+   !!----------------------------------------------------------------------
+   !!                     ***  sms_medusa.F90  ***  
+   !! TOP :   MEDUSA  Source Minus Sink variables
+   !!----------------------------------------------------------------------
+   !! History :    -   !  1999-09 (M. Levy)  original code
+   !!              -   !  2000-12 (O. Aumont, E. Kestenare)  add sediment 
+   !!             1.0  !  2005-10 (C. Ethe) F90
+   !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod
+   !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca
+   !!             2.0  !  2007-04  (C. Deltel, G. Madec)  Free form and modules
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                         MEDUSA model
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER ::   numnatp_ref = -1           !! Logical units for namelist medusa
+   INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist medusa
+   INTEGER ::   numonp      = -1           !! Logical unit for namelist medusa output
+
+!!----------------------------------------------------------------------
+!! Biological parameters
+!!----------------------------------------------------------------------
+!!
+!! Primary production and chl related quantities
+   REAL(wp) ::  xxi       !:  conversion factor from gC to mmolN 
+   REAL(wp) ::  xaln      !:  Chl-a specific initial slope of P-I curve for non-diatoms 
+   REAL(wp) ::  xald      !:  Chl-a specific initial slope of P-I curve for diatoms
+   INTEGER  ::  jphy      !:  phytoplankton T-dependent growth switch
+   REAL(wp) ::  xvpn      !:  maximum growth rate for non-diatoms
+   REAL(wp) ::  xvpd      !:  maximum growth rate for diatoms
+   REAL(wp) ::  xthetam   !:  maximum Chl to C ratio for non-diatoms      
+   REAL(wp) ::  xthetamd  !:  maximum Chl to C ratio for diatoms    
+   REAL(wp) ::  jq10      !:  specific Q10 value (jphy==2)    
+!!
+!! Diatom silicon parameters
+   REAL(wp) ::  xsin0     !:  minimum diatom Si:N ratio
+   REAL(wp) ::  xnsi0     !:  minimum diatom N:Si ratio
+   REAL(wp) ::  xuif      !:  hypothetical growth ratio at infinite Si:N ratio
+!!
+!! Nutrient limitation
+   INTEGER  ::  jliebig   !:  Liebig nutrient uptake switch
+   REAL(wp) ::  xnln      !:  half-sat constant for DIN uptake by non-diatoms 
+   REAL(wp) ::  xnld      !:  half-sat constant for DIN uptake by diatoms 
+   REAL(wp) ::  xsld      !:  half-sat constant for Si uptake by diatoms 
+   REAL(wp) ::  xfln      !:  half-sat constant for Fe uptake by non-diatoms 
+   REAL(wp) ::  xfld      !:  half-sat constant for Fe uptake by diatoms  
+!!
+!! Grazing
+   REAL(wp) ::  xgmi      !:  microzoo maximum growth rate 
+   REAL(wp) ::  xgme      !:  mesozoo maximum growth rate 
+   REAL(wp) ::  xkmi      !:  microzoo grazing half-sat parameter
+   REAL(wp) ::  xkme      !:  mesozoo grazing half-sat parameter
+   REAL(wp) ::  xphi      !:  micro/mesozoo grazing inefficiency
+   REAL(wp) ::  xbetan    !:  micro/mesozoo N assimilation efficiency
+   REAL(wp) ::  xbetac    !:  micro/mesozoo C assimilation efficiency
+   REAL(wp) ::  xkc       !:  micro/mesozoo net C growth efficiency
+   REAL(wp) ::  xpmipn    !:  grazing preference of microzoo for non-diatoms
+   REAL(wp) ::  xpmid     !:  grazing preference of microzoo for diatoms
+   REAL(wp) ::  xpmepn    !:  grazing preference of mesozoo for non-diatoms 
+   REAL(wp) ::  xpmepd    !:  grazing preference of mesozoo for diatoms
+   REAL(wp) ::  xpmezmi   !:  grazing preference of mesozoo for microzoo
+   REAL(wp) ::  xpmed     !:  grazing preference of mesozoo for detritus
+!!
+!! Metabolic losses
+   REAL(wp) ::  xmetapn   !:  non-diatom metabolic loss rate
+   REAL(wp) ::  xmetapd   !:  diatom     metabolic loss rate
+   REAL(wp) ::  xmetazmi  !:  microzoo   metabolic loss rate
+   REAL(wp) ::  xmetazme  !:  mesozoo    metabolic loss rate
+!!
+!! Mortality losses
+   INTEGER  ::  jmpn      !:  non-diatom mortality functional form
+   REAL(wp) ::  xmpn      !:  non-diatom mortality rate
+   REAL(wp) ::  xkphn     !:  non-diatom mortality half-sat constant
+   INTEGER  ::  jmpd      !:  diatom     mortality functional form
+   REAL(wp) ::  xmpd      !:  diatom     mortality rate
+   REAL(wp) ::  xkphd     !:  diatom     mortality half-sat constant
+   INTEGER  ::  jmzmi     !:  microzoo   mortality functional form
+   REAL(wp) ::  xmzmi     !:  microzoo   mortality rate
+   REAL(wp) ::  xkzmi     !:  microzoo   mortality half-sat constant
+   INTEGER  ::  jmzme     !:  mesozoo    mortality functional form
+   REAL(wp) ::  xmzme     !:  mesozoo    mortality rate
+   REAL(wp) ::  xkzme     !:  mesozoo    mortality half-sat constant
+!!
+!! Remineralisation
+   INTEGER  ::  jmd       !:  detritus T-dependent remineralisation switch
+   INTEGER  ::  jsfd      !:  accelerate seafloor detritus remin. switch
+   REAL(wp) ::  xmd       !:  detrital nitrogen remineralisation rate 
+   REAL(wp) ::  xmdc      !:  detrital carbon remineralisation rate 
+!!
+!! Stochiometric ratios
+   REAL(wp) ::  xthetapn  !:  non-diatom C:N ratio
+   REAL(wp) ::  xthetapd  !:  diatom C:N ratio
+   REAL(wp) ::  xthetazmi !:  microzoo C:N ratio
+   REAL(wp) ::  xthetazme !:  mesozoo C:N ratio
+   REAL(wp) ::  xthetad   !:  detritus C:N ratio
+   REAL(wp) ::  xrfn      !:  phytoplankton Fe:N ratio
+   REAL(wp) ::  xrsn      !:  diatom Si:N ratio (NOT USED HERE; RETAINED FOR LOBSTER)
+!!
+!! Iron parameters
+   INTEGER  ::  jiron     !:  iron scavenging submodel switch
+   REAL(wp) ::  xfe_mass  !:  iron atomic mass
+   REAL(wp) ::  xfe_sol   !:  aeolian iron solubility
+   REAL(wp) ::  xfe_sed   !:  sediment iron input
+   REAL(wp) ::  xLgT      !:  total ligand concentration (umol/m3)
+   REAL(wp) ::  xk_FeL    !:  dissociation constant for (Fe + L)
+   REAL(wp) ::  xk_sc_Fe  !:  scavenging rate of "free" iron
+!!
+!! Gravitational sinking      
+   REAL(wp) ::  vsed      !:  detritus gravitational sinking rate 
+   REAL(wp) ::  xhr       !:  coefficient for Martin et al. (1987) remineralisation
+!!
+!! Fast-sinking detritus parameters
+   INTEGER  ::  jexport   !:  fast detritus remineralisation switch
+   INTEGER  ::  jfdfate   !:  fate of fast detritus at seafloor switch
+   INTEGER  ::  jrratio   !:  rain ratio switch
+   INTEGER  ::  jocalccd  !:  CCD switch
+   REAL(wp) ::  xridg_r0  !:  Ridgwell rain ratio coefficient
+   REAL(wp) ::  xfdfrac1  !:  fast-sinking fraction of diatom nat. mort. losses
+   REAL(wp) ::  xfdfrac2  !:  fast-sinking fraction of mesozooplankton mort. losses
+   REAL(wp) ::  xfdfrac3  !:  fast-sinking fraction of diatom silicon grazing losses
+   REAL(wp) ::  xcaco3a   !:  polar (high latitude) CaCO3 fraction
+   REAL(wp) ::  xcaco3b   !:  equatorial (low latitude) CaCO3 fraction
+   REAL(wp) ::  xmassc    !:  organic C mass:mole ratio, C106 H175 O40 N16 P1
+   REAL(wp) ::  xmassca   !:  calcium carbonate mass:mole ratio, CaCO3
+   REAL(wp) ::  xmasssi   !:  biogenic silicon mass:mole ratio, (H2SiO3)n
+   REAL(wp) ::  xprotca   !:  calcium carbonate protection ratio
+   REAL(wp) ::  xprotsi   !:  biogenic silicon protection ratio
+   REAL(wp) ::  xfastc    !:  organic C remineralisation length scale
+   REAL(wp) ::  xfastca   !:  calcium carbonate dissolution length scale
+   REAL(wp) ::  xfastsi   !:  biogenic silicon dissolution length scale
+!!
+!! Benthos parameters
+   INTEGER  ::  jorgben   !:  does   organic detritus go to the benthos?
+   INTEGER  ::  jinorgben !:  does inorganic detritus go to the benthos?
+!!
+   REAL(wp) ::  xsedn     !:  organic   nitrogen sediment remineralisation rate 
+   REAL(wp) ::  xsedfe    !:  organic   iron     sediment remineralisation rate 
+   REAL(wp) ::  xsedsi    !:  inorganic silicon  sediment dissolution      rate 
+   REAL(wp) ::  xsedc     !:  organic   carbon   sediment remineralisation rate 
+   REAL(wp) ::  xsedca    !:  inorganic carbon   sediment dissolution      rate 
+   REAL(wp) ::  xburial   !:  burial rate of seafloor detritus
+!!
+!! River parameters
+   INTEGER  ::  jriver_n  !:  riverine nitrogen?   0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_si !:  riverine silicon?    0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_c  !:  riverine carbon?     0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_alk!:  riverine alkalinity? 0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_dep!:  depth river input added to?  1 = surface, >1 possible
+!!
+!! Miscellaneous
+   REAL(wp) ::  xsdiss    !:  diatom frustule dissolution rate
+!!
+!! Additional parameters
+   INTEGER  ::  jpkb      !:  vertical layer for diagnostic of the vertical flux 
+!!
+!! UKESM diagnostics
+   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
+!! JPALM --19-12-2017 -- UM people need to tune the Anderson DMS scheme    
+   REAL(wp) ::  dmsmin       !: Anderson DMS scheme - DMS minimum value
+   REAL(wp) ::  dmscut       !: Anderson DMS scheme - DMS cutoff value 
+   REAL(wp) ::  dmsslp       !: Anderson DMS scheme - DMS slope 
+!! FOR UKESM   
+   REAL(wp) ::  scl_chl      !: scaling factor for tuned Chl passed to the UM 
+   INTEGER  ::  chl_out      !: select Chl field exported and scaled for UM:
+                             !: 1- Surface Chl ; 2- MLD Chl
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   remdmp   !: depth dependent damping coefficient of passive tracers 
+!!
+!! AXY (27/07/10): add in indices for depth horizons (for sinking flux
+!!                 and seafloor iron inputs)
+   INTEGER  ::    i0100, i0150, i0200, i0500, i1000, i1100
+#if defined key_roam
+!!
+!! ROAM carbon, alkalinity and oxygen cycle parameters
+   REAL(wp) ::  xthetaphy    !:  oxygen evolution/consumption by phytoplankton 
+   REAL(wp) ::  xthetazoo    !:  oxygen consumption by zooplankton 
+   REAL(wp) ::  xthetanit    !:  oxygen consumption by nitrogen remineralisation
+   REAL(wp) ::  xthetarem    !:  oxygen consumption by carbon remineralisation
+   REAL(wp) ::  xo2min       !:  oxygen minimum concentration
+!! 
+!! 3D fields of carbonate system parameters
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_pH       !: 3D pH
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_h2co3    !: 3D carbonic acid
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_hco3     !: 3D bicarbonate
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_co3      !: 3D carbonate
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_omcal    !: 3D omega calcite
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_omarg    !: 3D omega aragonite
+!! 
+!! 2D fields of calcium carbonate compensation depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_cal  !: 2D calcite CCD depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_arg  !: 2D aragonite CCD depth
+!!
+!! 2D fields of organic and inorganic material sedimented on the seafloor
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_n    !: 2D organic nitrogen   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_n    !: 2D organic nitrogen   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_n    !: 2D organic nitrogen   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_fe   !: 2D organic iron       (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_fe   !: 2D organic iron       (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_fe   !: 2D organic iron       (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_si   !: 2D inorganic silicon  (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_si   !: 2D inorganic silicon  (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_si   !: 2D inorganic silicon  (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_c    !: 2D organic carbon     (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_c    !: 2D organic carbon     (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_c    !: 2D organic carbon     (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_ca   !: 2D inorganic carbon   (before)
+   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)
+!!
+!! 2D fields needing to be knows at first tstp for coupling with atm - UKEMS(Jpalm,14-06-2016)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_co2_flx  !: 2D avg fx co2 (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_co2_flx  !: 2D avg fx co2 (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_co2_flx  !: 2D avg fx co2 (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_srf  !: 2D avg sfr dms (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_srf  !: 2D avg sfr dms (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_srf  !: 2D avg srf dms (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_chl_srf  !: 2D avg srf chl (now)
+
+#endif
+
+!!----------------------------------------------------------------------
+!! CCD parameter
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ocal_ccd  !: CCD depth
+
+!!----------------------------------------------------------------------
+!! Dust parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust      !: dust parameter 1
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   zirondep  !! Fe deposition
+
+!!----------------------------------------------------------------------
+!! River parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_n      !: riverine N
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_si     !: riverine Si
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_c      !: riverine C
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_alk    !: riverine alkalinity
+   !! AXY (19/07/12): add this to permit river fluxes to be added below top box
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   friver_dep !: where river fluxes added
+
+#if defined key_roam
+!!----------------------------------------------------------------------
+!! JPALM -- change hist_pco2 init
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   hist_pco2 !: pCO2
+   INTEGER  :: co2_rec
+   REAL(wp) :: co2_yinit, co2_yend    !: First and Last year read in the xCO2.atm file
+#endif
+
+!!----------------------------------------------------------------------
+!! JPALM -- PI CO2 key
+!!----------------------------------------------------------------------
+!!
+#if defined key_axy_pi_co2
+   LOGICAL , PUBLIC ::   lk_pi_co2 = .TRUE.  !: PI xCO2 used
+#else
+   LOGICAL , PUBLIC ::   lk_pi_co2 = .FALSE. !: PI xCO2 unused
+#endif
+
+!!----------------------------------------------------------------------
+!! Optical parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST)
+   REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST)
+   REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST)
+   REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST)
+   REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST)
+   REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST)
+   REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST)
+                                                        
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln    !: number of levels in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze     !: euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar    !: par (photosynthetic available radiation)
+
+!!----------------------------------------------------------------------
+!! Sediment parameters                               
+!! 
+!! AXY (16/01/12): these parameters were originally part of the pre-
+!!                 cursor model on which MEDUSA's code was grounded;
+!!                 they do not relate to the sediment/benthos submodel
+!!                 added as part of the ROAM project; they have only
+!!                 been retained because they are distributed through
+!!                 MEDUSA and require a proper clean-up to purge
+!!----------------------------------------------------------------------
+!!
+   REAL(wp) ::   sedlam       !: time coefficient of POC remineralization in sediments
+   REAL(wp) ::   sedlostpoc   !: ???
+   REAL(wp) ::   areacot      !: ???
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: dminl       !: fraction of sinking POC released in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dmin3       !: fraction of sinking POC released at each level
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpocb     !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpocn     !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpoca     !: mass of POC in sediments
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbodf       !: rapid sinking particles
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbods       !: rapid sinking particles
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbodn       !: rapid sinking particles
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ffln        !: 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fflf        !: 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ffls        !: 
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: cmask       !: ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sms_medusa_alloc()
+      !!----------------------------------------------------------------------
+      !!        *** ROUTINE sms_medusa_alloc ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      INTEGER ::   ierr(8)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+#if defined key_medusa
+      !* depth-dependent damping coefficient
+      ALLOCATE( remdmp(jpk,jp_medusa),                           STAT=ierr(1) )
+# if defined key_roam
+      !* 2D and 3D fields of carbonate system parameters
+      ALLOCATE( f2_ccd_cal(jpi,jpj)  , f2_ccd_arg(jpi,jpj)  ,       &
+         &      f3_pH(jpi,jpj,jpk)   , f3_h2co3(jpi,jpj,jpk),       &
+         &      f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk)  ,       &
+         &      f3_omcal(jpi,jpj,jpk), f3_omarg(jpi,jpj,jpk),    STAT=ierr(2) )
+      !* 2D fields of organic and inorganic material sedimented on the seafloor
+      ALLOCATE( zb_sed_n(jpi,jpj)    , zn_sed_n(jpi,jpj)    ,       &
+         &      za_sed_n(jpi,jpj)    ,                              &
+         &      zb_sed_fe(jpi,jpj)   , zn_sed_fe(jpi,jpj)   ,       &
+         &      za_sed_fe(jpi,jpj)   ,                              &
+         &      zb_sed_si(jpi,jpj)   , zn_sed_si(jpi,jpj)   ,       &
+         &      za_sed_si(jpi,jpj)   ,                              &
+         &      zb_sed_c(jpi,jpj)    , zn_sed_c(jpi,jpj)    ,       &
+         &      za_sed_c(jpi,jpj)    ,                              &
+         &      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) )
+      !* 2D fields needing to be knows at first tstp for coupling with atm -
+      !UKEMSi (Jpalm,14-06-2016) 
+      ALLOCATE( zb_co2_flx(jpi,jpj)  , zn_co2_flx(jpi,jpj)  ,       &
+         &      za_co2_flx(jpi,jpj)  ,                              &
+         &      zb_dms_srf(jpi,jpj)  , zn_dms_srf(jpi,jpj)  ,       &           
+         &      za_dms_srf(jpi,jpj)  , zn_chl_srf(jpi,jpj)  ,    STAT=ierr(5) )
+# endif
+      !* 2D fields of miscellaneous parameters
+      ALLOCATE( ocal_ccd(jpi,jpj)    , dust(jpi,jpj)        ,       &
+         &      zirondep(jpi,jpj)                           ,       &
+         &      riv_n(jpi,jpj)                              ,       &
+         &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       &
+         &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(6) )
+      !* 2D and 3D fields of light parameters
+      ALLOCATE( neln(jpi,jpj)        , xze(jpi,jpj)         ,       &
+         &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(7) )
+      !* 2D and 3D fields of sediment-associated parameters
+      ALLOCATE( dminl(jpi,jpj)       , dmin3(jpi,jpj,jpk)   ,       &
+         &      sedpocb(jpi,jpj)     , sedpocn(jpi,jpj)     ,       &
+         &      sedpoca(jpi,jpj)     , fbodn(jpi,jpj)       ,       &
+         &      fbodf(jpi,jpj)       , fbods(jpi,jpj)       ,       &
+         &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       &
+         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(8) ) 
+#endif
+      !
+      sms_medusa_alloc = MAXVAL( ierr )
+      !
+      IF( sms_medusa_alloc /= 0 )   CALL ctl_warn('sms_medusa_alloc: failed to allocate arrays')
+      !
+   END FUNCTION sms_medusa_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     NO MEDUSA model 
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE sms_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcavg_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcavg_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcavg_medusa.F90	(revision 9824)
@@ -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$
+   !! 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/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcbio_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcbio_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcbio_medusa.F90	(revision 9824)
@@ -0,0 +1,1010 @@
+MODULE trcbio_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcbio  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  1999-07  (M. Levy)              original code
+   !!  -   !  2000-12  (E. Kestenare)         assign parameters to name 
+   !!                                         individual tracers
+   !!  -   !  2001-03  (M. Levy)              LNO3 + dia2d 
+   !! 2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!  -   !  2008-08  (K. Popova)            adaptation for MEDUSA
+   !!  -   !  2008-11  (A. Yool)              continuing adaptation for MEDUSA
+   !!  -   !  2010-03  (A. Yool)              updated for branch inclusion
+   !!  -   !  2011-08  (A. Yool)              updated for ROAM (see below)
+   !!  -   !  2013-03  (A. Yool)              updated for iMARNET
+   !!  -   !  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
+   !!  -   !  2015-10  (J. Palm)              Update for diag outputs through 
+   !!                                         iom_use  
+   !!  -   !  2016-11  (A. Yool)              Updated diags for CMIP6
+   !!  -   !  2017-05  (A. Yool)              Added extra DMS calculation
+   !!  -   !  2017-11  (J. Palm, A. Yool)     Diagnose tracer excursions
+   !!----------------------------------------------------------------------
+   !!
+#if defined key_roam
+   !!----------------------------------------------------------------------
+   !! Updates for the ROAM project include:
+   !!   - addition of DIC, alkalinity, detrital carbon and oxygen tracers
+   !!   - addition of air-sea fluxes of CO2 and oxygen
+   !!   - periodic (monthly) calculation of full 3D carbonate chemistry 
+   !!   - detrital C:N ratio now free to evolve dynamically
+   !!   - benthic storage pools
+   !! 
+   !! Opportunity also taken to add functionality:
+   !!   - switch for Liebig Law (= most-limiting) nutrient uptake
+   !!   - switch for accelerated seafloor detritus remineralisation
+   !!   - switch for fast -> slow detritus transfer at seafloor
+   !!   - switch for ballast vs. Martin vs. Henson fast detritus remin.
+   !!   - per GMD referee remarks, xfdfrac3 introduced for grazed PDS
+   !!----------------------------------------------------------------------
+#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
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_bio_medusa        :  
+   !!----------------------------------------------------------------------
+      !! AXY (30/01/14): necessary to find NaNs on HECTOR
+      USE, INTRINSIC :: ieee_arithmetic 
+
+      USE bio_medusa_mod,             ONLY: b0, fdep1,                      & 
+                                            ibenthic, idf, idfval,          &
+# if defined key_roam
+                                            f_xco2a,                        &
+                                            zalk, zdic, zoxy, zsal, ztmp,   &
+# endif
+# if defined key_mocsy
+                                            zpho,                           &
+# endif
+                                            zchd, zchn, zdet, zdin, zdtc,   &
+                                            zfer, zpds, zphd, zphn, zsil,   &
+                                            zzme, zzmi
+      USE dom_oce,                    ONLY: e3t_0, e3t_n,                   &
+                                            gdept_0, gdept_n,               &
+                                            gdepw_0, gdepw_n,               &
+                                            nday_year, nsec_day,            &
+                                            nyear, nyear_len, ndastp,       &
+                                            nsec_month,                     &
+                                            rdt, tmask, mig, mjg, nimpp,    &
+                                            njmpp 
+      USE in_out_manager,             ONLY: lwp, numout, nn_date0
+# if defined key_iomput
+      USE iom,                        ONLY: lk_iomput
+# endif
+      USE lbclnk,                     ONLY: lbc_lnk
+      USE lib_mpp,                    ONLY: mpp_max, mpp_maxloc,            & 
+                                            mpp_min, mpp_minloc,            &
+                                            ctl_stop, ctl_warn, lk_mpp  
+      USE oce,                        ONLY: tsb, tsn, PCO2a_in_cpl
+      USE par_kind,                   ONLY: wp
+      USE par_medusa,                 ONLY: jpalk, jpchd, jpchn, jpdet,     &
+                                            jpdic, jpdin, jpdtc, jpfer,     &
+                                            jpoxy, jppds, jpphd, jpphn,     &
+                                            jpsil, jpzme, jpzmi
+      USE par_oce,                    ONLY: jp_sal, jp_tem, jpi, jpim1,     &
+                                            jpj, jpjm1, jpk
+      !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm
+      USE sbc_oce,                    ONLY: lk_oasis
+      USE sms_medusa,                 ONLY: hist_pco2, co2_yinit, co2_yend, &
+                                            lk_pi_co2
+      USE trc,                        ONLY: ln_rsttr, nittrc000, trn
+      USE bio_medusa_init_mod,        ONLY: bio_medusa_init
+      USE carb_chem_mod,              ONLY: carb_chem
+      USE air_sea_mod,                ONLY: air_sea
+      USE plankton_mod,               ONLY: plankton
+      USE iron_chem_scav_mod,         ONLY: iron_chem_scav
+      USE detritus_mod,               ONLY: detritus
+      USE bio_medusa_update_mod,      ONLY: bio_medusa_update
+      USE bio_medusa_diag_mod,        ONLY: bio_medusa_diag
+      USE bio_medusa_diag_slice_mod,  ONLY: bio_medusa_diag_slice
+      USE bio_medusa_fin_mod,         ONLY: bio_medusa_fin
+      USE trcstat,                    ONLY: trc_rst_dia_stat
+
+      IMPLICIT NONE
+      PRIVATE
+      
+      PUBLIC   trc_bio_medusa    ! called in trcsms_medusa.F90
+      PUBLIC   trc_bio_exceptionnal_fix ! here 
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_bio_medusa( kt )
+      !!------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_bio  ***
+      !!
+      !! ** Purpose : compute the now trend due to biogeochemical processes
+      !!              and add it to the general trend of passive tracers 
+      !!              equations
+      !!
+      !! ** Method  : each now biological flux is calculated in function of
+      !!              now concentrations of tracers.
+      !!              depending on the tracer, these fluxes are sources or 
+      !!              sinks.
+      !!              The total of the sources and sinks for each tracer
+      !!              is added to the general trend.
+      !!        
+      !!                      tra = tra + zf...tra - zftra...
+      !!                                     |         |
+      !!                                     |         |
+      !!                                  source      sink
+      !!        
+      !!              IF 'key_trc_diabio' defined , the biogeochemical trends
+      !!              for passive tracers are saved for futher diagnostics.
+      !!------------------------------------------------------------------
+      !!
+      !!
+      !!------------------------------------------------------------------
+      !! Variable conventions
+      !!------------------------------------------------------------------
+      !!
+      !! names: z*** - state variable 
+      !!        f*** - function (or temporary variable used in part of 
+      !!               a function)
+      !!        x*** - parameter
+      !!        b*** - right-hand part (sources and sinks)
+      !!        i*** - integer variable (usually used in yes/no flags)
+      !!
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) ::    kt
+      !!
+      !! spatial array indices
+      INTEGER  ::    ji,jj,jk,jn
+      !!
+      INTEGER  ::    iball
+# if defined key_roam
+      !!
+      INTEGER  ::    iyr1, iyr2
+      !!
+# endif
+      !! 
+      !! temporary variables
+      REAL(wp) ::    fq3,fq4
+      REAL(wp) ::    this_y, this_d, this_s, fyear
+      !!
+      !! T and S check temporary variable
+      REAL(wp) ::    sumtsn, tsnavg
+      INTEGER  ::    summask
+      CHARACTER(40) :: charout, charout2, charout3, charout4, charout5
+      !!
+      !!------------------------------------------------------------------
+
+# 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
+      !! IF( kt == nit000 ) THEN
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_bio: MEDUSA bio-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      !! AXY (13/01/12): is benthic model properly interactive? 0 = no, 1 = yes
+      ibenthic = 1
+
+      !!------------------------------------------------------------------
+      !! b0 is present for debugging purposes; using b0 = 0 sets the tendency
+      !! terms of all biological equations to 0.
+      !!------------------------------------------------------------------
+      !!
+      !! AXY (03/09/14): probably not the smartest move ever, but it'll fit
+      !!                 the bill for now; another item on the things-to-sort-
+      !!		 out-in-the-future list ...
+# if defined key_kill_medusa
+      b0 = 0.
+# else
+      b0 = 1.
+# endif
+      !!------------------------------------------------------------------
+      !! fast detritus ballast scheme (0 = no; 1 = yes)
+      !! alternative to ballast scheme is same scheme but with no ballast
+      !! protection (not dissimilar to Martin et al., 1987)
+      !!------------------------------------------------------------------
+      !!
+      iball = 1
+
+      !!------------------------------------------------------------------
+      !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output
+      !! these should *only* be used in 1D since they give comprehensive
+      !! output for ecological functions in the model; primarily used in
+      !! debugging
+      !!------------------------------------------------------------------
+      !!
+      idf    = 0
+      !!
+      !! timer mechanism
+      if (kt/120*120.eq.kt) then
+         idfval = 1
+      else
+         idfval = 0
+      endif
+
+      !!------------------------------------------------------------------
+      !! Initialise arrays to zero and set up arrays for diagnostics
+      !!------------------------------------------------------------------
+      CALL bio_medusa_init( kt )
+
+# if defined key_axy_nancheck
+       DO jn = jp_msa0,jp_msa1
+          !! fq0 = MINVAL(trn(:,:,:,jn))
+          !! fq1 = MAXVAL(trn(:,:,:,jn))
+          fq2 = SUM(trn(:,:,:,jn))
+          !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK',     &
+          !!                kt, jn, fq0, fq1, fq2
+          !! AXY (30/01/14): much to our surprise, the next line doesn't 
+          !!                 work on HECTOR and has been replaced here with 
+          !!                 a specialist routine
+          !! if (fq2 /= fq2 ) then
+          if ( ieee_is_nan( fq2 ) ) then
+             !! there's a NaN here
+             if (lwp) write(numout,*) 'NAN detected in field', jn,           &
+                                      'at time', kt, 'at position:'
+             DO jk = 1,jpk
+                DO jj = 1,jpj
+                   DO ji = 1,jpi
+                      !! AXY (30/01/14): "isnan" problem on HECTOR
+                      !! if (trn(ji,jj,jk,jn) /= trn(ji,jj,jk,jn)) then
+                      if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then
+                         if (lwp) write (numout,'(a,1pe12.2,4i6)')           &
+                            'NAN-CHECK', tmask(ji,jj,jk), ji, jj, jk, jn
+                      endif
+                   enddo
+                enddo
+             enddo
+             CALL ctl_stop( 'trcbio_medusa, NAN in incoming tracer field' )
+          endif
+       ENDDO
+       CALL flush(numout)
+# 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
+      !!------------------------------------------------------------------
+      !! calculate atmospheric pCO2
+      !!------------------------------------------------------------------
+      !!
+      IF (lk_oasis) THEN 
+         !! xCO2 from coupled
+         IF ( ( kt == nittrc000 ) .AND. lwp )     &
+             WRITE(numout,*) '** MEDUSA Atm xCO2 given by the UM **'
+         f_xco2a(:,:) = PCO2a_in_cpl(:,:)
+         !! Check the xCO2 from the UM is OK
+         !! piece of code moved from air-sea.F90
+         !!---
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !! OPEN wet point IF..THEN loop
+               IF (tmask(ji,jj,1) == 1) then
+                  !!! Jpalm test on atm xCO2
+                  IF ( (f_xco2a(ji,jj) .GT. 10000.0 ).OR.     &
+                       (f_xco2a(ji,jj) .LE. 0.0 ) ) THEN
+                     IF(lwp) THEN
+                        WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj),       &
+                                        ' -- ji =', mig(ji),' jj = ', mjg(jj)
+                     ENDIF
+                     CALL ctl_stop( 'MEDUSA - trc_bio :',     &
+                                    'unrealistic coupled atm xCO2 ' )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+         !!--- 
+      ELSEIF (lk_pi_co2) THEN
+         !! OCMIP pre-industrial xCO2
+         IF ( ( kt == nittrc000 ) .AND. lwp )     &
+             WRITE(numout,*) '** MEDUSA Atm xCO2 fixed to pre-industrial value **'
+         !! f_xco2a(:,:) = 284.725       !! CMIP5 pre-industrial pCO2
+         f_xco2a(:,:) = 284.317          !! CMIP6 pre-industrial pCO2 
+      ELSE      
+         !! xCO2 from file
+         !! AXY - JPALM new interpolation scheme usinf nyear_len
+         this_y = real(nyear)
+         this_d = real(nday_year)
+         this_s = real(nsec_day)
+         !!
+         fyear = this_y + ((this_d - 1) + (this_s / (60. * 60. * 24.))) / real(nyear_len(1))
+         !!
+         IF ( ( kt == nittrc000 ) .AND. lwp ) THEN 
+            WRITE(numout,*) '** MEDUSA Atm xCO2 from file **'
+            WRITE(numout,*) ' MEDUSA year      =', this_y
+            WRITE(numout,*) ' Year length      =', real(nyear_len(1))
+            WRITE(numout,*) ' MEDUSA nday_year =', this_d
+            WRITE(numout,*) ' MEDUSA nsec_day  =', this_s
+         ENDIF
+         !! 
+         !! different case test 
+         IF (fyear .LE. co2_yinit) THEN
+            !! before first record -- pre-industrial value
+            f_xco2a(:,:) = hist_pco2(1)  
+         ELSEIF (fyear .GE. co2_yend) THEN
+            !! after last record - continue to use the last value
+            f_xco2a(:,:) = hist_pco2(int(co2_yend - co2_yinit + 1.) )
+         ELSE
+            !! just right
+            iyr1 = int(fyear - co2_yinit) + 1
+            iyr2 = iyr1 + 1 
+            fq3 = fyear - real(iyr1) - co2_yinit + 1.
+            fq4 = ((1 - fq3) * hist_pco2(iyr1)) + (fq3 * hist_pco2(iyr2))
+            f_xco2a(:,:) = fq4
+            !!
+            IF ( ( kt == nittrc000 ) .AND. lwp ) THEN 
+               WRITE(numout,*) ' MEDUSA year1     =', iyr1
+               WRITE(numout,*) ' MEDUSA year2     =', iyr2
+               WRITE(numout,*) ' xCO2 year1       =', hist_pco2(iyr1)
+               WRITE(numout,*) ' xCO2 year2       =', hist_pco2(iyr2)
+               WRITE(numout,*) ' Year2 weight     =', fq3
+            ENDIF
+         ENDIF
+      ENDIF
+ 
+      !! Writing xCO2 in output on start and on the 1st tsp of each  month
+      IF ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        &
+           ( nsec_month .LE. INT(rdt) ) )  THEN
+           IF ( lwp )  WRITE(numout,*) ' *** Atm xCO2 *** -- kt:', kt,       &
+                                       ';  current date:', ndastp
+          call trc_rst_dia_stat(f_xco2a(:,:), 'atm xCO2')
+      ENDIF
+# 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 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,960) == 0 ) THEN 
+      !!=============================
+      !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call :
+      !!          we don't want to call on the first time-step of all run 
+      !!          submission, but only on the very first time-step, and 
+      !!          then every month. So we call on nittrc000 if not 
+      !!          restarted run, else if one month after last call.
+      !!          Assume one month is 30d --> 3600*24*30 : 2592000s
+      !!          try to call carb-chem at 1st month's tm-stp : 
+      !!          x * 30d + 1*rdt(i.e: mod = rdt)   
+      !!          ++ need to pass carb-chem output var through restarts
+      !!If ( (kt == nitt8rc000 .AND. .NOT.ln_rsttr) .OR.          &
+      !!     ( (mod(kt*rdt,2592000.)) == rdt) THEN
+      !!=============================
+      !! (Jpalm -- updated for restartability issues)
+      !! We want this to be start of month or if starting afresh from  
+      !! climatology - marc 20/6/17 
+      !!If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                         & 
+      !!     ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 
+      !!=============================
+      !! Jpalm -- 15-02-2018 -- need to change 3D carb-chem call freq again.
+      !! previous call did not work, probably the (86400*mod(nn_date0,100) part
+      !! should not be in...
+      !! now use the NEMO calendar tool : nsec_month to be sure to call 
+      !! at the beginning of a new month .
+      IF ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        &
+           ( nsec_month .LE. INT(rdt) ) )  THEN
+           IF ( lwp )  WRITE(numout,*)                                       &         
+                              ' *** 3D carb chem call *** -- kt:', kt,       &
+                              ';  current date:', ndastp 
+         !!---------------------------------------------------------------
+         !! Calculate the carbonate chemistry for the whole ocean on the first
+         !! simulation timestep and every month subsequently; the resulting 3D
+         !! field of omega calcite is used to determine the depth of the CCD
+         !!---------------------------------------------------------------
+         CALL carb_chem( kt )
+
+      ENDIF
+# 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
+      !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers) 
+      !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1          
+      !!------------------------------------------------------------------
+      !!
+      !! NOTE: the ordering of the loops below differs from that of some other
+      !! models; looping over the vertical dimension is the outermost loop and
+      !! this complicates some calculations (e.g. storage of vertical fluxes
+      !! that can otherwise be done via a singular variable require 2D fields
+      !! here); however, these issues are relatively easily resolved, but the
+      !! loops CANNOT be reordered without potentially causing code efficiency
+      !! problems (e.g. array indexing means that reordering the loops would
+      !! require skipping between widely-spaced memory location; potentially
+      !! outside those immediately cached)
+      !!
+      !! OPEN vertical loop
+      DO jk = 1,jpk
+         !! OPEN horizontal loops
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !! OPEN wet point IF..THEN loop
+               if (tmask(ji,jj,jk) == 1) then               
+                  !!======================================================
+                  !! SETUP LOCAL GRID CELL
+                  !!======================================================
+                  !!
+                  !!------------------------------------------------------
+                  !! Some notes on grid vertical structure
+                  !! - fsdepw(ji,jj,jk) is the depth of the upper surface of 
+                  !!   level jk
+                  !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of 
+                  !!   level jk
+                  !! - fse3t(ji,jj,jk)  is the thickness of level jk
+                  !!------------------------------------------------------
+                  !!
+                  !! AXY (01/03/10): set up level depth (bottom of level)
+                  fdep1(ji,jj) = fsdepw(ji,jj,jk) + fse3t(ji,jj,jk)
+                  !!
+                  !! set up model tracers
+                  !! negative values of state variables are not allowed to
+                  !! contribute to the calculated fluxes
+                  !! non-diatom chlorophyll
+                  zchn(ji,jj) = max(0.,trn(ji,jj,jk,jpchn))
+                  !! diatom chlorophyll
+                  zchd(ji,jj) = max(0.,trn(ji,jj,jk,jpchd))
+                  !! non-diatoms
+                  zphn(ji,jj) = max(0.,trn(ji,jj,jk,jpphn))
+                  !! diatoms
+                  zphd(ji,jj) = max(0.,trn(ji,jj,jk,jpphd))
+                  !! diatom silicon
+                  zpds(ji,jj) = max(0.,trn(ji,jj,jk,jppds))
+                  !! AXY (28/01/10): probably need to take account of 
+                  !! chl/biomass connection
+                  if (zchn(ji,jj).eq.0.) zphn(ji,jj) = 0.
+                  if (zchd(ji,jj).eq.0.) zphd(ji,jj) = 0.
+                  if (zphn(ji,jj).eq.0.) zchn(ji,jj) = 0.
+                  if (zphd(ji,jj).eq.0.) zchd(ji,jj) = 0.
+	          !! AXY (23/01/14): duh - why did I forget diatom silicon?
+	          if (zpds(ji,jj).eq.0.) zphd(ji,jj) = 0.
+	          if (zphd(ji,jj).eq.0.) zpds(ji,jj) = 0.
+               ENDIF
+            ENDDO
+         ENDDO
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  !! microzooplankton
+                  zzmi(ji,jj) = max(0.,trn(ji,jj,jk,jpzmi))
+                  !! mesozooplankton
+                  zzme(ji,jj) = max(0.,trn(ji,jj,jk,jpzme))
+                  !! detrital nitrogen
+                  zdet(ji,jj) = max(0.,trn(ji,jj,jk,jpdet))
+                  !! dissolved inorganic nitrogen
+                  zdin(ji,jj) = max(0.,trn(ji,jj,jk,jpdin))
+                  !! dissolved silicic acid
+                  zsil(ji,jj) = max(0.,trn(ji,jj,jk,jpsil))
+                  !! dissolved "iron"
+                  zfer(ji,jj) = max(0.,trn(ji,jj,jk,jpfer))
+               ENDIF
+            ENDDO
+         ENDDO
+
+# if defined key_roam
+         !! extra MEDUSA-2 tracers
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  !! detrital carbon
+                  zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc))
+                  !! dissolved inorganic carbon
+                  zdic(ji,jj) = trn(ji,jj,jk,jpdic)
+                  !! alkalinity
+                  zalk(ji,jj) = trn(ji,jj,jk,jpalk)
+                  !! oxygen
+                  zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy))
+#  if defined key_axy_carbchem && defined key_mocsy
+                  !! phosphate via DIN and Redfield
+                  zpho(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) / 16.0
+#  endif
+                  !!
+                  !! also need physical parameters for gas exchange 
+                  !! calculations
+                  ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem)
+                  zsal(ji,jj) = tsn(ji,jj,jk,jp_sal)
+               ENDIF
+            ENDDO
+         ENDDO
+# else
+         !! diagnostic MEDUSA-1 detrital carbon tracer
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               IF (tmask(ji,jj,jk) == 1) THEN
+                  !! implicit detrital carbon
+                  zdtc(ji,jj) = zdet(ji,jj) * xthetad
+               ENDIF
+            ENDDO
+         ENDDO
+# endif
+
+# if defined key_roam
+         !! ---------------------------------------------
+         !! JPALM -- 14-12-2017 -- Here, before any exeptionnal crazy value is
+         !!              removed, we want to tell to the Master Processor that this 
+         !!              Exceptionnal value did exist
+         !!
+         Call trc_bio_check(kt, jk)
+
+         !!================================================================
+	 !! AXY (03/11/17): check input fields
+         !! tracer values that exceed thresholds can cause carbonate system
+         !! failures when passed to MOCSY; temporary temperature excursions
+         !! in recent UKESM0.8 runs trigger such failures but are too short
+         !! to have physical consequences; this section checks for such
+         !! values and amends them using neighbouring values
+         !! 
+         !! the check on temperature here is also carried out at the end of
+         !! each model time step and anomalies are reported in the master
+         !! ocean.output file; the error reporting below is strictly local
+         !! to the relevant ocean.output_XXXX file so will not be visible
+         !! unless all processors are reporting output
+         !!================================================================
+         !!
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  !! the thresholds for the four tracers are ...
+                  IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0  ) .OR.   &
+                       (zsal(ji,jj) .LE.  0.0) .OR. (zsal(ji,jj) .GT. 50.0  ) .OR.   &
+                       (zdic(ji,jj) .LE.  0.0) .OR. (zdic(ji,jj) .GT. 4.0E3 ) .OR.   &
+                       (zalk(ji,jj) .LE.  0.0) .OR. (zalk(ji,jj) .GT. 4.0E3 ) ) THEN
+                     !!
+                     !! all tracer values are reported in the event of any excursion
+                     IF (lwp) THEN
+                         WRITE(charout,*)  ' Tmp = ', ztmp(ji,jj)
+                         WRITE(charout2,*) ' Sal = ', zsal(ji,jj)
+                         WRITE(charout3,*) ' DIC = ', zdic(ji,jj)
+                         WRITE(charout4,*) ' Alk = ', zalk(ji,jj)
+                         WRITE(charout5,*) mig(ji), mjg(jj), jk, kt 
+                         CALL ctl_warn( 'trc_bio_medusa: carbonate chemistry WARNING:',  &
+                            TRIM(charout),TRIM(charout2),TRIM(charout3),TRIM(charout4),  & 
+                            'at i, j, k, kt:', TRIM(charout5) )
+                     ENDIF
+                     !!
+                     !! Detect, report and correct tracer excursions
+                     IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT.  40.0) )             &
+                        CALL trc_bio_exceptionnal_fix(                                         &
+                        tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_tem), tmask(ji-1:ji+1,jj-1:jj+1,jk),    &
+                        'Tmp', -3.0, 40.0, ztmp(ji,jj) )
+                     !!
+                     IF ( (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT.  50.0)  )             &
+                        CALL trc_bio_exceptionnal_fix(                                         &
+                        tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_sal), tmask(ji-1:ji+1,jj-1:jj+1,jk),    &
+                        'Sal', 1.0, 50.0, zsal(ji,jj) )
+                     !!
+                     IF ( (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3)  )             &
+                        CALL trc_bio_exceptionnal_fix(                                         &
+                        trn(ji-1:ji+1,jj-1:jj+1,jk,jpdic), tmask(ji-1:ji+1,jj-1:jj+1,jk),     &
+                        'DIC', 100.0, 4.0E3, zdic(ji,jj) )
+                     !!
+                     IF ( (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3)  )             &
+                        CALL trc_bio_exceptionnal_fix(                                         &
+                        trn(ji-1:ji+1,jj-1:jj+1,jk,jpalk), tmask(ji-1:ji+1,jj-1:jj+1,jk),     &
+                        'Alk', 100.0, 4.0E3, zalk(ji,jj) )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+# endif
+
+# if defined key_debug_medusa
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               if (tmask(ji,jj,jk) == 1) then
+                  if (idf.eq.1) then
+                     !! AXY (15/01/10)
+                     if (trn(ji,jj,jk,jpdin).lt.0.) then
+                        IF (lwp) write (numout,*)                            &
+                           '------------------------------'
+                        IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =',    &
+                           trn(ji,jj,jk,jpdin)
+                        IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @',    &
+                           ji, jj, jk, kt
+                     endif
+                     if (trn(ji,jj,jk,jpsil).lt.0.) then
+                        IF (lwp) write (numout,*)                            &
+                           '------------------------------'
+                        IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =',    &
+                           trn(ji,jj,jk,jpsil)
+                        IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @',    &
+                           ji, jj, jk, kt
+                     endif
+#  if defined key_roam
+                     if (trn(ji,jj,jk,jpdic).lt.0.) then
+                        IF (lwp) write (numout,*)                            &
+                           '------------------------------'
+                        IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =',    &
+                           trn(ji,jj,jk,jpdic)
+                        IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @',    &
+                           ji, jj, jk, kt
+                     endif
+                     if (trn(ji,jj,jk,jpalk).lt.0.) then
+                        IF (lwp) write (numout,*)                            &
+                           '------------------------------'
+                        IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =',    &
+                           trn(ji,jj,jk,jpalk)
+                        IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @',    &
+                           ji, jj, jk, kt
+                     endif
+                     if (trn(ji,jj,jk,jpoxy).lt.0.) then
+                        IF (lwp) write (numout,*)                            &
+                           '------------------------------'
+                        IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =',    &
+                           trn(ji,jj,jk,jpoxy)
+                        IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @',    &
+                           ji, jj, jk, kt
+                     endif
+#  endif
+                  endif
+               ENDIF
+            ENDDO
+         ENDDO
+# endif
+# if defined key_debug_medusa
+! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17
+!         if (idf.eq.1.AND.idfval.eq.1) then
+!            DO jj = 2,jpjm1
+!               DO ji = 2,jpim1
+!                  if (tmask(ji,jj,jk) == 1) then
+!                     !! report state variable values
+!                     IF (lwp) write (numout,*)                               &
+!                        '------------------------------'
+!                     IF (lwp) write (numout,*) 'fthk(',jk,') = ',            &
+!                        fse3t(ji,jj,jk)
+!                     IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn(ji,jj)
+!                     IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd(ji,jj)
+!                     IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds(ji,jj)
+!                     IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi(ji,jj)
+!                     IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme(ji,jj)
+!                     IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet(ji,jj)
+!                     IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin(ji,jj)
+!                     IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil(ji,jj)
+!                     IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer(ji,jj)
+#  if defined key_roam
+!                     IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc(ji,jj)
+!                     IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic(ji,jj)
+!                     IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk(ji,jj)
+!                     IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy(ji,jj)
+#  endif
+!                  ENDIF
+!               ENDDO
+!            ENDDO
+!         endif
+# endif
+
+# if defined key_debug_medusa
+! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17
+!         if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then
+!            DO jj = 2,jpjm1
+!               DO ji = 2,jpim1
+!                  if (tmask(ji,jj,jk) == 1) then
+!                     IF (lwp) write (numout,*)                               &
+!                       '------------------------------'
+!                     IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj)
+!                  ENDIF
+!               ENDDO
+!            ENDDO
+!         endif
+# endif
+
+         !!---------------------------------------------------------------
+         !! Calculate air-sea gas exchange and river inputs
+         !!---------------------------------------------------------------
+         IF ( jk == 1 ) THEN
+            CALL air_sea( kt )
+         ENDIF
+
+         !!---------------------------------------------------------------
+         !! Phytoplankton growth, zooplankton grazing and miscellaneous
+         !! plankton losses. 
+         !!---------------------------------------------------------------
+         CALL plankton( jk )
+
+         !!---------------------------------------------------------------
+         !! Iron chemistry and scavenging
+         !!---------------------------------------------------------------
+         CALL iron_chem_scav( jk )
+
+         !!---------------------------------------------------------------
+         !! Detritus processes
+         !!---------------------------------------------------------------
+         CALL detritus( jk, iball )
+
+         !!---------------------------------------------------------------
+         !! Updating tracers
+         !!---------------------------------------------------------------
+         CALL bio_medusa_update( kt, jk )
+
+         !!---------------------------------------------------------------
+         !! Diagnostics
+         !!---------------------------------------------------------------
+         CALL bio_medusa_diag( jk )
+
+         !!-------------------------------------------------------
+         !! 2d specific k level diags
+         !!-------------------------------------------------------
+         IF( lk_iomput ) THEN
+            CALL bio_medusa_diag_slice( jk )
+         ENDIF
+
+      !! CLOSE vertical loop
+      ENDDO
+
+      !!------------------------------------------------------------------
+      !! Final calculations for diagnostics
+      !!------------------------------------------------------------------
+      CALL bio_medusa_fin( kt )
+
+# if defined key_debug_medusa
+       IF(lwp) WRITE(numout,*) ' MEDUSA exiting trc_bio_medusa at kt =', kt
+       CALL flush(numout)
+# endif
+
+   END SUBROUTINE trc_bio_medusa
+
+
+
+   SUBROUTINE trc_bio_exceptionnal_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout)
+      !! JPALM (27/10/17): This function is called only when abnormal values that 
+      !! could break the model's carbonate system are fed to MEDUSA
+      !! 
+      !! The function calculates an average tracer value based on the 3x3 cell
+      !! neighbourhood around the abnormal cell, and reports this back
+      !! 
+      !! Tracer array values are not modified, but MEDUSA uses "corrected" values
+      !! in its calculations
+      !!
+      !! temporary variables
+      REAL(wp), INTENT( in ), DIMENSION(3,3) :: tiny_var, tiny_mask
+      CHARACTER(25), INTENT( in )            :: var_nm
+      REAL(wp), INTENT( in )                 :: mini, maxi
+      REAL(wp), INTENT( out )                :: varout
+      REAL(wp)      :: sumtsn, tsnavg
+      INTEGER       :: summask
+      CHARACTER(25) :: charout1, charout2
+      CHARACTER(60) :: charout3, charout4
+      INTEGER       :: ii,ij
+    
+      !! point to the center of the 3*3 zoom-grid, to check around
+      ii = 2
+      ij = 2
+      !! Print surounding values to check if isolated Crazy value or 
+      !! General error
+      IF(lwp) THEN 
+          WRITE(numout,*)                                 &
+            '----------------------------------------------------------------------'
+          WRITE(numout,*)                                 &
+            'trc_bio_medusa: 3x3 neighbourhood surrounding abnormal ', TRIM(var_nm)
+          WRITE(numout,9100)                              &
+            3, tiny_var(ii-1,ij+1), tiny_var(ii  ,ij+1), tiny_var(ii+1,ij+1)
+          WRITE(numout,9100)                              &
+            2, tiny_var(ii-1,ij  ), tiny_var(ii  ,ij  ), tiny_var(ii+1,ij  )
+          WRITE(numout,9100)                              &
+            1, tiny_var(ii-1,ij-1), tiny_var(ii  ,ij-1), tiny_var(ii+1,ij-1)
+          WRITE(numout,*)                                 &
+            'trc_bio_medusa: 3x3 land-sea neighbourhood, tmask'
+          WRITE(numout,9100)                              &
+            3, tiny_mask(ii-1,ij+1), tiny_mask(ii  ,ij+1), tiny_mask(ii+1,ij+1)
+          WRITE(numout,9100)                              &
+            2, tiny_mask(ii-1,ij  ), tiny_mask(ii  ,ij  ), tiny_mask(ii+1,ij  )
+          WRITE(numout,9100)                              &
+            1, tiny_mask(ii-1,ij-1), tiny_mask(ii  ,ij-1), tiny_mask(ii+1,ij-1)
+      ENDIF
+      !! Correct out of range values
+      sumtsn = ( tiny_mask(ii-1,ij+1) * tiny_var(ii-1,ij+1) ) +  &
+               ( tiny_mask(ii  ,ij+1) * tiny_var(ii  ,ij+1) ) +  &
+               ( tiny_mask(ii+1,ij+1) * tiny_var(ii+1,ij+1) ) +  &
+               ( tiny_mask(ii-1,ij  ) * tiny_var(ii-1,ij  ) ) +  &
+               ( tiny_mask(ii+1,ij  ) * tiny_var(ii+1,ij  ) ) +  &
+               ( tiny_mask(ii-1,ij-1) * tiny_var(ii-1,ij-1) ) +  &
+               ( tiny_mask(ii  ,ij-1) * tiny_var(ii  ,ij-1) ) +  &
+               ( tiny_mask(ii+1,ij-1) * tiny_var(ii+1,ij-1) )
+      !!
+      summask = tiny_mask(ii-1,ij+1) + tiny_mask(ii  ,ij+1)   +  &
+                tiny_mask(ii+1,ij+1) + tiny_mask(ii-1,ij  )   +  &
+                tiny_mask(ii+1,ij  ) + tiny_mask(ii-1,ij-1)   +  &
+                tiny_mask(ii  ,ij-1) + tiny_mask(ii+1,ij-1)
+      !!
+      IF ( summask .GT. 0 ) THEN
+         tsnavg = ( sumtsn / summask )
+         varout = MAX( MIN( maxi, tsnavg), mini )
+      ELSE   
+         IF (ztmp(ii,ij) .LT. mini )  varout = mini
+         IF (ztmp(ii,ij) .GT. maxi )  varout = maxi
+      ENDIF
+      !!
+      IF (lwp) THEN 
+          WRITE(charout1,9200) tiny_var(ii,ij)
+          WRITE(charout2,9200) varout
+          WRITE(charout3,*) ' ', charout1, ' -> ', charout2
+          WRITE(charout4,*) ' Tracer: ', trim(var_nm)
+      !!
+          WRITE(numout,*) 'trc_bio_medusa: ** EXCEPTIONAL VALUE SWITCHING **'
+          WRITE(numout,*) charout4 
+          WRITE(numout,*) charout3
+          WRITE(numout,*) '----------------------------------------------------------------------'
+          WRITE(numout,*) ' '
+      ENDIF
+
+9100  FORMAT('Row:', i1, '  ', e16.6, ' ', e16.6, ' ', e16.6)
+9200  FORMAT(e16.6)
+
+   END SUBROUTINE trc_bio_exceptionnal_fix 
+
+   SUBROUTINE trc_bio_check(kt, jk)
+      !!-----------------------------------
+      !! JPALM -- 14-12-2017 -- Still dealing with this micro-boil/carb failure
+      !!                     problem. The model is now able to correct a local
+      !!                     crazy value. but does it silently.
+      !!                     We need to spread the word to the master processor. we
+      !!                     don't want the model  to correct values without telling us
+      !!                     This module will tell at least when crazy DIC or
+      !!                     ALK appears.
+      !!-------------------------------------
+      REAL(wp)              :: zmax, zmin    ! temporary scalars
+      INTEGER               :: ji,jj         ! dummy loop
+      INTEGER               :: ii,ij         ! temporary scalars 
+      INTEGER, DIMENSION(2) :: ilocs         ! 
+      INTEGER, INTENT( in ) :: kt, jk
+      !!
+      !!==========================
+      !! DIC Check
+      zmax =  -5.0  ! arbitrary  low maximum value
+      zmin =  4.0E4  ! arbitrary high minimum value
+      DO jj = 2, jpjm1
+         DO ji = 2,jpim1
+            IF( tmask(ji,jj,1) == 1) THEN
+               zmax = MAX(zmax,zdic(ji,jj))     ! find local maximum
+               zmin = MIN(zmin,zdic(ji,jj))     ! find local minimum
+            ENDIF
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zmax )       ! max over the global domain
+      IF( lk_mpp )   CALL mpp_min( zmin )       ! min over the global domain
+      !
+      IF( zmax .GT. 4.0E3) THEN  ! we've got a problem
+         IF (lk_mpp) THEN
+            CALL mpp_maxloc ( zdic(:,:),tmask(:,:,1), zmax, ii,ij )
+         ELSE
+            ilocs = MAXLOC( zdic(:,:), mask = tmask(:,:,1) == 1. )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 'trc_bio:tracer anomaly: *****    WARNING     *****'
+            WRITE(numout,*) 'trc_bio:tracer anomaly: DIC concentration > 4000 '
+            WRITE(numout,9600) kt, zmax, ii, ij, jk
+            WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****'
+         ENDIF
+      ENDIF
+      !
+      IF( zmin .LE. 0.0) THEN  ! we've got a problem
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( zdic(:,:),tmask(:,:,1), zmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( zdic(:,:), mask = tmask(:,:,1) == 1. )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 'trc_bio:tracer anomaly: *****    WARNING     *****'
+            WRITE(numout,*) 'trc_bio:tracer anomaly: DIC concentration <= 0 '
+            WRITE(numout,9700) kt, zmin, ii, ij, jk
+            WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****'
+         ENDIF
+      ENDIF
+      !!
+      !!==========================
+      !! ALKALINITY Check
+      zmax =  -5.0  ! arbitrary  low maximum value
+      zmin =  4.0E4  ! arbitrary high minimum value
+      DO jj = 2, jpjm1
+         DO ji = 2,jpim1
+            IF( tmask(ji,jj,1) == 1) THEN
+               zmax = MAX(zmax,zalk(ji,jj))     ! find local maximum
+               zmin = MIN(zmin,zalk(ji,jj))     ! find local minimum
+            ENDIF
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zmax )       ! max over the global domain
+      IF( lk_mpp )   CALL mpp_min( zmin )       ! min over the global domain
+      !
+      IF( zmax .GT. 4.0E3) THEN  ! we've got a problem
+         IF (lk_mpp) THEN
+            CALL mpp_maxloc ( zalk(:,:),tmask(:,:,1), zmax, ii,ij )
+         ELSE
+            ilocs = MAXLOC( zalk(:,:), mask = tmask(:,:,1) == 1. )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 'trc_bio:tracer anomaly: *****     WARNING    *****'
+            WRITE(numout,*) 'trc_bio:tracer anomaly: ALK concentration > 4000 '
+            WRITE(numout,9800) kt, zmax, ii, ij, jk
+            WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****'
+         ENDIF
+      ENDIF
+      !
+      IF( zmin .LE. 0.0) THEN  ! we've got a problem
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( zalk(:,:),tmask(:,:,1), zmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( zalk(:,:), mask = tmask(:,:,1) == 1. )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 'trc_bio:tracer anomaly: *****    WARNING     *****'
+            WRITE(numout,*) 'trc_bio:tracer anomaly:  ALK concentration <= 0 '
+            WRITE(numout,9900) kt, zmin, ii, ij, jk
+            WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****'
+         ENDIF
+      ENDIF
+
+
+9600  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max DIC: ',f16.10,', i j k: ',3i5)
+9700  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min DIC: ',f16.10,', i j k: ',3i5)
+9800  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max ALK: ',f16.10,', i j k: ',3i5)
+9900  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min ALK: ',f16.10,', i j k: ',3i5)
+
+   END SUBROUTINE trc_bio_check
+
+
+#else
+   !!=====================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!=====================================================================
+CONTAINS
+   SUBROUTINE trc_bio_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_bio_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bio_medusa
+#endif 
+
+   !!=====================================================================
+END MODULE  trcbio_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcco2_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcco2_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcco2_medusa.F90	(revision 9824)
@@ -0,0 +1,1136 @@
+MODULE trcco2_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcco2_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2010-12  (A. Yool)             added for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA carbonate chemistry
+   !!----------------------------------------------------------------------
+   !!   trc_co2_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_co2_medusa    ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - trc_co2_medusa
+!      - CALLS CO2_dynamics
+!           - CALLS CO2DYN
+!		 - CALLS POLYCO
+!		      - CALLS CO2SET
+!		      - CALLS CO2CLC
+!           - CALLS CaCO3_Saturation
+!      - CALLS Air_sea_exchange
+
+CONTAINS
+
+!=======================================================================
+!
+      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 )
+!      
+!=======================================================================
+!  
+! This file contains a set of FORTRAN subroutines that calculate the carbonate system 
+! at any given point in marine space time, given values for 
+! temperature, salinity, DIC, depth (pressure). 
+! This is essentially an implimentation of the Haltafall speciation code
+! (Ingri et al 1967, Talanta 14, 1261 - if it ain't broke don't fix it)
+! Another routine calulates the air sea exchange of CO2 given wind speed and atmospheric pCO2.
+! Code developed by Jerry blackford and others at PML, based on pre-existing code.
+! We accept no liability for errors or inaccuracies.
+! See Zeebe & Wolf-Gladrow, 2001. CO2 in seawater: equilibrium, kinetics and isotopes. 
+! Elsevier Oceanography Series 65, 346. for a reasonable overview. 
+! Many other packages exist, replicating the same functionality in different languages.
+! See http://cdiac.ornl.gov/oceans/co2rprt.html (CO2sys)
+! or  http://neon.otago.ac.nz/research/mfc/people/keith_hunter/software/swco2/
+! reference for prior usage of this code: Blackford & Gilbert, 2007. J Mar Sys 64, 229-241.
+! 
+! Modifications
+! 17/02/2010. Added conversion factor from per m3 to per kg (line 108-133)
+! 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: 
+!     - making the program a module
+!     - passing in input variables (obvious given the last point)
+!     - making alkalinity a state variable (rather than a function of salinity)
+!
+      IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: Temp       ! degrees C
+      REAL(wp), INTENT( in )    :: Sal        ! PSU
+      REAL(wp), INTENT( in )    :: DIC        ! mmol / m3
+      REAL(wp), INTENT( in )    :: ALK        ! meq  / m3
+      REAL(wp), INTENT( in )    :: Depth      ! m
+!     REAL(wp), INTENT( in )    :: Wnd        ! m / s
+      REAL(wp), INTENT( in )    :: xkw        ! m / s
+      REAL(wp), INTENT( in )    :: pCO2a      ! uatm
+!----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: pH         ! "normal" pH units
+      REAL(wp), INTENT( inout ) :: pCO2w      ! uatm
+      REAL(wp), INTENT( inout ) :: h2co3      ! mmol / m3
+      REAL(wp), INTENT( inout ) :: hco3       ! mmol / m3
+      REAL(wp), INTENT( inout ) :: co3        ! mmol / m3
+      REAL(wp), INTENT( inout ) :: om_cal     ! normalised
+      REAL(wp), INTENT( inout ) :: om_arg     ! normalised
+      REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / s
+      REAL(wp), INTENT( inout ) :: TDIC       ! umol / kg
+      REAL(wp), INTENT( inout ) :: TALK       ! ueq  / kg
+      REAL(wp), INTENT( inout ) :: dcf        ! m3 / kg
+      REAL(wp), INTENT( inout ) :: henry      ! ?
+      INTEGER,  INTENT( inout ) :: iters      ! # iterations to convergence
+!----------------------------------------------------------------------
+!     REAL(wp) :: cco2,bicarb,carb,henry
+      REAL(wp) :: cco2,bicarb,carb
+! ======================================================================
+
+! write inputs to screen
+!  WRITE(*,*) " "
+!  WRITE(*,'(A28)')       "    .........Inputs........."
+!  WRITE(*,'(A24,F10.3)') "    Temperature   (C) = ", Temp
+!  WRITE(*,'(A24,F10.3)') "    Salinity    (psu) = ", Sal
+!  WRITE(*,'(A24,F10.3)') "    Depth         (m) = ", Depth
+!  WRITE(*,'(A24,F10.3)') "    DIC     (mmol/m3) = ", DIC
+!  WRITE(*,'(A24,F10.3)') "    ALK      (ueq/m3) = ", ALK
+!  WRITE(*,'(A24,F10.3)') "    Wind speed  (m/s) = ", Wnd
+!  WRITE(*,'(A24,F10.3)') "    pCO2 atmos (uatm) = ", pCO2a
+
+! AXY (07/05/13) ==================================================
+! set total number of iterations to zero
+      iters = 0
+! AXY (07/05/13) ==================================================
+  
+   call CO2_dynamics( Temp, Sal, Depth, DIC, ALK, pCO2a, &                  ! inputs
+      pco2w, ph, h2co3, hco3, co3, henry, om_cal, om_arg, TDIC, TALK, &     ! outputs
+      dcf, iters)                                                           ! outputs
+
+   ! AXY (18/08/11): only do air-sea exchange calculation if depth = 0 
+   !                 (i.e. surface calculations being performed)
+   if (Depth .eq. 0.0) then
+      call Air_sea_exchange( Temp, xkw, pCO2w, pCO2a, henry, dcf, &         ! inputs
+         co2flux )                                                          ! output
+   else
+      co2flux = 0.0
+   endif      
+
+! AXY (09/01/14) ==================================================
+! check for non-convergence and NaNs
+   !!
+   if (iters .eq. 25) then
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: ITERS WARNING, ', &
+      iters, ' AT depth =', Depth
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: ztmp    =', Temp
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zsal    =', Sal
+      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_kw660 =', xkw
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_ph    =', ph
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_pco2w =', pCO2w
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_h2co3 =', h2co3
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_hco3  =', hco3
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_co3   =', co3
+   endif
+   !!
+   !! AXY (29/10/13): NaN checks
+   if (co2flux /= co2flux) then
+      !! if (lwp) write (numout,'(a,1pe10.2,4i6)') 'CO2FLUX-NAN', &
+      !! &        tmask(ji,jj,jk), kt, ji, jj, jk
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' TMP', Temp, ' SAL', Sal
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' DIC', DIC, ' ALK', ALK
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' XKW', xkw, ' PH ', ph
+      if (lwp) write (numout,'(a,a,i6)') 'CO2FLUX-NAN', &
+      &        ' ITERS', iters
+   endif
+   !!
+   !! AXY (09/01/14): NaN fudges
+   if (co2flux /= co2flux) then
+      ph      = 8.1
+      pCO2w   = pCO2a
+      h2co3   = 0.005 * DIC
+      hco3    = 0.865 * DIC
+      co3     = 0.130 * DIC
+      om_cal  = 4.
+      om_arg  = 2.
+      co2flux = 0.
+      TDIC    = DIC
+      TALK    = ALK
+      dcf     = 1.
+      henry   = 1.
+   endif
+! AXY (09/01/14) ==================================================
+
+! write outputs to screen
+!  WRITE(*,*) " "
+!  WRITE(*,'(A32,F10.3)') "    ..........Outputs..........."
+!  WRITE(*,'(A27,F10.3)') "    pH                 (pH) = ", pH
+!  WRITE(*,'(A27,F10.3)') "    DIC           (umol/kg) = ", TDIC
+!  WRITE(*,'(A27,F10.3)') "    TALK           (ueq/kg) = ", TALK
+!  WRITE(*,'(A27,F10.3)') "    pco2w            (uatm) = ", pco2w
+!  WRITE(*,'(A27,F10.3)') "    carbonic acid (mmol/m3) = ", h2co3
+!  WRITE(*,'(A27,F10.3)') "    bicarbonate   (mmol/m3) = ", bicarb
+!  WRITE(*,'(A27,F10.3)') "    carbonate     (mmol/m3) = ", carb
+!  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/s) = ", flux
+!  WRITE(*,*) " "
+
+   END SUBROUTINE trc_co2_medusa
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      subroutine CO2_dynamics( T, S, Z, DIC, TALK, pco2a, &
+      pco2w, ph, h2co3, bicarb, carb, henry, om_cal, om_arg, TCO2, TA, &
+      dcf, iters )
+!      
+!=======================================================================
+!  
+   IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: T          ! temperature (C)
+      REAL(wp), INTENT( in )    :: S          ! salinity (psu)
+      REAL(wp), INTENT( in )    :: Z          ! depth (metres)
+      REAL(wp), INTENT( in )    :: DIC        ! total dissolved inorganic carbon (mmol.m-3)
+      REAL(wp), INTENT( in )    :: TALK       ! total alkalinity (meq.m-3)
+      REAL(wp), INTENT( in )    :: pco2a      ! atmospheric pCO2
+!----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: pco2w      ! seawater pCO2
+      REAL(wp), INTENT( inout ) :: ph         ! seawater pH
+      REAL(wp), INTENT( inout ) :: h2co3      ! seawater carbonic acid (H2CO3)
+      REAL(wp), INTENT( inout ) :: bicarb     ! seawater bicarbonate ion (HCO3)
+      REAL(wp), INTENT( inout ) :: carb       ! seawater carbonate ion (CO3)
+      REAL(wp), INTENT( inout ) :: henry      ! Henry constant
+      REAL(wp), INTENT( inout ) :: om_cal     ! Omega calcite
+      REAL(wp), INTENT( inout ) :: om_arg     ! Omega aragonite
+      REAL(wp), INTENT( inout ) :: TCO2       ! total dissolved inorganic carbon (mol.kg-1)
+      REAL(wp), INTENT( inout ) :: TA         ! total alkalinity (eq.kg-1)
+      REAL(wp), INTENT( inout ) :: dcf        ! density conversion factor
+      INTEGER,  INTENT( inout ) :: iters      ! # iterations to convergence
+!----------------------------------------------------------------------
+      REAL(wp) :: a, b, c
+      REAL(wp) :: ca, bc, cb
+      REAL(wp) :: pco2water, fairco2
+
+! ======================================================================
+
+! Adjust to correct units.
+! Haltafall uses mol/kg rather than umol/kg necessitating a scaling factor of /1.0D6
+! DIC (mmol/m3) needs to be converted to umol/kg via the calculation of water density at prevailing T&S
+! sea-water density (Millero & Poisson, Deep-Sea Research, 1981, also known as UNESCO, 1981)
+! with T: Temperature in degree Celsius; S: Salinity in practical units, density in kg/m3
+! valid for 0<T<40 and 0.5<S<43. Density Conversion factor (dcf) = * density * 1.0D3
+
+          a   =  8.24493d-1 - 4.0899d-3*T +  7.6438d-5*T**2 - 8.2467d-7*T**3 + 5.3875d-9*T**4
+          b   = -5.72466d-3 + 1.0227d-4*T - 1.6546d-6*T**2 
+          c   = 4.8314d-4
+          dcf = (999.842594 + 6.793952d-2*T- 9.095290d-3*T**2 + 1.001685d-4*T**3 &
+                - 1.120083d-6*T**4 + 6.536332d-9*T**5+a*S+b*S**1.5+c*S**2)/1.0D3
+
+          TA    = TALK / (1.0D6*dcf)
+          TCO2  = DIC  / (1.0D6*dcf)
+
+! Call the parent routine for the carbonate system
+          CALL CO2DYN ( TCO2, TA, T, S, pco2a, &     ! inputs
+          pco2water, pH, HENRY, ca, bc, cb, iters )  ! outputs
+
+! Adjust outputs back to units used in the parent model code (e.g. mmol/m3) if appropriate
+
+          pco2w  = pco2water * (1.0D6) 	! partial pressure of co2 in water 
+          TA     = TA * (1.0D6)         ! total alkalinity (umol/kg)
+          h2co3  = ca * (1.0D6*dcf)     ! carbonic acid concentration (mmol/m3)
+          bicarb = bc * (1.0D6*dcf)     ! bicarbonate ion concentration (mmol/m3)
+          carb   = cb * (1.0D6*dcf)     ! carbonate ion concentration (mmol/m3)
+          TCO2   = TCO2 * (1.0D6)       ! total C or DIC in units of umol/kg
+
+! Call carbonate saturation state subroutine to calculate calcite and aragonite calcification states
+
+          CALL CaCO3_Saturation ( T, S, Z, cb, &  ! inputs
+          om_cal, om_arg )                        ! outputs
+
+   RETURN
+
+   END SUBROUTINE CO2_dynamics
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE Air_sea_exchange( T, xkw, pco2w, pco2a, henry, dcf, &
+      flux )
+!      
+!=======================================================================
+!  
+!  This routine should be called for the surface box only (like, duh)
+!  Uses the Nightingale and Liss parameterisation (GBC 14, 373-388 (2000).
+!  SC is the Schmidt number from Wanninkhof (1992, JGR 97,7373-7382), the Nightingale et al (2000)
+!  transfer velocity being for Sc=600 and the dependence of tranfer velocity on Sc coming 
+!  from Jahne et al (1987, J. Geophys Res 92, 1937-1949).
+
+!  Inputs
+!  pCO2w    partial pressure of CO2 in the water (from carbonate system subroutine call)
+!  pCO2a    partial pressure of CO2 in the atmosphere (usually external forcing).
+!  T        temperature (C)
+!  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
+
+!  Outputs are
+!  flux     flux of CO2 in mmol C /m2/d 
+!           +ve is in-gassing (air to sea), -ve is outgassing (sea to air).
+
+   IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: T, xkw, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS:
+!-----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: flux                             ! OUTPUT Variables
+!-----------------------------------------------------------------------
+      REAL(wp)                  :: sc, fwind                        ! LOCAL VARIABLES:
+
+! 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 = xkw * (sc/660.d0)**(-0.5)
+          fwind = fwind*24.d0/100.d0   ! convert to m/day
+
+! flux depends on the difference in partial pressures, wind and henry
+! 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 
+
+  END SUBROUTINE Air_sea_exchange
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2dyn ( TCO2, TA, T, S, PCO2A, PCO2, PH, HENRY, ca, bc, cb, iters )
+!      
+!=======================================================================
+!
+!     This subroutine acts as an interface to the Haltafall iteration, setting options etc.
+
+      REAL(wp), INTENT( in )    :: TCO2, TA, T, S, PCO2A
+!-----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: PCO2, PH, HENRY, ca, bc, cb
+      INTEGER,  INTENT( inout ) :: iters
+!-----------------------------------------------------------------------
+      REAL(wp) :: PRSS
+      INTEGER  :: MCONC, MKVAL, ICONST, ICALC
+
+      PARAMETER ( MCONC = 9,MKVAL = 4 )
+
+      REAL(wp), DIMENSION(MKVAL) :: AKVAL
+      REAL(wp), DIMENSION(MCONC) :: CONCS
+
+      ICONST = 6
+      PRSS = 1.0D0
+      CONCS(1) = TCO2
+      CONCS(2) = TA
+      ICALC = 1
+      
+      CALL POLYCO(PRSS,T,S,CONCS,MCONC,AKVAL,MKVAL,ICALC,ICONST,iters)
+
+      if(iters.eq.25) then
+         ! AXY (13/05/13): this location has failed to converge; use
+         !                 some standard values to plug the hole
+         CONCS(3) = PCO2A * 1E-06 ! atmospheric value
+         CONCS(4) = 8.1           ! global average pH
+         CONCS(5) = TCO2 * 0.005  ! some "standard" values plucked
+         CONCS(6) = TCO2 * 0.865  ! from pages 5-6 of Zeebe & Wolf-
+         CONCS(7) = TCO2 * 0.130  ! Gladow (2001)
+         AKVAL(1) = 0.5E-01       ! trial-and-error value
+         IF(lwp) THEN
+            WRITE(numout,*) ' CO2DYN : reset failed outputs'
+         ENDIF
+      endif
+
+      PCO2  = CONCS(3)
+      PH    = CONCS(4)
+      ca    = CONCS(5)
+      bc    = CONCS(6)
+      cb    = CONCS(7)
+      HENRY = AKVAL(1)
+    
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE POLYCO(PD,TD,SD,CONCS,NCONC,AKVAL,NKVAL,ICALC,ICONST,iters)
+!      
+!=======================================================================
+!
+! MASTER SUBROUTINE FOR CALCULATION OF THE CO2 SYSTEM THERMODYNAMICS
+!
+! EXPLANATION OF POLYCO PARAMETERS
+!       AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+!       P - PRESSURE IN ATMOSPHERES (P<>1 CODED only for ICONST=3 and ICONST=6)
+!       T - TEMPERATURE IN DEG.C
+!       S - SALINITY IN PPT
+!      CONCS(1) - TOTAL C (MOL/KG)
+!      CONCS(2) - TOTAL ALKALINITY (MOL/KG)
+!      CONCS(3) - PCO2 (ATM)
+!      CONCS(4) - PH
+!      CONCS(5) - {H2CO3} (MOL/KG)
+!      CONCS(6) - {HCO3} (MOL/KG)
+!      CONCS(7) - {CO3} (MOL/KG)
+!        CONCS(8) - CARBONATE ALKALINITY  ) FOR ICONST = 4,5,6
+!        CONCS(9) - BORATE ALKALINITY     )       ONLY
+!         NCONC - SIZE OF CONCS ARRAY (7 FOR ICONST=1,2,3; 9 FOR ICONST
+!     AKVAL(1) - KP (HENRY'S LAW CONSTANT) (MOL/KG/ATM)
+!     AKVAL(2) - K1C (H2CO3 DISSOCIATION) (MOL/KG)
+!       AKVAL(3) - K2C (HCO3 DISSOCIATION) (MOL/KG)
+!       AKVAL(4) - KB (B(OH)3 DISSOCIATION) (MOL/KG)  FOR ICONST=4,5,6
+!        NKVAL - SIZE OF AKVAL ARRAY (3 FOR ICONST=1,2,3; 4 FOR ICONST=
+!        ICALC - SELECTION OF THE TWO INPUT PARAMETERS:
+!       ICALC = 1  TOTAL C AND ALKALINITY
+!       ICALC = 2  TOTAL C AND PCO2
+!       ICALC = 3  TOTAL C AND PH
+!       ICALC = 4  ALKALINITY AND PCO2
+!       ICALC = 5  ALKALINITY AND PH
+!       ICALC = 6  PCO2 AND PH
+!       ICALC = 7  CALCULATE CONSTANTS AKVAL ONLY
+!       ICONST - SELECTION OF PH SCALE AND COMPONENTS:
+!       ICONST = 1  NBS PH SCALE
+!       ICONST = 2  HANSSON'S SCALE (SWS WITHOUT FLUORIDE)
+!       ICONST = 3  SWS PH SCALE
+!       ICONST = 4  AS 1 BUT INCLUDING BORATE IN THE CALCULATION
+!       ICONST = 5  AS 2 BUT INCLUDING BORATE IN THE CALCULATION
+!       ICONST = 6  AS 3 BUT INCLUDING BORATE IN THE CALCULATION
+
+!  NOTE: FOR ICONST=1,2,3 CONCS(2) REPRESENTS CARBONATE ALKALINITY SINC
+!        BORATE IS NOT INCLUDED IN THE CALCULATION. FOR ICONST=4,5,6 CO
+!        REPRESENTS TOTAL ALKALINITY (CARBONATE + BORATE), THE COMPONEN
+!        WHICH ARE GIVEN IN CONCS(8) AND CONCS(9)
+
+      REAL(wp) :: PMIN, PMAX, SMIN, SMAX, TMIN, TMAX, & 
+     &     PD, TD, SD, P, T, S, BTOT
+      INTEGER  :: MINJC, MAXJC, MINJK, MAXJK, MINCAL, MAXCAL, MINCON,  &
+     &     MAXCON, NCONC, NKVAL, ICALC, ICONST, IC, iters
+      LOGICAL  :: BORON
+
+      PARAMETER(MINJC=7,MAXJC=9,MINJK=3,MAXJK=4)
+      PARAMETER(MINCAL=1,MAXCAL=7,MINCON=1,MAXCON=6)
+      !! AXY (11/08/11): TMIN changed to -2 to stop error messages in polar regions
+      !! AXY (09/01/14): TMIN changed to -3 to stop error messages in polar regions
+      !! AXY (03/03/14): SMAX changed to 42 to stop error messages in salty regions (the Great Answer ...)
+      !! AXY (05/03/14): SMAX changed to 45 to stop error messages in salty regions
+      PARAMETER(PMIN=0.99999D0,PMAX=1.00001D0,SMIN=0.0D0,  &
+     &  SMAX=45.0D0,TMIN=-3.0D0,TMAX=40.0D0)
+      REAL(wp), DIMENSION(NKVAL) :: AKVAL
+      REAL(wp), DIMENSION(NCONC) :: CONCS
+
+      P = PD
+      S = SD
+      T = TD
+      
+      !! AXY (09/08/11): STOP statements commented out and WARNING messages added
+      IF(lwp) THEN
+         IF(T.LT.TMIN.OR.T.GT.TMAX) WRITE(numout,*) ' trc_co2_medusa: T WARNING, ', T, TMIN, TMAX, S, P
+         IF(S.LT.SMIN.OR.S.GT.SMAX) WRITE(numout,*) ' trc_co2_medusa: S WARNING, ', S, SMIN, SMAX, T, P
+         IF(P.LT.PMIN.OR.P.GT.PMAX) WRITE(numout,*) ' trc_co2_medusa: P WARNING, ', P, PMIN, PMAX, T, S
+      ENDIF
+      ! IF(T.LT.TMIN.OR.T.GT.TMAX)WRITE (*,*) P, S, T, TMIN, TMAX
+      ! IF(P.LT.PMIN.OR.P.GT.PMAX) STOP'POLYCO - PRESSURE OUT OF RANGE'
+      ! IF(S.LT.SMIN.OR.S.GT.SMAX) STOP'POLYCO - SALINITY OUT OF RANGE'
+      ! IF(T.LT.TMIN.OR.T.GT.TMAX) STOP'POLYCO - TEMP. OUT OF RANGE'
+
+      !! AXY (17/04/13): iMARNET climate change simulation appears to be compromised
+      !!                 by excessive Caspian Sea salinity (> 45 PSU); this may be
+      !!                 a runoff glitch that doesn't manifest on local instance of
+      !!                 NEMO; fudging this here by replacing excessively high
+      !!                 salinity values with maximum salinity value for the purpose
+      !!                 of carbonate chemistry calculations; if this works, a more
+      !!                 sensible solution might be to kill Caspian, etc.
+      IF(lwp) THEN
+         IF(S.LT.SMIN) THEN
+            WRITE(numout,*) ' trc_co2_medusa: S RESET, ', S, '->', SMIN
+            S = SMIN
+         ENDIF
+         IF(S.GT.SMAX) THEN
+            WRITE(numout,*) ' trc_co2_medusa: S RESET, ', S, '->', SMAX
+            S = SMAX
+         ENDIF
+      ENDIF
+      
+      !! AXY (28/02/13): as above, but for T; this has been done for 1/4-degree
+      !!                 simulations to provide a temporary fix to a strange
+      !!                 glitch in ocean temperature; basically, T has been found
+      !!                 to spike upwards arbitrarily (e.g. 24C -> 53C); this 
+      !!                 causes the carbonate chemistry calculations to fail;
+      !!                 this fix aims to stop the problem so that we can estimate
+      !!                 how frequent a problem this is; it's suggestive of a
+      !!                 memory leak
+      IF(lwp) THEN
+         IF(T.LT.TMIN) THEN
+            WRITE(numout,*) ' trc_co2_medusa: T RESET, ', T, '->', TMIN
+            T = TMIN
+         ENDIF
+         IF(T.GT.TMAX) THEN
+            WRITE(numout,*) ' trc_co2_medusa: T RESET, ', T, '->', TMAX
+            T = TMAX
+         ENDIF
+      ENDIF
+     
+      IF(ICALC.LT.MINCAL.OR.ICALC.GT.MAXCAL) STOP 'POLYCO - ICALC OUT OR RANGE'
+      IF(ICONST.LT.MINCON.OR.ICONST.GT.MAXCON) STOP 'POLYCO - ICONST OUT OF RANGE'
+      BORON=(ICONST.GT.3)
+      IF(BORON) THEN
+        IC=ICONST-3
+        BTOT=0.0004128D0*S/35.0D0
+        IF(NCONC.NE.MAXJC) STOP 'POLYCO - WRONG NCONC VALUE'
+        IF(NKVAL.NE.MAXJK) STOP 'POLYCO - WRONG NKVAL VALUE'
+      ELSE
+        IC=ICONST
+        IF(NCONC.NE.MINJC) STOP 'POLYCO - WRONG NCONC VALUE'
+        IF(NKVAL.NE.MINJK) STOP 'POLYCO - WRONG NKVAL VALUE'
+      ENDIF
+
+      CALL CO2SET(P,T,S,AKVAL,NKVAL,IC)
+
+      IF(ICALC.LT.MAXCAL)  &
+     & CALL CO2CLC(CONCS,NCONC,AKVAL,NKVAL,ICALC,BORON,BTOT,iters)
+
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2SET(P,T,S,AKVAL,NKVAL,IC)
+!      
+!=======================================================================
+!
+! Routine to calculate CO2 system constants under the conditions set by
+! P,S,T     (NOTE: PRESSURE <> 1ATM IS NOT YET CODED)
+
+! I. Calculate constants at P=1 and S=0 using
+
+!      ln K0  =  A + B/TK + C ln TK
+!                                   (where TK is in Kelvin)
+
+! II. Calculate constants at P=1 and salinity S using
+
+!    ln K  =  ln K0 + (a0 + a1/TK + a2 ln TK) S**1/2
+!                 + (b0 + b1TK + b2TK**2) S
+
+! The sources of the coefficients are as follows:
+
+!  IC=                  1                    2                  3
+!               (NBS pH scale)        (SWS pH scale       (SWS pH scale
+!                                       with no F)
+
+!  KP            WEISS (1974)           WEISS(1974)          WEISS(1974
+
+!  K1C )      MEHRBACH ACC. TO       HANSSON ACC. TO    HANSSON AND MEH
+!  K2C )       MILLERO (1979)         MILLERO (1979)      ACC. TO DICKS
+!   KB )                                                 AND MILLERO (1
+!                                                         (K1C AND K2C
+!                                                           HANSSON ACC
+!                                                            MILLERO (1
+!                                                              (KB ONLY
+
+! ***
+!      IMPLICIT real*8 (A-H,O-Z)
+
+!     Modified by jcb 17/02/10 to use OCMIP calculations of K1, K2, Kb. 
+!     Differences are subtle rather than significant
+
+      INTEGER             :: MAXK, MAXCON, NKVAL, ICON, IC, IK
+! ***
+      PARAMETER(MAXK=4,MAXCON=3)
+      REAL(wp), DIMENSION(MAXK)        :: A, B, C
+      REAL(wp), DIMENSION(MAXK,MAXCON) :: A0, A1, A2
+      REAL(wp), DIMENSION(MAXK,MAXCON) :: B0, B1, B2
+      REAL(wp), DIMENSION(NKVAL)       :: AKVAL
+!     AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+!     REAL(wp)            :: P,T,S,VAL,TK
+      REAL(wp)            :: P,T,S,VAL,TK, delta, kappa, Rgas
+      REAL(wp)            :: dlogTK, S2, sqrtS, S15, k1, k2, kb
+! ***
+!     AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+      DATA Rgas/83.131/
+
+      DATA A/-167.8108D0, 290.9097D0, 207.6548D0, 148.0248D0/
+      DATA B/9345.17D0, -14554.21D0, -11843.79D0, -8966.9D0/
+      DATA C/23.3585D0, -45.0575D0, -33.6485D0, -24.4344D0/
+      DATA (A0(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A0(2,ICON),ICON=1,MAXCON) /0.0221D0, 0.5709D0, -45.8076D0/
+      DATA (A0(3,ICON),ICON=1,MAXCON) /0.9805D0, 1.4853D0, -39.5492D0/
+      DATA (A0(4,ICON),ICON=1,MAXCON) /0.0473D0, 0.5998D0, 0.5998D0/
+      DATA (A1(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A1(2,ICON),ICON=1,MAXCON) /34.02D0, -84.25D0, 1935.07D0/
+      DATA (A1(3,ICON),ICON=1,MAXCON) /-92.65D0, -192.69D0, 1590.14D0/
+      DATA (A1(4,ICON),ICON=1,MAXCON) /49.10D0, -75.25D0, -75.25D0/
+      DATA (A2(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A2(2,ICON),ICON=1,MAXCON) /2*0.0D0,6.9513D0/
+      DATA (A2(3,ICON),ICON=1,MAXCON) /2*0.0D0,6.1523D0/
+      DATA (A2(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B0(1,ICON),ICON=1,MAXCON) /3*0.023517D0/
+      DATA (B0(2,ICON),ICON=1,MAXCON) /0.0D0,-0.01632D0,-0.01566D0/
+      DATA (B0(3,ICON),ICON=1,MAXCON) /-0.03294D0,-0.05058D0,-0.04997D0/
+      DATA (B0(4,ICON),ICON=1,MAXCON) /0.0D0, -0.01767D0, -0.01767D0/
+      DATA (B1(1,ICON),ICON=1,MAXCON) /3*-2.3656D-4/
+      DATA (B1(2,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B1(3,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B1(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(1,ICON),ICON=1,MAXCON) /3*4.7036D-7/
+      DATA (B2(2,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(3,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+
+      TK=T+273.15D0
+      DO 100 IK=1,NKVAL
+        VAL=A(IK) + B(IK)/TK + C(IK)*LOG(TK)
+        VAL=VAL + (A0(IK,IC) + A1(IK,IC)/TK + A2(IK,IC)*LOG(TK))*SQRT(S)
+        VAL=VAL + (B0(IK,IC) + B1(IK,IC)*TK + B2(IK,IC)*TK*TK)*S
+        AKVAL(IK)=EXP(VAL)
+100    CONTINUE
+
+      IF (IC .EQ. 3) THEN
+!  Calculation of constants as used in the OCMIP process for ICONST = 3 or 6
+!  see http://www.ipsl.jussieu.fr/OCMIP/
+!  added jcb 17/02/10
+
+!  Derive simple terms used more than once
+	dlogTK = log(TK)
+	S2 = S*S
+	sqrtS = sqrt(S)
+	S15 = S**1.5
+! k1 = [H][HCO3]/[H2CO3]
+! k2 = [H][CO3]/[HCO3]
+! Millero p.664 (1995) using Mehrbach et al. data on seawater scale 
+	k1=10**(-1*(3670.7/TK - 62.008 + 9.7944*dlogTK - &
+     &		0.0118 * S + 0.000116*S2))
+	k2=10**(-1*(1394.7/TK + 4.777 - &
+     &		0.0184*S + 0.000118*S2))
+! AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+! Correction for high pressure (from Millero 1995)
+! added YA 04/10/2010
+        delta=-25.5+0.1271*T
+        kappa=(-3.08+0.0877*T)/1000.0
+        k1=k1*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+        delta=-15.82-0.0219*T
+        kappa=(1.13-0.1475*T)/1000.0
+        k2=k2*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+
+! kb = [H][BO2]/[HBO2]
+! Millero p.669 (1995) using data from Dickson (1990)
+	kb=exp((-8966.90 - 2890.53*sqrtS - 77.942*S + &
+     &		1.728*S15 - 0.0996*S2)/TK + &
+     &		(148.0248 + 137.1942*sqrtS + 1.62142*S) + &
+     &		(-24.4344 - 25.085*sqrtS - 0.2474*S) * &
+     &		dlogTK + 0.053105*sqrtS*TK)
+! AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+! Correction for high pressure (from Millero, 1995)
+! added YA 04/10/2010
+        delta=-29.48+0.1622*T-0.002608*T**2.0
+        kappa=-2.84/1000.0
+        kb=kb*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+! Correction for high pressure of Kw (from Millero 1995)
+! added YA 04/10/2010
+        delta=-25.60+0.2324*T-0.0036246*T**2
+        kappa=(-5.13+0.0794*T)/1000.0
+        AKVAL(1)=AKVAL(1)*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+
+! replace haltafall calculations with OCMIP calculations
+      AKVAL(2) = k1
+      AKVAL(3) = k2
+      AKVAL(4) = kb
+      END IF ! section implimenting OCMIP coefficients
+
+      RETURN
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2CLC(CONCS,NCONC,AKVAL,NKVAL,ICALC,BORON,BTOT,iters)
+!      
+!=======================================================================
+! 
+! ROUTINE TO CARRY OUT CO2 CALCULATIONS WITH 2 FIXED PARAMETERS ACCORDI
+! THE EQUATIONS GIVEN BY PARKS(1969) AND SKIRROW (1975)
+! WITH ADDITIONS FOR INCLUDING BORON IF BORON=.TRUE.
+
+
+!      IMPLICIT real*8 (A-H,O-Z)
+      INTEGER             :: NCONC, NKVAL, ICALC, II, KARL, LQ, iters
+! AXY (07/05/13) ==================================================
+! put counter in to check duration in convergence loop
+      INTEGER             :: COUNTER,C_CHECK,C_SW,III
+! AXY (07/05/13) ==================================================
+      REAL(wp)            :: CTOT,ALK,PCO2,PH,H2CO3,HCO3,CO3,ALKC
+      REAL(wp)            :: ALKB,AKP,AK1C,AK2C,AKB,BTOT
+      REAL(wp)            :: AKR,AHPLUS
+      REAL(wp)            :: PROD,tol1,tol2,tol3,tol4,steg,fak
+      REAL(wp)            :: STEGBY,Y,X,W,X1,Y1,X2,Y2,FACTOR,TERM,Z
+      REAL(wp), DIMENSION(NCONC) :: CONCS
+      REAL(wp), DIMENSION(NKVAL) :: AKVAL
+      REAL(wp), DIMENSION(9)     :: CONCS2
+      REAL(wp), DIMENSION(4)     :: AKVAL2
+
+! AXY (07/05/13) ==================================================
+! setup array to store old values of concs
+      real(wp),DIMENSION(:) :: old_CONCS(NCONC)
+! AXY (07/05/13) ==================================================
+
+      EQUIVALENCE (CTOT  , CONCS2(1)), (ALK   , CONCS2(2)),  &
+     &            (PCO2  , CONCS2(3)), (PH    , CONCS2(4)),  &
+     &            (H2CO3 , CONCS2(5)), (HCO3  , CONCS2(6)),  &
+     &            (CO3   , CONCS2(7)), (ALKC  , CONCS2(8)),  &
+     &            (ALKB  , CONCS2(9)),                       &
+     &            (AKP   , AKVAL2(1)), (AK1C  , AKVAL2(2)),  &
+     &            (AK2C  , AKVAL2(3)), (AKB   , AKVAL2(4))
+      LOGICAL             :: BORON,DONE
+
+! AXY (07/05/13) ==================================================
+!  DERIVING PH REQUIRES FOLLOWING LOOP TO CONVERGE.
+!  THIS SUBROUTINE RELIES ON CONVERGENCE.  IF THE ENVIRONMENTAL
+!  CONDITIONS DO NOT ALLOW FOR CONVERGENCE (IN 3D MODEL THIS IS
+!  LIKELY TO OCCUR NEAR LOW SALINITY REGIONS) THE MODEL WILL 
+!  BE STUCK IN THE LOOP.  TO AVOID THIS A CONVERGENCE CONDITION
+!  IS PUT IN PLACE TO SET A FLAGG OF -99 IN THE PH VAR FOR NON CONVEGENCE. 
+!  THE MODEL IS THEN ALLOWED TO CONTINUE. 'COUNTER, C_SW,C_CHECK' ARE 
+!  THE LOCAL VARS USED.
+! C_SW = condition of convergence 0=yes, 1= no
+! COUNTER = number of iterations
+! C_CHECK = maximum number of iterations
+
+! SET COUNTER AND SWITCH TO ZERO AND OFF
+      COUNTER=0
+      C_SW=0
+! FROM EXPERIENCE IF THE ITERATIONS IN THE FOLLOWING DO LOOP
+! EXCEEDS 15 CONVERGENCE WILL NOT OCCUR.  THE OVERHEAD OF 25 ITERATIONS 
+! IS OK FOR SMALL DOMAINS WITH 1/10 AND 1/15 DEG RESOLUTION.
+! I RECOMMEND A LOWER VALUE OF 15 FOR HIGHER RESOLUTION OR LARGER DOMAINS.
+      C_CHECK=25
+! AXY (07/05/13) ==================================================
+
+      DO 100 II=1,NCONC
+        CONCS2(II)=CONCS(II)
+
+! AXY (07/05/13) ==================================================
+! IF CONVERGENCE IS NOT ACHIEVED THE LOCAL ARRAY CONCS MUST BE STORED TO 
+! ALLOW THE MODEL TO CONTINUE. THEREFORE ....
+! UPDATE OLD_CONCS
+        old_CONCS(II)=CONCS(II)
+! AXY (07/05/13) ==================================================
+
+100    CONTINUE
+      DO 110 II=1,NKVAL
+        AKVAL2(II)=AKVAL(II)
+110    CONTINUE
+      AKR = AK1C/AK2C
+      AHPLUS=10.0D0**(-PH)
+      PROD=AKR*AKP*PCO2
+     
+      IF(BORON) THEN
+
+        IF(ICALC.EQ.1.OR.ICALC.EQ.4) THEN
+!         *** ALK, BTOT AND CTOT OR PCO2 FIXED ***
+!         *** ITERATIVE CALCULATION NECESSARY HERE
+
+!         SET INITIAL GUESSES AND TOLERANCE
+          H2CO3=PCO2*AKP
+          CO3=ALK/10.0D0
+          AHPLUS=1.0D-8
+          ALKB=BTOT
+          TOL1=ALK/1.0D5
+          TOL2=H2CO3/1.0D5
+          TOL3=CTOT/1.0D5
+          TOL4=BTOT/1.0D5
+
+!         HALTAFALL iteration to determine CO3, ALKB, AHPLUS
+          KARL=1
+          STEG=2.0D0
+          FAK=1.0D0
+          STEGBY=0.4D0
+10        DONE=.TRUE.
+
+! AXY (07/05/13) ==================================================
+! SET COUNTER UPDATE. FLAG 10 IS THE POINT OF RETURN FOR 
+! THE CONVERGENCE CONDITION
+          COUNTER=COUNTER+1
+	  iters  = COUNTER
+! CHECK IF CONVERGENCE HAS OCCURED IN THE NUMBER OF 
+! ACCEPTABLE ITTERATIONS.  SET C_SW TO LET MODEL KNOW
+! WHAT TO DO AT THE END OF THE SUBROUTINE
+          if(counter.ge.c_check)then
+             IF(lwp) THEN
+                WRITE(numout,*) ' CO2CLC : ITERS WARNING, ', iters
+             ENDIF
+             c_sw=1
+             GOTO 123
+          endif
+! AXY (07/05/13) ==================================================
+
+          IF(ICALC.EQ.4) THEN
+!         *** PCO2 IS FIXED ***
+            Y=AHPLUS*AHPLUS*CO3/(AK1C*AK2C)
+            IF(ABS(Y-H2CO3).GT.TOL2) THEN
+              CO3=CO3*H2CO3/Y
+              DONE=.FALSE.
+            ENDIF
+          ELSEIF(ICALC.EQ.1) THEN
+!           *** CTOT IS FIXED ***
+            Y=CO3*(1.0D0+AHPLUS/AK2C+AHPLUS*AHPLUS/(AK1C*AK2C))
+            IF(ABS(Y-CTOT).GT.TOL3) THEN
+              CO3=CO3*CTOT/Y
+              DONE=.FALSE.
+            ENDIF
+          ENDIF
+          Y=ALKB*(1.0D0+AHPLUS/AKB)
+          IF(ABS(Y-BTOT).GT.TOL4) THEN
+            ALKB=ALKB*BTOT/Y
+            DONE=.FALSE.
+          ENDIF
+
+! Alkalinity is equivalent to -(total H+), so the sign of W is opposite
+! to that normally used
+
+          Y=CO3*(2.0D0+AHPLUS/AK2C)+ALKB
+          IF(ABS(Y-ALK).GT.TOL1) THEN
+            DONE=.FALSE.
+            X=LOG(AHPLUS)
+!           W=SIGN(1.0D0,Y-ALK)
+            IF ( Y-ALK .GE. 0.0D0 ) THEN
+            W=1.0D0
+            ELSE
+            W=-1.0D0
+            ENDIF
+            IF(W.GE.0.0D0) THEN
+              X1=X
+              Y1=Y
+            ELSE
+              X2=X
+              Y2=Y
+            ENDIF
+            LQ=KARL
+            IF(LQ.EQ.1) THEN
+              KARL=2*NINT(W)
+            ELSEIF(IABS(LQ).EQ.2.AND.(LQ*W).LT.0.) THEN
+              FAK=0.5D0
+              KARL=3
+            ENDIF
+            IF(KARL.EQ.3.AND.STEG.LT.STEGBY) THEN
+              W=(X2-X1)/(Y2-Y1)
+              X=X1+W*(ALK-Y1)
+            ELSE
+              STEG=STEG*FAK
+              X=X+STEG*W
+            ENDIF
+            AHPLUS=EXP(X)  
+          ENDIF
+          IF(.NOT.DONE) GOTO 10
+          
+          HCO3=CO3*AHPLUS/AK2C
+          IF(ICALC.EQ.4) THEN
+            CTOT=H2CO3+HCO3+CO3
+          ELSEIF(ICALC.EQ.1) THEN
+            H2CO3=HCO3*AHPLUS/AK1C
+            PCO2=H2CO3/AKP
+          ENDIF
+          PH=-LOG10(AHPLUS)
+          ALKC=ALK-ALKB
+        ELSEIF(ICALC.EQ.2) THEN
+!         *** CTOT, PCO2, AND BTOT FIXED ***
+          Y=SQRT(PROD*(PROD-4.0D0*AKP*PCO2+4.0D0*CTOT))
+          H2CO3=PCO2*AKP
+          HCO3=(Y-PROD)/2.0D0
+          CO3=CTOT-H2CO3-HCO3
+          ALKC=HCO3+2.0D0*CO3
+          AHPLUS=AK1C*H2CO3/HCO3
+          PH=-LOG10(AHPLUS)
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALK=ALKC+ALKB
+        ELSEIF(ICALC.EQ.3) THEN
+!         *** CTOT, PH AND BTOT FIXED ***
+          FACTOR=CTOT/(AHPLUS*AHPLUS+AK1C*AHPLUS+AK1C*AK2C)
+          CO3=FACTOR*AK1C*AK2C
+          HCO3=FACTOR*AK1C*AHPLUS
+          H2CO3=FACTOR*AHPLUS*AHPLUS
+          PCO2=H2CO3/AKP
+          ALKC=HCO3+2.0D0*CO3
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALK=ALKC+ALKB
+        ELSEIF(ICALC.EQ.5) THEN
+!         *** ALK, PH AND BTOT FIXED ***
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALKC=ALK-ALKB
+          HCO3=ALKC/(1.0D0+2.0D0*AK2C/AHPLUS)
+          CO3=HCO3*AK2C/AHPLUS
+          H2CO3=HCO3*AHPLUS/AK1C
+          PCO2=H2CO3/AKP
+          CTOT=H2CO3+HCO3+CO3
+        ELSEIF(ICALC.EQ.6) THEN
+!         *** PCO2, PH AND BTOT FIXED ***
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          H2CO3=PCO2*AKP
+          HCO3=H2CO3*AK1C/AHPLUS
+          CO3=HCO3*AK2C/AHPLUS
+          CTOT=H2CO3+HCO3+CO3
+          ALKC=HCO3+2.0D0*CO3
+          ALK=ALKC+ALKB
+        ENDIF
+      ELSE
+        IF(ICALC.EQ.1) THEN
+!         *** CTOT AND ALK FIXED ***
+          TERM=4.0D0*ALK+CTOT*AKR-ALK*AKR
+          Z=SQRT(TERM*TERM+4.0D0*(AKR-4.0D0)*ALK*ALK)
+          CO3=(ALK*AKR-CTOT*AKR-4.0D0*ALK+Z)/(2.0D0*(AKR-4.0D0))
+          HCO3=(CTOT*AKR-Z)/(AKR-4.0D0)
+          H2CO3=CTOT-ALK+CO3
+          PCO2=H2CO3/AKP
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.2) THEN
+!         *** CTOT AND PCO2 FIXED ***
+          Y=SQRT(PROD*(PROD-4.0D0*AKP*PCO2+4.0D0*CTOT))
+          H2CO3=PCO2*AKP
+          HCO3=(Y-PROD)/2.0D0
+          CO3=CTOT-H2CO3-HCO3
+          ALK=HCO3+2.0D0*CO3
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.3) THEN
+!         *** CTOT AND PH FIXED ***
+          FACTOR=CTOT/(AHPLUS*AHPLUS+AK1C*AHPLUS+AK1C*AK2C)
+          CO3=FACTOR*AK1C*AK2C
+          HCO3=FACTOR*AK1C*AHPLUS
+          H2CO3=FACTOR*AHPLUS*AHPLUS
+          PCO2=H2CO3/AKP
+          ALK=HCO3+2.0D0*CO3
+        ELSEIF(ICALC.EQ.4) THEN
+!         *** ALK AND PCO2 FIXED ***
+          TERM=SQRT((8.0D0*ALK+PROD)*PROD)
+          CO3=ALK/2.0D0+PROD/8.0D0-TERM/8.0D0
+          HCO3=-PROD/4.0D0+TERM/4.0D0
+          H2CO3=PCO2*AKP
+          CTOT=CO3+HCO3+H2CO3
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.5) THEN
+!         *** ALK AND PH FIXED ***
+          HCO3=ALK/(1.0D0+2.0D0*AK2C/AHPLUS)
+          CO3=HCO3*AK2C/AHPLUS
+          H2CO3=HCO3*AHPLUS/AK1C
+          PCO2=H2CO3/AKP
+          CTOT=H2CO3+HCO3+CO3
+        ELSEIF(ICALC.EQ.6) THEN
+!         *** PCO2 AND PH FIXED ***
+          H2CO3=PCO2*AKP
+          HCO3=H2CO3*AK1C/AHPLUS
+          CO3=HCO3*AK2C/AHPLUS
+          CTOT=H2CO3+HCO3+CO3
+          ALK=HCO3+2.0D0*CO3
+        ENDIF
+      ENDIF
+
+      DO 120 II=1,NCONC
+        CONCS(II)=CONCS2(II)
+120    CONTINUE
+
+! AXY (07/05/13) ==================================================
+! C_SW IS SET AT 0 TO START
+! THEN IF NON CONVERGENCE C_SW SET TO 1
+123   IF(C_SW.EQ.1)THEN
+! IF NON CONVERGENCE, THE MODEL REQUIRES CONCS TO CONTAIN USABLE VALUES.
+! BEST OFFER BEING THE OLD CONCS VALUES WHEN CONVERGENCE HAS BEEN 
+! ACHIEVED
+        DO II=1,NCONC
+           CONCS(II)=OLD_CONCS(II)
+        END DO
+
+! SPECIFIC CARBONATE VALUES TO PUSH CODE ON THROUGH THE
+! NON CONVERGENCE CONDITIONS
+! PCO2W = 0 SO CO2 UPTAKE WILL BE ENCOURAGED
+!       CONCS(3)=O3C(III)*0.005_fp8/1.e6_fp8
+! -99 IS A FLAG TO SHOW WHEN AND WHERE NON CONVERGENCE OCCURED
+! CONCS(4)=PH, OUTPUT OF -99 MEANS NON-CONVERGENCE
+!       CONCS(4)=-99._fp8
+! 
+! AXY (10/05/13): remove this -99 flag; this is handled instead up in
+!                 trcbio_medusa.F90 where the iters variable is both 
+!                 output and may be used to trigger action
+!
+! RESET SWITCH FOR NEXT CALL TO THIS SUBROUTINE
+        C_SW=0
+      ENDIF
+! AXY (07/05/13) ==================================================
+
+
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CaCO3_Saturation (Tc, S, D, CO3, &
+      Om_cal, Om_arg)
+!      
+!=======================================================================
+!
+! Routine to calculate the saturation state of calcite and aragonite    
+! Inputs:                                                               
+!               Tc      Temperature (C)                                 
+!               S       Salinity                                        
+!               D       Depth (m)                                       
+!               CO3     Carbonate ion concentration (mol.kg-1 ie /1D6)
+!                                                                       
+! Outputs                                                               
+!               Om_cal  Calite saturation                               
+!               Om_arg  Aragonite saturation                            
+!                                                                       
+! Intermediates                                                         
+!               K_cal   Stoichiometric solubility product for calcite   
+!               K_arg   Stoichiometric solubility product for aragonite 
+!               Ca      Calcium 2+ concentration (mol.kg-1) 
+!               P       Pressure (bars)
+!                                                                       
+! Source                                                                
+!       Zeebe & Wolf-Gladrow 2001 following Mucci (1983)                
+!       with pressure corrections from Millero (1995)                   
+!       Code tested against reference values given in Z & W-G
+!       Built Jerry Blackford, 2008
+!=======================================================================
+
+        IMPLICIT None
+        REAL(wp), INTENT( in )    :: Tc, S, D, CO3
+        REAL(wp), INTENT( inout ) :: Om_cal, Om_arg
+        REAL(wp) :: Tk, Kelvin, Ca
+        REAL(wp) :: logKspc, Kspc
+        REAL(wp) :: logKspa, Kspa
+        REAL(wp) :: tmp1, tmp2, tmp3
+        REAL(wp) :: dV, dK, P, R
+               
+! setup
+        Kelvin = 273.15
+        Tk = Tc + Kelvin 
+        Ca = 0.01028    ! Currently oceanic mean value at S=25, needs refining)
+        Ca = 0.010279 * (S / 35.0)  ! Ca varies with salinity (cf. Feeley et al., 2004; Yool et al., 2010)
+        R = 83.131      !(cm3.bar.mol-1.K-1)
+        P = D / 10.0    !pressure in bars
+
+! calculate K for calcite
+        tmp1 = -171.9065 - (0.077993*Tk) + (2839.319/Tk) + 71.595*log10(Tk) 
+        tmp2 = + (-0.77712 + (0.0028426*Tk) + (178.34/Tk))*SQRT(S) 
+        tmp3 = - (0.07711*S) + (0.0041249*(S**1.5))
+        logKspc = tmp1 + tmp2 + tmp3
+        Kspc = 10.0**logKspc
+      
+! correction for pressure for calcite
+        IF ( D .GT. 0) THEN
+          dV = -48.76 + 0.5304*Tc
+          dK = -11.76/1.0D3 + (0.3692/1.0D3) * Tc
+          tmp1 = -(dV/(R*Tk))*P + (0.5*dK/(R*Tk))*P*P
+          Kspc = Kspc*exp(tmp1)
+          logKspc = log10(Kspc)
+        END IF
+        
+! calculate K for aragonite
+        tmp1 = -171.945 - 0.077993*Tk + 2903.293 / Tk + 71.595* log10(Tk)
+        tmp2 = + (-0.068393 + 0.0017276*Tk + 88.135/Tk)*SQRT(S)    
+        tmp3 = - 0.10018*S + 0.0059415*S**1.5
+        logKspa = tmp1 + tmp2 + tmp3
+        Kspa = 10.0**logKspa
+     
+! correction for pressure for aragonite
+        IF ( D .GT. 0) THEN
+          dV = -46.00 + 0.5304*Tc
+          dK = -11.76/1.0D3 + (0.3692/1.0D3) * Tc
+          tmp1 = -(dV/(R*Tk))*P + (0.5*dK/(R*Tk))*P*P
+          Kspa = Kspa*exp(tmp1)
+          logKspa = log10(Kspa)
+        END IF
+        
+! calculate saturation states
+        Om_cal = (CO3 * Ca) / Kspc
+        Om_arg = (CO3 * Ca) / Kspa
+      
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#  else
+   !!======================================================================
+   !!  Dummy module :                         No MEDUSA carbonate chemistry
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE trc_co2_medusa( kt )                   ! Empty routine
+
+      INTEGER, INTENT( in ) ::   kt
+
+      WRITE(*,*) 'trc_co2_medusa: You should not have seen this print! error?', kt
+
+   END SUBROUTINE trc_co2_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcco2_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcctl_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcctl_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcctl_medusa.F90	(revision 9824)
@@ -0,0 +1,83 @@
+MODULE trcctl_medusa
+   !!======================================================================
+   !!                         ***  trcctl_medusa.F90  ***
+   !! TOP :                Control of MEDUSA_TRC biogeochemical model
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !! History :   1.0  !  2000-12 (C. Ethe) assign a parameter to name individual tracers
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!----------------------------------------------------------------------
+
+#if defined key_medusa
+
+   USE oce_trc
+   USE trc
+   USE in_out_manager
+   USE par_medusa
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_ctl_medusa     ! called by ???
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ctl_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_medusa  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'use MEDUSA biological model  '
+
+! Check number of tracers
+! -----------------------
+# if defined key_roam
+      IF (jp_medusa /= 15) THEN 
+          IF (lwp) THEN 
+              WRITE (numout,*) ' ===>>>> : W A R N I N G '
+              WRITE (numout,*) ' =======   ============= '
+              WRITE (numout,*)                             &
+              &   ' STOP, change jp_medusa to 15 in '      &
+              &  ,' par_medusa.F90 '  
+          END IF 
+          STOP 'TRC_CTL'
+      END IF 
+# else
+      IF (jp_medusa /= 11) THEN 
+          IF (lwp) THEN 
+              WRITE (numout,*) ' ===>>>> : W A R N I N G '
+              WRITE (numout,*) ' =======   ============= '
+              WRITE (numout,*)                             &
+              &   ' STOP, change jp_medusa to 11 in '      &
+              &  ,' par_medusa.F90 '  
+          END IF 
+          STOP 'TRC_CTL'
+      END IF 
+# endif
+
+   END SUBROUTINE trc_ctl_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                            No MEDUSA
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ctl_medusa               ! Dummy routine
+   END SUBROUTINE trc_ctl_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcctl_medusa
+      
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcdms_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcdms_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcdms_medusa.F90	(revision 9824)
@@ -0,0 +1,203 @@
+MODULE trcdms_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcdms_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2014-08  (J. Palmieri - A. Yool)    added for UKESM1 project
+   !!  -   !  2017-05  (A. Yool)                  add extra Anderson scheme
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA DMS surface concentration
+   !!----------------------------------------------------------------------
+   !!   trc_dms_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_dms_medusa    ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_dms_medusa( chn, chd, mld, xqsr, xdin, xlim,  &  !! inputs
+     &  dms_andr, dms_simo, dms_aran, dms_hall, dms_andm)           !! outputs
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates DMS ocean surface concentration
+      !! Author : Julien Palmieri and Andrew Yool
+      !! Date   : 08/08/14 
+      !!
+      !! DMS module is called in trc_bio's huge jk,jj,ji loop
+      !! --> DMS concentration is calculated in a specific cell 
+      !! (no need of ji,jj,jk)
+      !!
+      !! AXY (13/03/15): amend to include all four schemes tested
+      !!                 during winter/spring 2015; these are:
+      !!
+      !!                 1. Anderson et al. (2001); this uses fields
+      !!                    of surface chl, irradiance and nutrients
+      !!                    to empirically estimate DMS via a broken
+      !!                    stick approach
+      !!
+      !!                 2. Simo & Dachs (2002); this uses fields of
+      !!                    surface chl and mixed layer depth
+      !!
+      !!                 3. Aranami & Tsunogai (2004); this is an
+      !!                    embellishment of Simo & Dachs
+      !!
+      !!                 4. Halloran et al. (2010); this is an
+      !!                    alternative embellishment of Sim & Dachs
+      !!                    and is included because it is formally
+      !!                    published (and different from the above)
+      !!
+      !! AXY (25/05/17): add extra "corrected" Anderson scheme
+      !!
+      !!                 5. As Anderson et al. (2001) but modified to
+      !!                    more accurately reflect nutrient limitation
+      !!                    status of phytoplankton community
+      !!
+      !! 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
+      !!
+!=======================================================================
+
+      IMPLICIT NONE
+!
+      REAL(wp), INTENT( in )    :: chn                  !! non-diatom chlorophyll    (mg/m3)
+      REAL(wp), INTENT( in )    :: chd                  !! diatom chlorophyll        (mg/m3)
+      REAL(wp), INTENT( in )    :: mld                  !! mix layer depth           (m)
+      REAL(wp), INTENT( in )    :: xqsr                 !! surface irradiance        (W/m2)
+      REAL(wp), INTENT( in )    :: xdin                 !! surface DIN               (mmol N/m3)
+      REAL(wp), INTENT( in )    :: xlim                 !! surface DIN limitation    (mmol N/m3)
+      REAL(wp), INTENT( inout ) :: dms_andr             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_simo             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_aran             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_hall             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_andm             !! DMS surface concentration (nmol/L) 
+!
+      REAL(wp) :: CHL, cmr, sw_dms
+      REAL(wp) :: Jterm, Qterm
+      !! temporary variables
+      REAL(wp) ::    fq1,fq2,fq3
+! 
+!=======================================================================
+!
+! 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)
+!! JPALM --19-12-2017-- Tunable through the namelist
+!!                      within dmsmin - dmscut - dmsslp
+        Jterm = xqsr + 1.0e-6
+        !! this next line makes a hard-coded assumption about the 
+        !! half-saturation constant of MEDUSA (which should be
+        !! done properly; perhaps even scaled with the proportion
+        !! of diatoms and non-diatoms)
+        Qterm = xdin / (xdin + 0.5)
+        fq1 = log10(CHL * Jterm * Qterm)
+        if (fq1 > dmscut) then
+           dms_andr = (dmsslp * (fq1 - dmscut)) + dmsmin
+        else
+           dms_andr = dmsmin
+        endif
+!
+! AXY (13/03/15): Simo & Dachs (2002)
+        fq1 = (-1.0 * log(mld)) + 5.7
+        fq2 = (55.8 * cmr) + 0.6
+        if (cmr < 0.02) then
+           dms_simo = fq1
+        else
+           dms_simo = fq2
+        endif
+!           
+! AXY (13/03/15): Aranami & Tsunogai (2004)
+        fq1 = 60.0 / mld
+        fq2 = (55.8 * cmr) + 0.6
+        if (cmr < 0.02) then
+           dms_aran = fq1
+        else
+           dms_aran = fq2
+        endif
+!        
+! AXY (13/03/15): Halloran et al. (2010)
+        fq1 = (-1.0 * log(mld)) + 5.7
+        fq2 = (55.8 * cmr) + 0.6
+        fq3 = (90.0 / mld)
+        if (cmr < 0.02) then
+           dms_hall = fq1
+        else
+           dms_hall = fq2
+        endif
+        if (mld > 182.5) then
+           dms_hall = fq3
+        endif
+!
+! AXY (25/05/17): modified Anderson et al. (2001)
+        Jterm = xqsr + 1.0e-6
+        !! this version fixes the hard-coded assumption above
+        Qterm = xlim
+        fq1 = log10(CHL * Jterm * Qterm)
+        if (fq1 > 1.72) then
+           dms_andm = (8.24 * (fq1 - 1.72)) + 2.29
+        else
+           dms_andm = 2.29
+        endif
+
+  END SUBROUTINE trc_dms_medusa
+
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_dms_medusa( kt )                                        !! EMPTY Routine
+!      
+!
+      INTEGER, INTENT( in ) ::   kt
+!
+
+      WRITE(*,*) 'trc_dms_medusa: You should not have seen this print! error?'
+
+   END SUBROUTINE trc_dms_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcdms_medusa
+
+
+
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcini_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcini_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcini_medusa.F90	(revision 9824)
@@ -0,0 +1,586 @@
+MODULE trcini_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcini_medusa  ***
+   !! TOP :   initialisation of the MEDUSA tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                         MEDUSA tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_medusa   : MEDUSA model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE in_out_manager
+   !! AXY (04/11/13): add this in for initialisation stuff
+   USE iom
+   USE par_medusa
+   !! AXY (13/01/12): add this in for sediment variables
+   USE sms_medusa
+   !! AXY (04/11/13): add this in for initialisation stuff
+   USE trcsed_medusa
+   USE sbc_oce, ONLY: lk_oasis
+   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_medusa   ! called by trcini.F90 module
+
+   !! AXY (25/02/10)
+   LOGICAL, PUBLIC ::                  &
+      bocalccd = .TRUE.
+   !! JPALM (14/09/15)
+   LOGICAL, PUBLIC ::                  &
+      ln_ccd = .TRUE.
+
+   INTEGER ::                          &
+      numccd
+
+   !! AXY (25/02/10)
+   INTEGER ::                          &
+      numriv
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ini_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_medusa  ***  
+      !!
+      !! ** Purpose :   initialization for MEDUSA model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      !! vertical array index
+      INTEGER  ::    jk, ierr
+      !! AXY (19/07/12): added jk2 to set up friver_dep array
+      INTEGER            :: jk2
+      !! AXY (19/07/12): added tfthk to set up friver_dep array
+      REAL(wp)           :: fthk, tfthk
+      !! AXY (04/11/13): add in temporary variables for checks
+      REAL(wp)           :: fq0, fq1, fq2
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisation of MEDUSA model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+# if defined key_debug_medusa
+            CALL flush(numout)
+# endif
+
+                                           ! Allocate MEDUSA arrays
+      ierr =         sms_medusa_alloc()
+# if defined key_debug_medusa
+            IF (lwp) write (numout,*) '------------------------------'
+            IF (lwp) write (numout,*) 'Jpalm - debug'
+            IF (lwp) write (numout,*) 'in trc_ini_medusa, just after array allocate'
+            IF (lwp) write (numout,*) ' '
+            CALL flush(numout)
+# endif
+
+!!
+!! AXY (19/07/12): setup array to control distribution of river nutrients
+      friver_dep(:,:) = 0.
+      DO jk = 1,jpk
+         tfthk = 0.
+         DO jk2 = 1,jriver_dep
+            fthk  = e3t_1d(jk2)
+            if (jk2 .le. jk) then
+               tfthk = tfthk + fthk
+               friver_dep(jk2,jk) = fthk
+            endif
+         ENDDO
+         DO jk2 = 1,jriver_dep
+            friver_dep(jk2,jk) = friver_dep(jk2,jk) / tfthk
+         ENDDO
+      ENDDO
+!!
+!! Have a look at the result of this for a single depth (jriver_dep + 1)
+      IF(lwp) THEN
+          WRITE(numout,*) '=== River nutrient fraction by depth (for a water column of jpk depth)'
+          DO jk = 1,jpk
+             WRITE(numout,*)     &
+             &   ' cell = ', jk, ', friver_dep value = ', friver_dep(jk,jpk)
+          ENDDO
+          IF(lwp) CALL flush(numout)
+       ENDIF
+
+#if defined key_roam
+!! ROAM 3D and 2D carbonate system fields (calculated on first time
+!! step, then monthly)
+      f3_pH(:,:,:)    = 0.
+      f3_h2co3(:,:,:) = 0.
+      f3_hco3(:,:,:)  = 0.
+      f3_co3(:,:,:)   = 0.
+      f3_omcal(:,:,:) = 0.
+      f3_omarg(:,:,:) = 0.
+!!
+      f2_ccd_cal(:,:) = 0.
+      f2_ccd_arg(:,:) = 0.
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: carbonate fields initialised to zero'
+#endif
+      IF(lwp) CALL flush(numout)
+
+      !!----------------------------------------------------------------------
+      !! State variable initial conditions (all mmol / m3)
+      !!----------------------------------------------------------------------
+      !!     
+      !! biological and detrital components are initialised to nominal
+      !! values above 100 m depth and zero below; the latter condition
+      !! is applied since non-linear loss processes allow significant
+      !! concentrations of these components to persist at depth
+      !!
+      trn(:,:,:,jpchn) = 0.
+      trn(:,:,:,jpchd) = 0.
+      trn(:,:,:,jpphn) = 0.
+      trn(:,:,:,jpphd) = 0.
+      trn(:,:,:,jppds) = 0.
+      trn(:,:,:,jpzmi) = 0.
+      trn(:,:,:,jpzme) = 0.
+      trn(:,:,:,jpdet) = 0.
+      !!
+      DO jk = 1,13
+         !! non-diatom chlorophyll         (nominal)
+         trn(:,:,jk,jpchn) = 0.01
+         !!
+         !! diatom chlorophyll             (nominal)
+         trn(:,:,jk,jpchd) = 0.01
+         !!
+         !! non-diatom                     (nominal)
+         trn(:,:,jk,jpphn) = 0.01
+         !!
+         !! diatom                         (nominal)
+         trn(:,:,jk,jpphd) = 0.01
+         !!
+         !! diatom silicon                 (nominal)
+         trn(:,:,jk,jppds) = 0.01
+         !!
+         !! microzooplankton               (nominal)
+         trn(:,:,jk,jpzmi) = 0.01
+         !!
+         !! mesozooplankton                (nominal)
+         trn(:,:,jk,jpzme) = 0.01
+         !!
+         !! detrital nitrogen              (nominal)
+         trn(:,:,jk,jpdet) = 0.01
+      ENDDO
+      !!
+      !! dissolved inorganic nitrogen     (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpdin) = 30.
+      !!
+      !! dissolved silicic acid           (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpsil) = 90.
+      !!
+      !! dissolved "total" iron           (nominal; typically initialised from model-derived climatology)
+      trn(:,:,:,jpfer) = 1.0e-4           !! = 0.1 umol Fe / m3
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-1 fields initialised to defaults'
+# if defined key_roam
+      !!
+      !! detrital carbon                  (nominal)
+      trn(:,:,:,jpdtc) = 0.
+      DO jk = 1,13
+         trn(:,:,jk,jpdtc) = 0.06625
+      ENDDO
+      !!
+      !! dissolved inorganic carbon (DIC) (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpdic) = 2330.
+      !!
+      !! total alkalinity                 (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpalk) = 2450.
+      !!
+      !! dissolved oxygen                 (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpoxy) = 175.
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-2 fields initialised to defaults'
+# endif
+      IF(lwp) CALL flush(numout)
+
+      !!----------------------------------------------------------------------
+      !! Sediment pools initial conditions (all mmol / m2)
+      !!----------------------------------------------------------------------
+      !!     
+      !! these pools store biogenic material that has sunk to the seabed,
+      !! and act as a temporary reservoir
+      zb_sed_n(:,:)  = 0.0  !! organic N
+      zn_sed_n(:,:)  = 0.0
+      za_sed_n(:,:)  = 0.0
+      zb_sed_fe(:,:) = 0.0  !! organic Fe
+      zn_sed_fe(:,:) = 0.0
+      za_sed_fe(:,:) = 0.0
+      zb_sed_si(:,:) = 0.0  !! inorganic Si
+      zn_sed_si(:,:) = 0.0
+      za_sed_si(:,:) = 0.0
+      zb_sed_c(:,:)  = 0.0  !! organic C
+      zn_sed_c(:,:)  = 0.0
+      za_sed_c(:,:)  = 0.0
+      zb_sed_ca(:,:) = 0.0  !! inorganic C
+      zn_sed_ca(:,:) = 0.0
+      za_sed_ca(:,:) = 0.0
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: benthic fields initialised to zero'
+      IF(lwp) CALL flush(numout)
+     
+      !!----------------------------------------------------------------------
+      !! 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)
+      !!
+      !!---------------------------------------------------------------------
+      !!JPALM (14-06-2016): init dms and co2 flux for coupling with atm (UKESM)
+      !!---------------------------------------------------------------------
+      !!
+      zb_co2_flx(:,:)  = 0.0  !! CO2 flx
+      zn_co2_flx(:,:)  = 0.0
+      za_co2_flx(:,:)  = 0.0
+      zb_dms_srf(:,:)  = 0.0  !! DMS srf
+      zn_dms_srf(:,:)  = 0.0
+      za_dms_srf(:,:)  = 0.0
+      zn_chl_srf(:,:)  = 2.0E-8 !! Chl cpl - set first as surf
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: DMS and CO2 flux (UKESM) initialised to zero'
+      IF(lwp) CALL flush(numout)
+      IF (lk_oasis) THEN
+         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable
+         DMS_out_cpl(:,:)     =  zn_dms_srf(:,:)   !! Coupling variable
+         chloro_out_cpl(:,:)  =  zn_chl_srf(:,:) * scl_chl   !! Coupling variable
+      END IF
+      !!
+      !!----------------------------------------------------------------------
+      !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
+      !!----------------------------------------------------------------------
+      !!     
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising dust deposition fields'
+      CALL trc_sed_medusa_sbc( nit000 )
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising ocean CCD array'
+      CALL trc_ini_medusa_ccd( nit000 )
+      fq0 = MINVAL(ocal_ccd(:,:))
+      fq1 = MAXVAL(ocal_ccd(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'CCD: min ', fq0, ' max ', fq1
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising riverine nutrient arrays'
+      riv_n(:,:)   = 0.0
+      riv_si(:,:)  = 0.0
+      riv_c(:,:)   = 0.0
+      riv_alk(:,:) = 0.0 
+      !!
+      CALL trc_ini_medusa_river( nit000 )
+      fq0 = MINVAL(riv_n(:,:))
+      fq1 = MAXVAL(riv_n(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_N:   min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_si(:,:))
+      fq1 = MAXVAL(riv_si(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_SI:  min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_c(:,:))
+      fq1 = MAXVAL(riv_c(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_C:   min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_alk(:,:))
+      fq1 = MAXVAL(riv_alk(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_ALK: min ', fq0, ' max ', fq1
+      IF(lwp) CALL flush(numout)
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA initialised'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      IF(lwp) CALL flush(numout)
+      !!
+      !!----------------------------------------------------------------------
+      !! JPALM (23-01-2017): new way to initialize CO2-atm for cmip6 
+      !!                     initially done in trcsms_medusa
+      !!----------------------------------------------------------------------
+      !! 
+      IF( ( .NOT.lk_oasis ) .AND. ( .NOT.lk_pi_co2 ) ) THEN
+         IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisating atm CO2 record'
+         CALL trc_ini_medusa_co2atm
+      ENDIF
+
+   END SUBROUTINE trc_ini_medusa
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (25/02/10)
+   SUBROUTINE trc_ini_medusa_ccd(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ini_medusa_ccd  ***
+      !!
+      !! ** Purpose :   Read CCD field
+      !!
+      !! ** Method  :   Read the file
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !!---------------------------------------------------------------------
+
+      !! Open the file
+      !! -------------
+      !!
+      !!!! JPALM -- 14-09-2015 -- 
+      !!!!       -- to test on ORCA2 with Christian, no file available, so initiate to 0 
+      IF (ln_ccd) THEN
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
+         CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
+
+      !! Read the data
+      !! -------------
+      !!
+         CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read'
+
+      !! Close the file
+      !! --------------
+      !!
+         CALL iom_close ( numccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
+         IF(lwp) CALL flush(numout)
+      ELSE
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc'
+         IF(lwp) WRITE(numout,*) ' **** ln_ccd = FALSE and ocal_ccd = 0.0 ---'
+         ocal_ccd(:,:) = 0.0  
+      ENDIF
+ 
+   END SUBROUTINE trc_ini_medusa_ccd
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (26/01/12)
+   SUBROUTINE trc_ini_medusa_river(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ini_medusa_river  ***
+      !!
+      !! ** Purpose :   Read riverine nutrient fields
+      !!
+      !! ** Method  :   Read the file
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !!---------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' **** Routine trc_ini_medusa_river'
+         WRITE(numout,*) ' '
+      ENDIF
+
+      !! Open and read the files
+      !! -----------------------
+      !!
+      if (jriver_n.gt.0) then
+         if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
+         if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_N', riv_n )
+         IF(lwp) THEN
+            if (jriver_n.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: N CONC data read'
+            if (jriver_n.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: N FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river N file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: N data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_si.gt.0) then
+         if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
+         if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_SI', riv_si )
+         IF(lwp) THEN
+            if (jriver_si.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: Si CONC data read'
+            if (jriver_si.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: Si FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river Si file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: Si data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_c.gt.0) then
+         if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
+         if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_C', riv_c )
+         IF(lwp) THEN
+            if (jriver_c.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: C CONC data read'
+            if (jriver_c.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: C FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river C file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: C data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_alk.gt.0) then
+         if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
+         if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
+         IF(lwp) THEN
+            if (jriver_alk.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity CONC data read'
+            if (jriver_alk.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river alkalinity file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity data NOT read'
+         ENDIF
+      endif
+      IF(lwp) CALL flush(numout)
+
+   END SUBROUTINE trc_ini_medusa_river
+   
+   SUBROUTINE trc_ini_medusa_co2atm
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_medusa_co2atm  ***  
+      !!
+      !! ** Purpose :   initialization atmospheric co2 record
+      !!
+      !! ** Method  : - Read the xco2 file
+      !!----------------------------------------------------------------------
+      INTEGER                       ::  jn, jm, io, ierr, inum, iostatus
+      INTEGER, PARAMETER            ::  iskip = 4   ! number of 1st descriptor lines
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   zyy !: xCO2 record years
+      CHARACTER (len=10), PARAMETER ::  clname = 'xco2.atm'  !! atm CO2 record file
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa_co2atm: initialisation of atm CO2 historical record'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+
+      IF(lwp) WRITE(numout,*) 'read of formatted file xco2.atm'
+
+      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      !!!
+      ! -Compute the number of year in the file
+      ! -File starts in co2_yinit, jn represents the record number in the file.
+      ! -Remove the file head (iskip lines) to jn
+      ! -The year is jn + yinit - 1 
+      !! Determine the number of lines in xCO2 input file
+      iostatus = 0
+      jn = 1
+      DO WHILE ( iostatus == 0 )
+        READ(inum,'(1x)', IOSTAT=iostatus, END=100)
+        jn = jn + 1
+      ENDDO
+      IF( iostatus .NE. 0 ) THEN
+        !! Error while reading xCO2 input file 
+        CALL ctl_stop('trc_ini_medusa_co2atm: &
+                      & Error on the 1st reading of xco2.atm')
+        RETURN
+      ENDIF
+ 100  co2_rec = jn - 1 - iskip
+      IF ( lwp) WRITE(numout,*) '    ', co2_rec ,' years read in the file'
+      !                                ! Allocate CO2 hist arrays
+      ierr = 0 
+      ALLOCATE( hist_pco2(co2_rec),zyy(co2_rec), STAT=ierr )
+      IF( ierr > 0 ) THEN
+         CALL ctl_stop( 'trc_ini_medusa_co2atm: unable to allocate  array' )  
+         RETURN
+      ENDIF
+
+      REWIND(inum)
+
+      DO jm = 1, iskip        ! Skip over 1st six descriptor lines
+         READ(inum,'(1x)')
+      END DO
+      ! file starts in 1931 do jn represent the year in the century.jhh
+      ! Read file till the end
+      ! allocate start and end year of the file
+      DO jn = 1, co2_rec
+        READ(inum,'(F6.1,F12.7)', IOSTAT=io) zyy(jn), hist_pco2(jn)
+        IF( io .NE. 0 ) THEN
+          !! Error while reading xCO2 input file 
+          CALL ctl_stop('trc_ini_medusa_co2atm: &
+                        & Error on the 2nd reading of xco2.atm')
+          RETURN
+        ENDIF
+
+        IF(jn==1) co2_yinit = zyy(jn)
+      END DO
+      co2_yend = co2_yinit + real(co2_rec) - 1.
+
+      IF(lwp) THEN        ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'CO2 hist start year: ', co2_yinit
+         WRITE(numout,*) 'CO2 hist end   year: ', co2_yend
+         WRITE(numout,*) ' Year   xCO2 atm '
+         DO jn = 1, co2_rec
+            WRITE(numout, '(F6.1,F12.7)') zyy(jn), hist_pco2(jn)
+         END DO
+      ENDIF
+
+   END SUBROUTINE trc_ini_medusa_co2atm
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MEDUSA model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_medusa             ! Empty routine
+   END SUBROUTINE trc_ini_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcini_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcnam_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcnam_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcnam_medusa.F90	(revision 9824)
@@ -0,0 +1,2403 @@
+MODULE trcnam_medusa
+   !!======================================================================
+   !!                      ***  MODULE trcnam_medusa  ***
+   !! TOP :   initialisation of some run parameters for MEDUSA bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!              -   !  2013-05  (A. Yool) renamed (from trclsm) for v3.5
+   !!              -   !  2015-11  (J. Palmieri) added iom_use for diags
+   !!              -   !  2016-11  (A. Yool) updated diags for CMIP6
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'   :                                       MEDUSA model
+   !!----------------------------------------------------------------------
+   !! trc_nam_medusa      : MEDUSA model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE sms_medusa      ! sms trends
+   USE iom             ! I/O manager
+   USE sbc_oce, ONLY: lk_oasis
+   !!USE trc_nam_dia     ! JPALM 13-11-2015 -- if iom_use for diag
+
+   !! AXY (04/02/14): necessary to find NaNs on HECTOR
+   USE, INTRINSIC :: ieee_arithmetic 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_medusa       ! called by trcnam.F90 module
+   PUBLIC   trc_nam_iom_medusa   ! called by trcnam.F90 module
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_medusa  ***  
+      !!
+      !! ** Purpose :   read MEDUSA namelist
+      !!
+      !! ** input   :   file 'namelist.trc.sms' containing the following
+      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio")
+      !!
+      !! ekp: namelist nabio contains ALL parameters of the ecosystem 
+      !!      point sourses and sinks PLUS sediment exchange
+      !!      dia_bio - used by Lobster to output all point terms 
+      !!                (sourses and sinks of bio)
+      !!      dia_add - additional diagnostics for biology such as 
+      !!                primary production (2d depth integrated field or 3d)
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER            :: ji,jj,jk
+      REAL(wp)           :: fthk, fdep, fdep1
+      REAL(wp)           :: q1, q2, q3
+      !
+      NAMELIST/natbio/ xxi,xaln,xald,jphy,xvpn,xvpd,          &
+      &    xsin0,xnsi0,xuif,jliebig, jq10,                    &
+      &    xthetam,xthetamd,xnln,xnld,xsld,xfln,xfld,         &
+      &  xgmi,xgme,xkmi,xkme,xphi,xbetan,xbetac,xkc,          &
+      &    xpmipn,xpmid,xpmepn,xpmepd,xpmezmi,xpmed,          &
+      &  xmetapn,xmetapd,xmetazmi,xmetazme,                   &
+      &  jmpn,xmpn,xkphn,jmpd,xmpd,xkphd,jmzmi,xmzmi,xkzmi,   &
+      &    jmzme,xmzme,xkzme,jmd,jsfd,xmd,xmdc,               &
+      &  xthetapn,xthetapd,xthetazmi,xthetazme,xthetad,       &
+      &    xrfn,xrsn,vsed,xhr,                                &
+      &  jiron,xfe_mass,xfe_sol,xfe_sed,xLgT,xk_FeL,xk_sc_Fe, &
+      &  jexport,jfdfate,jrratio,jocalccd,xridg_r0,           &
+      &    xfdfrac1,xfdfrac2,xfdfrac3,                        &
+      &    xcaco3a,xcaco3b,xmassc,xmassca,xmasssi,xprotca,    &
+      &    xprotsi,xfastc,xfastca,xfastsi,                    &
+      &  jorgben,jinorgben,xsedn,xsedfe,xsedsi,xsedc,xsedca,  &
+      &    xburial,                                           &
+      &  jriver_n,jriver_si,jriver_c,jriver_alk,jriver_dep,   &
+      &  xsdiss,                                              &
+      &  sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model,   &
+      &  scl_chl, chl_out, dmsmin, dmscut, dmsslp
+#if defined key_roam
+      NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        &
+      &    xthetarem,xo2min 
+#endif
+      NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig
+      INTEGER :: jl, jn
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      CHARACTER(LEN=32)   ::   clname
+      !!
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      clname = 'namelist_medusa'
+      IF(lwp) WRITE(numout,*) ' trc_nam_medusa: read MEDUSA namelist'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
+
+
+      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'open namelist_medusa -- OK'
+      IF (lwp) write (numout,*) 'Now, read namilists inside :'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
+
+      ! 1.4 namelist natbio : biological parameters
+      ! -------------------------------------------
+      !! Note: the default values below will all be overwritten by the
+      !!       input in the namelist natbio.
+      
+      xxi         = 0.
+      xaln        = 0.
+      xald        = 0.
+      jphy        = 0
+      xvpn        = 0.
+      xvpd        = 0.
+      xthetam     = 0.
+      xthetamd    = 0.
+!!
+      xsin0       = 0.
+      xnsi0       = 0.
+      xuif        = 0.
+!!
+      jliebig     = 0
+      jq10        = 0.
+      xnln        = 0.
+      xnld        = 0.
+      xsld        = 0.
+      xfln        = 0.
+      xfld        = 0.
+!!
+      xgmi        = 0.
+      xgme        = 0.
+      xkmi        = 0.
+      xkme        = 0.
+      xphi	  = 0.
+      xbetan      = 0.
+      xbetac      = 0.
+      xkc         = 0.
+      xpmipn      = 0.
+      xpmid       = 0.
+      xpmepn      = 0.
+      xpmepd      = 0.
+      xpmezmi     = 0.
+      xpmed       = 0.
+!!
+      xmetapn     = 0.
+      xmetapd     = 0.
+      xmetazmi    = 0.
+      xmetazme    = 0.
+!!
+      jmpn        = 0
+      xmpn        = 0.
+      xkphn       = 0.
+      jmpd        = 0
+      xmpd        = 0.
+      xkphd       = 0.
+      jmzmi       = 0
+      xmzmi       = 0.
+      xkzmi       = 0.
+      jmzme       = 0
+      xmzme       = 0.
+      xkzme       = 0.
+!!
+      jmd         = 0
+      jsfd        = 0
+      xmd         = 0.
+      xmdc        = 0.
+!!
+      xthetapn    = 0.
+      xthetapd    = 0.
+      xthetazmi   = 0.
+      xthetazme   = 0.
+      xthetad     = 0.
+      xrfn        = 0.
+      xrsn        = 0.  !: (NOT USED HERE; RETAINED FOR LOBSTER)
+!!
+      jiron       = 0
+      xfe_mass    = 0.
+      xfe_sol     = 0.
+      xfe_sed     = 0.
+      xLgT        = 0.
+      xk_FeL	  = 0.
+      xk_sc_Fe    = 0.
+!!
+      jexport     = 0
+      jfdfate     = 0
+      jrratio     = 0
+      jocalccd    = 0
+      xridg_r0    = 0.
+      xfdfrac1	  = 0.
+      xfdfrac2	  = 0.
+      xfdfrac3	  = 0.
+      xcaco3a	  = 0.
+      xcaco3b	  = 0.
+      xmassc	  = 0.
+      xmassca	  = 0.
+      xmasssi	  = 0.
+      xprotca	  = 0.
+      xprotsi	  = 0.
+      xfastc	  = 0.
+      xfastca	  = 0.
+      xfastsi	  = 0.
+!!
+      jorgben     = 0
+      jinorgben   = 0
+      xsedn       = 0.
+      xsedfe      = 0.
+      xsedsi      = 0.
+      xsedc       = 0.
+      xsedca      = 0.
+      xburial     = 0.
+!!
+      jriver_n    = 0
+      jriver_si   = 0
+      jriver_c    = 0
+      jriver_alk  = 0
+      jriver_dep  = 1
+!!
+      xsdiss	  = 0.
+!!
+      vsed        = 0.
+      xhr         = 0.
+!!
+      sedlam	  = 0.
+      sedlostpoc  = 0.
+      jpkb	  = 0.
+      jdms        = 0
+      jdms_input  = 0
+      jdms_model  = 0
+      scl_chl     = 1.
+      chl_out     = 1
+      dmsmin      = 2.29 !! Anderson DMS default
+      dmscut      = 1.72 !! Anderson DMS default
+      dmsslp      = 8.24 !! Anderson DMS default
+            
+      !REWIND(numnatm)
+      !READ(numnatm,natbio)
+         ! Namelist natbio
+         ! -------------------
+         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 , '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 , 'natbio in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natbio )
+
+!! Primary production and chl related quantities
+!!       xxi         :  conversion factor from gC to mmolN 
+!!       xaln        :  Chl-a specific initial slope of P-I curve for non-diatoms 
+!!       xald        :  Chl-a specific initial slope of P-I curve for diatoms
+!!       jphy        :  phytoplankton T-dependent growth switch
+!!       xvpn        :  maximum growth rate for non-diatoms
+!!       xvpd        :  maximum growth rate for diatoms
+!!       xthetam     :  maximum Chl to C ratio for non-diatoms      
+!!       xthetamd    :  maximum Chl to C ratio for diatoms      
+!!
+!! Diatom silicon parameters
+!!       xsin0       :  minimum diatom Si:N ratio
+!!       xnsi0       :  minimum diatom N:Si ratio
+!!       xuif        :  hypothetical growth ratio at infinite Si:N ratio
+!!
+!! Nutrient limitation
+!!       jliebig     :  Liebig nutrient uptake switch
+!!       xnln        :  half-sat constant for DIN uptake by non-diatoms 
+!!       xnld        :  half-sat constant for DIN uptake by diatoms 
+!!       xsl         :  half-sat constant for Si uptake by diatoms 
+!!       xfld        :  half-sat constant for Fe uptake by diatoms  
+!!       xfln        :  half-sat constant for Fe uptake by non-datoms 
+!!
+!! Grazing
+!!       xgmi        :  microzoo maximum growth rate 
+!!       xgme        :  mesozoo maximum growth rate 
+!!       xkmi        :  microzoo grazing half-sat parameter
+!!       xkme        :  mesozoo grazing half-sat parameter
+!!       xphi        :  micro/mesozoo grazing inefficiency
+!!       xbetan      :  micro/mesozoo N assimilation efficiency
+!!       xbetac      :  micro/mesozoo C assimilation efficiency
+!!       xkc         :  micro/mesozoo net C growth efficiency
+!!       xpmipn      :  grazing preference of microzoo for non-diatoms
+!!       xpmid       :  grazing preference of microzoo for diatoms
+!!       xpmepn      :  grazing preference of mesozoo for non-diatoms 
+!!       xpmepd      :  grazing preference of mesozoo for diatoms
+!!       xpmezmi     :  grazing preference of mesozoo for microzoo
+!!       xpmed       :  grazing preference of mesozoo for detritus
+!!
+!! Metabolic losses
+!!       xmetapn     :  non-diatom metabolic loss rate
+!!       xmetapd     :  diatom     metabolic loss rate
+!!       xmetazmi    :  microzoo   metabolic loss rate
+!!       xmetazme    :  mesozoo    metabolic loss rate
+!!
+!! Mortality/Remineralisation
+!!       jmpn        :  non-diatom mortality functional form
+!!       xmpn        :  non-diatom mortality rate
+!!       xkphn       :  non-diatom mortality half-sat constant
+!!       jmpd        :  diatom     mortality functional form
+!!       xmpd        :  diatom mortality rate
+!!       xkphd       :  diatom mortality half-sat constant
+!!       jmzmi       :  microzoo   mortality functional form
+!!       xmzmi       :  microzoo mortality rate
+!!       xkzmi       :  microzoo mortality half-sat constant
+!!       jmzme       :  mesozoo    mortality functional form
+!!       xmzme       :  mesozoo mortality rate
+!!       xkzme       :  mesozoo mortality half-sat constant
+!!
+!! Remineralisation
+!!       jmd         :  detritus T-dependent remineralisation switch
+!!       jsfd        :  accelerate seafloor detritus remin. switch
+!!       xmd         :  detrital nitrogen remineralisation rate 
+!!       xmdc        :  detrital carbon remineralisation rate 
+!!
+!! Stochiometric ratios
+!!       xthetapn    :  non-diatom C:N ratio
+!!       xthetapd    :  diatom C:N ratio
+!!       xthetazmi   :  microzoo C:N ratio
+!!       xthetazme   :  mesozoo C:N ratio
+!!       xthetad     :  detritus C:N ratio
+!!       xrfn        :  phytoplankton Fe:N ratio
+!!	 xrsn        :  diatom Si:N ratio (*NOT* used)
+!!
+!! Iron parameters
+!!       jiron       :  iron scavenging submodel switch
+!!       xfe_mass    :  iron atomic mass
+!!	 xfe_sol     :  aeolian iron solubility
+!!	 xfe_sed     :  sediment iron input
+!!	 xLgT	     :  total ligand concentration (umol/m3)
+!!	 xk_FeL	     :  dissociation constant for (Fe + L)
+!!	 xk_sc_Fe    :  scavenging rate of "free" iron
+!!	 
+!! Fast-sinking detritus parameters
+!!       jexport     :  fast detritus remineralisation switch
+!!       jfdfate     :  fate of fast detritus at seafloor switch
+!!       jrratio     :  rain ratio switch
+!!       jocalccd    :  CCD switch
+!!       xridg_r0    :  Ridgwell rain ratio coefficient
+!!       xfdfrac1    :  fast-sinking fraction of diatom nat. mort. losses
+!!       xfdfrac2    :  fast-sinking fraction of meszooplankton mort. losses
+!!       xfdfrac3    :  fast-sinking fraction of diatom silicon grazing losses
+!!       xcaco3a     :  polar (high latitude) CaCO3 fraction
+!!       xcaco3b     :  equatorial (low latitude) CaCO3 fraction
+!!       xmassc      :  organic C mass:mole ratio, C106 H175 O40 N16 P1
+!!       xmassca     :  calcium carbonate mass:mole ratio, CaCO3
+!!       xmasssi     :  biogenic silicon mass:mole ratio, (H2SiO3)n
+!!       xprotca     :  calcium carbonate protection ratio
+!!       xprotsi     :  biogenic silicon protection ratio
+!!       xfastc      :  organic C remineralisation length scale
+!!       xfastca     :  calcium carbonate dissolution length scale
+!!       xfastsi     :  biogenic silicon dissolution length scale
+!!
+!! Benthic 
+!!       jorgben     :  does   organic detritus go to the benthos?
+!!       jinorgben   :  does inorganic detritus go to the benthos?
+!!       xsedn       :  organic   nitrogen sediment remineralisation rate 
+!!       xsedfe      :  organic   iron     sediment remineralisation rate 
+!!       xsedsi      :  inorganic silicon  sediment dissolution      rate 
+!!       xsedc       :  organic   carbon   sediment remineralisation rate 
+!!       xsedca      :  inorganic carbon   sediment dissolution      rate 
+!!       xburial     :  burial rate of seafloor detritus
+!!
+!! Riverine inputs
+!!       jriver_n    :  riverine N          input?
+!!       jriver_si   :  riverine Si         input?
+!!       jriver_c    :  riverine C          input?
+!!       jriver_alk  :  riverine alkalinity input?
+!!       jriver_dep  :  depth of riverine   input?
+!!
+!! Miscellaneous
+!!       xsdiss      :  diatom frustule dissolution rate
+!!
+!! Gravitational sinking      
+!!       vsed        :  detritus gravitational sinking rate 
+!!       xhr         :  coeff for Martin's remineralisation profile
+!!
+!! Additional parameters
+!!       sedlam      :  time coeff of POC in sediments
+!!      sedlostpoc   :  sediment geol loss for POC
+!!       jpkb        :  vertical layer for diagnostic of the vertical flux 
+!!                      NOTE that in LOBSTER it is a first vertical layers where 
+!!                      biology is active  
+!!
+!! 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, 5 = ANDM
+!!       dmsmin      : DMS minimum value for DMS Anderson (ANDR) sheme ONLY
+!!       dmscut      : DMS cutoff value for DMS Anderson (ANDR) sheme ONLY
+!!       dmsslp      : DMS slope value for DMS Anderson (ANDR) sheme ONLY
+!! UKESM1 - exported Chl to UM
+!!       scl_chl     : scaling factor to tune the chl field sent to the UM
+!!       chl_out     : select the chl field to send at the UM:
+!!                     1- Surf Chl ; 2- MLD Chl 
+
+      IF(lwp) THEN
+!!
+!! AXY (08/11/13): compilation key notification
+         WRITE(numout,*) '=== Compilation keys'
+#if defined key_roam
+         WRITE(numout,*)     &
+         &   ' key_roam                                                               = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_roam                                                               = INACTIVE'
+#endif        
+#if defined key_axy_carbchem
+         WRITE(numout,*)     &
+         &   ' key_axy_carbchem                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' 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,*)     &
+         &   ' key_bs_axy_zforce                                                      = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_zforce                                                      = INACTIVE'
+#endif        
+#if defined key_bs_axy_yrlen
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_yrlen                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_yrlen                                                       = INACTIVE'
+#endif        
+#if defined key_deep_fe_fix
+         WRITE(numout,*)     &
+         &   ' key_deep_fe_fix                                                        = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_deep_fe_fix                                                        = INACTIVE'
+#endif        
+#if defined key_axy_nancheck
+         WRITE(numout,*)     &
+         &   ' key_axy_nancheck                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_axy_nancheck                                                       = INACTIVE'
+#endif        
+# if defined key_axy_pi_co2
+         WRITE(numout,*)     &
+         &   ' key_axy_pi_co2                                                         = ACTIVE'
+#else
+         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,*) ' '
+
+         WRITE(numout,*) 'natbio'
+         WRITE(numout,*) ' '
+!!
+!! Primary production and chl related quantities
+         WRITE(numout,*) '=== Primary production'
+         WRITE(numout,*)     &
+         &   ' conversion factor from gC to mmolN,                        xxi         =', xxi
+         WRITE(numout,*)     &
+         &   ' Chl-a specific initial slope of P-I curve for non-diatoms, xaln        = ', xaln
+         WRITE(numout,*)     &
+         &   ' Chl-a specific initial slope of P-I curve for diatoms,     xald        = ', xald
+         if (jphy.eq.1) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-dependent*            jphy        = ', jphy
+         elseif (jphy.eq.2) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-dependent(Q10)*       jphy        = ', jphy
+         elseif (jphy.eq.0) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-independent*          jphy        = ', jphy
+         endif
+         WRITE(numout,*)     &
+         &   ' maximum growth rate for non-diatoms,                       xvpn        = ', xvpn
+         WRITE(numout,*)     &
+         &   ' maximum growth rate for diatoms,                           xvpn        = ', xvpd
+         WRITE(numout,*)     &
+         &   ' maximum Chl to C ratio for non-diatoms,                    xthetam     = ', xthetam
+         WRITE(numout,*)     &
+         &   ' maximum Chl to C ratio for diatoms,                        xthetamd    = ', xthetamd
+         WRITE(numout,*)     &
+         &   ' specific Q10 value (jphy==2),                                  jq10    = ', jq10
+!!
+!! Diatom silicon parameters
+         WRITE(numout,*) '=== Diatom silicon parameters'
+         WRITE(numout,*)     &
+         &   ' minimum diatom Si:N ratio,                                 xsin0       = ', xsin0
+         WRITE(numout,*)     &
+         &   ' minimum diatom N:Si ratio,                                 xnsi0       = ', xnsi0
+         WRITE(numout,*)     &
+         &   ' hypothetical growth ratio at infinite Si:N ratio,          xuif        = ', xuif
+!!
+!! Nutrient limitation
+         WRITE(numout,*) '=== Nutrient limitation'
+         if (jliebig.eq.1) then
+            WRITE(numout,*) &
+            &   ' nutrient uptake is a Liebig Law (= most limiting) function jliebig     = ', jliebig
+         elseif (jliebig.eq.0) then
+            WRITE(numout,*) &
+            &   ' nutrient uptake is a multiplicative function               jliebig     = ', jliebig
+         endif
+         WRITE(numout,*)     &
+         &   ' half-sat constant for DIN uptake by non-diatoms,           xnln        = ', xnln
+         WRITE(numout,*)     &
+         &   ' half-sat constant for DIN uptake by diatoms,               xnld        = ', xnld
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Si uptake by diatoms,                xsld        = ', xsld
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Fe uptake by non-diatoms,            xfln        = ', xfln
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Fe uptake by diatoms,                xfld        = ', xfld
+!!
+!! Grazing
+         WRITE(numout,*) '=== Zooplankton grazing'
+         WRITE(numout,*)     &
+         &   ' microzoo maximum growth rate,                              xgmi        = ', xgmi
+         WRITE(numout,*)     &
+         &   ' mesozoo maximum growth rate,                               xgme        = ', xgme
+         WRITE(numout,*)     &
+         &   ' microzoo grazing half-sat parameter,                       xkmi        = ', xkmi
+         WRITE(numout,*)     &
+         &   ' mesozoo grazing half-sat parameter,                        xkme        = ', xkme
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo grazing inefficiency,                        xphi        = ', xphi
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo N assimilation efficiency,                   xbetan      = ', xbetan
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo C assimilation efficiency,                   xbetac      = ', xbetan
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo net C growth efficiency,                     xkc         = ', xkc
+         WRITE(numout,*)     &
+         &   ' grazing preference of microzoo for non-diatoms,            xpmipn      = ', xpmipn
+         WRITE(numout,*)     &
+         &   ' grazing preference of microzoo for detritus,               xpmid       = ', xpmid
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for non-diatoms,             xpmepn      = ', xpmepn
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for diatoms,                 xpmepd      = ', xpmepd
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for microzoo,                xpmezmi     = ', xpmezmi
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for detritus,                xpmed       = ', xpmed
+!!
+!! Metabolic losses
+         WRITE(numout,*) '=== Metabolic losses'
+         WRITE(numout,*)     &
+         &   ' non-diatom metabolic loss rate,                            xmetapn     = ', xmetapn
+         WRITE(numout,*)     &
+         &   ' diatom     metabolic loss rate,                            xmetapd     = ', xmetapd
+         WRITE(numout,*)     &
+         &   ' microzoo   metabolic loss rate,                            xmetazmi    = ', xmetazmi
+         WRITE(numout,*)     &
+         &   ' mesozoo    metabolic loss rate,                            xmetazme    = ', xmetazme
+!!
+!! Mortality losses
+         WRITE(numout,*) '=== Mortality losses'
+         if (jmpn.eq.1) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,            LINEAR    jmpn        = ', jmpn
+         elseif (jmpn.eq.2) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,         QUADRATIC    jmpn        = ', jmpn
+         elseif (jmpn.eq.3) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,        HYPERBOLIC    jmpn        = ', jmpn
+         elseif (jmpn.eq.4) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,           SIGMOID    jmpn        = ', jmpn
+         endif
+         WRITE(numout,*)     &
+         &   ' non-diatom mortality rate,                                 xmpn        = ', xmpn
+         WRITE(numout,*)     &
+         &   ' non-diatom mortality half-sat constant                     xkphn       = ', xkphn
+         if (jmpd.eq.1) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,                LINEAR    jmpd        = ', jmpd
+         elseif (jmpd.eq.2) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,             QUADRATIC    jmpd        = ', jmpd
+         elseif (jmpd.eq.3) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,            HYPERBOLIC    jmpd        = ', jmpd
+         elseif (jmpd.eq.4) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,               SIGMOID    jmpd        = ', jmpd
+         endif
+         WRITE(numout,*)     &
+         &   ' diatom mortality rate,                                     xmpd        = ', xmpd
+         WRITE(numout,*)     &
+         &   ' diatom mortality half-sat constant                         xkphd       = ', xkphd
+         if (jmzmi.eq.1) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,              LINEAR    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.2) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,           QUADRATIC    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.3) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,          HYPERBOLIC    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.4) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,             SIGMOID    jmzmi       = ', jmzmi
+         endif
+         WRITE(numout,*)     &
+         &   ' microzoo mortality rate,                                   xmzmi       = ', xmzmi
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality half-sat constant,                       xkzmi       = ', xkzmi
+         if (jmzme.eq.1) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,               LINEAR    jmzme       = ', jmzme
+         elseif (jmzme.eq.2) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,            QUADRATIC    jmzme       = ', jmzme
+         elseif (jmzme.eq.3) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,           HYPERBOLIC    jmzme       = ', jmzme
+         elseif (jmzme.eq.4) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,              SIGMOID    jmzme       = ', jmzme
+         endif
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality rate,                                    xmzme       = ', xmzme
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality half-sat constant,                       xkzme       = ', xkzme
+!!
+!! Remineralisation
+         WRITE(numout,*) '=== Remineralisation'
+         if (jmd.eq.1) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-dependent*       jmd         = ', jmd
+         elseif (jmd.eq.2) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-dependent(Q10)*  jmd         = ', jmd
+         elseif (jmd.eq.0) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-independent*     jmd         = ', jmd
+         endif
+         if (jsfd.eq.1) then
+            WRITE(numout,*) &
+            &   ' detritus seafloor remineralisation is *accelerated*        jsfd        = ', jsfd
+         else
+            WRITE(numout,*) &
+            &   ' detritus seafloor remineralisation occurs at same rate     jsfd        = ', jsfd
+         endif
+         WRITE(numout,*)     &
+         &   ' detrital nitrogen remineralisation rate,                   xmd         = ', xmd
+         WRITE(numout,*)     &
+         &   ' detrital carbon remineralisation rate,                     xmdc        = ', xmdc
+!!
+!! Stochiometric ratios
+         WRITE(numout,*) '=== Stoichiometric ratios'
+         WRITE(numout,*)     &
+         &   ' non-diatom C:N ratio,                                      xthetapn    = ', xthetapn
+         WRITE(numout,*)     &
+         &   ' diatom C:N ratio,                                          xthetapd    = ', xthetapd
+         WRITE(numout,*)     &
+         &   ' microzoo C:N ratio,                                        xthetazmi   = ', xthetazmi
+         WRITE(numout,*)     &
+         &   ' mesozoo C:N ratio,                                         xthetazme   = ', xthetazme
+         WRITE(numout,*)     &
+         &   ' detritus C:N ratio,                                        xthetad     = ', xthetad
+         WRITE(numout,*)     &
+         &   ' phytoplankton Fe:N ratio,                                  xrfn        = ', xrfn
+         WRITE(numout,*)     &
+         &   ' diatom Si:N ratio,                                         xrsn        = ', xrsn
+!!	  
+!! Iron parameters
+         WRITE(numout,*) '=== Iron parameters'
+         if (jiron.eq.1) then
+            WRITE(numout,*)     &
+            &   ' Dutkiewicz et al. (2005) iron scavenging                   jiron       = ', jiron
+         elseif (jiron.eq.2) then
+            WRITE(numout,*)     &
+            &   ' Moore et al. (2004) iron scavenging                        jiron       = ', jiron
+         elseif (jiron.eq.3) then
+            WRITE(numout,*)     &
+            &   ' Moore et al. (2008) iron scavenging                        jiron       = ', jiron
+         elseif (jiron.eq.4) then
+            WRITE(numout,*)     &
+            &   ' Galbraith et al. (2010) iron scavenging                    jiron       = ', jiron
+         else
+            WRITE(numout,*)     &
+            &   ' There is **no** iron scavenging                            jiron       = ', jiron
+         endif
+         WRITE(numout,*)     &
+         &   ' iron atomic mass,                                          xfe_mass    = ', xfe_mass
+         WRITE(numout,*)     &
+         &   ' aeolian iron solubility,                                   xfe_sol     = ', xfe_sol
+         WRITE(numout,*)     &
+         &   ' sediment iron input,                                       xfe_sed     = ', xfe_sed
+         WRITE(numout,*)     &
+         &   ' total ligand concentration (umol/m3),                      xLgT        = ', xLgT
+         WRITE(numout,*)     &
+         &   ' dissociation constant for (Fe + L),                        xk_FeL      = ', xk_FeL
+         WRITE(numout,*)     &
+         &   ' scavenging rate for free iron,                             xk_sc_Fe    = ', xk_sc_Fe
+!!
+!! Fast-sinking detritus parameters
+         WRITE(numout,*) '=== Fast-sinking detritus'
+         if (jexport.eq.1) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Dunne et al. (2007; ballast)     jexport     = ', jexport
+         elseif (jexport.eq.2) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Martin et al. (1987)             jexport     = ', jexport
+         elseif (jexport.eq.2) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Henson et al. (2011)             jexport     = ', jexport
+         endif
+         if (jfdfate.eq.1) then
+            WRITE(numout,*) &
+            &   ' fast-detritus reaching seafloor becomes slow-detritus      jfdfate     = ', jfdfate
+         elseif (jfdfate.eq.0) then
+            WRITE(numout,*) &
+            &   ' fast-detritus reaching seafloor instantly remineralised    jfdfate     = ', jfdfate
+         endif
+#if defined key_roam
+         if (jrratio.eq.0) then
+            WRITE(numout,*) &
+            &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
+         elseif (jrratio.eq.1) then
+            WRITE(numout,*) &
+            &   ' Ridgwell et al. (2007) rain ratio submodel (surface omega) jrratio     = ', jrratio
+         elseif (jrratio.eq.2) then
+            WRITE(numout,*) &
+            &   ' Ridgwell et al. (2007) rain ratio submodel (3D omega)      jrratio     = ', jrratio
+         endif
+#else          
+         jrratio = 0
+         WRITE(numout,*) &
+         &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
+#endif          
+#if defined key_roam
+         if (jocalccd.eq.0) then
+            WRITE(numout,*) &
+            &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
+         elseif (jocalccd.eq.1) then
+            WRITE(numout,*) &
+            &   ' Calculated, dynamic CCD used                               jocalccd    = ', jocalccd
+         endif
+#else          
+         jocalccd = 0
+         WRITE(numout,*) &
+         &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
+#endif
+         WRITE(numout,*)     &
+         &   ' Ridgwell rain ratio coefficient,                           xridg_r0    = ', xridg_r0
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of diatom nat. mort. losses,         xfdfrac1    = ', xfdfrac1
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of mesozooplankton mort. losses,     xfdfrac2    = ', xfdfrac2
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of diatom silicon grazing losses,    xfdfrac3    = ', xfdfrac3
+         WRITE(numout,*)     &
+         &   ' polar (high latitude) CaCO3 fraction,                      xcaco3a     = ', xcaco3a
+         WRITE(numout,*)     &
+         &   ' equatorial (low latitude) CaCO3 fraction,                  xcaco3b     = ', xcaco3b
+         WRITE(numout,*)     &
+         &   ' organic C mass:mole ratio, C106 H175 O40 N16 P1,           xmassc      = ', xmassc
+         WRITE(numout,*)     &
+         &   ' calcium carbonate mass:mole ratio, CaCO3,                  xmassca     = ', xmassca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon mass:mole ratio, (H2SiO3)n,               xmasssi     = ', xmasssi
+         WRITE(numout,*)     &
+         &   ' calcium carbonate protection ratio,                        xprotca     = ', xprotca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon protection ratio,                         xprotsi     = ', xprotsi
+         WRITE(numout,*)     &
+         &   ' organic C remineralisation length scale,                   xfastc      = ', xfastc
+         WRITE(numout,*)     &
+         &   ' calcium carbonate dissolution length scale,                xfastca     = ', xfastca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon dissolution length scale,                 xfastsi     = ', xfastsi
+!!
+!! Benthos parameters
+         WRITE(numout,*) '=== Benthos parameters'
+         WRITE(numout,*)     &
+         &   ' does   organic detritus go to the benthos?,                jorgben     = ', jorgben
+         WRITE(numout,*)     &
+         &   ' does inorganic detritus go to the benthos?,                jinorgben   = ', jinorgben
+!!
+!! Some checks on parameters related to benthos parameters
+         if (jorgben.eq.1 .and. jsfd.eq.1) then
+            !! slow detritus going to benthos at an accelerated rate
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jsfd *and* jorgben are active - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         if (jorgben.eq.1 .and. jfdfate.eq.1) then
+            !! fast detritus going to benthos but via slow detritus
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jfdfate *and* jorgben are active - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         if (jorgben.eq.0 .and. jinorgben.eq.1) then
+            !! inorganic fast detritus going to benthos but organic fast detritus is not
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jinorgben is active but jorgben is not - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         WRITE(numout,*)     &
+         &   ' organic   nitrogen sediment remineralisation rate,         xsedn       = ', xsedn
+         WRITE(numout,*)     &
+         &   ' organic   iron     sediment remineralisation rate,         xsedfe      = ', xsedfe
+         WRITE(numout,*)     &
+         &   ' inorganic silicon  sediment remineralisation rate,         xsedsi      = ', xsedsi
+         WRITE(numout,*)     &
+         &   ' organic   carbon   sediment remineralisation rate,         xsedc       = ', xsedc
+         WRITE(numout,*)     &
+         &   ' inorganic carbon   sediment remineralisation rate,         xsedca      = ', xsedca
+         WRITE(numout,*)     &
+         &   ' burial rate of seafloor detritus,                          xburial     = ', xburial
+!!
+!! Riverine inputs
+         WRITE(numout,*) '=== Riverine inputs'
+         if (jriver_n.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine N input,                                     jriver_n    = ', jriver_n
+         elseif (jriver_n.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine N concentrations specified,                       jriver_n    = ', jriver_n
+         elseif (jriver_n.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine N inputs specified,                               jriver_n    = ', jriver_n
+         endif
+         if (jriver_si.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine Si input,                                    jriver_si   = ', jriver_si
+         elseif (jriver_si.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine Si concentrations specified,                      jriver_si   = ', jriver_si
+         elseif (jriver_si.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine Si inputs specified,                              jriver_si   = ', jriver_si
+         endif
+         if (jriver_c.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine C input,                                     jriver_c    = ', jriver_c
+         elseif (jriver_c.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine C concentrations specified,                       jriver_c    = ', jriver_c
+         elseif (jriver_c.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine C inputs specified,                               jriver_c    = ', jriver_c
+         endif
+         if (jriver_alk.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine alkalinity input,                            jriver_alk  = ', jriver_alk
+         elseif (jriver_alk.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine alkalinity concentrations specified,              jriver_alk  = ', jriver_alk
+         elseif (jriver_alk.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine alkalinity inputs specified,                      jriver_alk  = ', jriver_alk
+         endif
+         !! AXY (19/07/12): prevent (gross) stupidity on part of user
+         if (jriver_dep.lt.1.or.jriver_dep.ge.jpk) then
+            jriver_dep = 1
+         endif
+         WRITE(numout,*)     &
+         &   ' riverine input applied to down to depth k = ...            jriver_dep  = ', jriver_dep
+!!
+!! Miscellaneous
+         WRITE(numout,*) '=== Miscellaneous'
+         WRITE(numout,*)     &
+         &   ' diatom frustule dissolution rate,                          xsdiss      = ', xsdiss
+!!
+!! Gravitational sinking      
+         WRITE(numout,*) '=== Gravitational sinking'
+         WRITE(numout,*)     &
+         &   ' detritus gravitational sinking rate,                       vsed        = ', vsed
+         WRITE(numout,*)     & 
+         &   ' coefficient for Martin et al. (1987) remineralisation,     xhr         = ', xhr
+!!
+!! Non-Medusa parameters
+         WRITE(numout,*) '=== Non-Medusa parameters'
+         WRITE(numout,*)     & 
+         &   ' time coeff of POC in sediments,                            sedlam      = ', sedlam
+         WRITE(numout,*)     &
+         &   ' Sediment geol loss for POC,                                sedlostpoc  = ', sedlostpoc
+         WRITE(numout,*)     &
+         &   ' Vert layer for diagnostic of vertical flux,                jpkp        = ', jpkb
+!!
+!! UKESM1 - new diagnostics  !! Jpalm; AXY (08/07/15)
+         WRITE(numout,*) '=== UKESM1-related parameters ==='
+         WRITE(numout,*) ' ---- --- ---'
+
+         IF (lk_oasis) THEN
+            WRITE(numout,*) '=== UKESM1 --  coupled DMS to the atmosphere'
+            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)'
+	    elseif (jdms_model .eq. 5) then
+               WRITE(numout,*)     &
+               &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Anderson et al. (2001; modified)'
+            endif
+            if (jdms_model .eq. 1) then
+               WRITE(numout,*)     &
+               &   ' Anderson DMS model tuned parameters:                       DMS minimum = ',dmsmin,'. -- Default = 2.29 '
+               WRITE(numout,*)     &
+               &   ' Anderson DMS model tuned parameters:                       DMS cutoff  = ',dmscut,'. -- Default = 1.72 '
+               WRITE(numout,*)     &
+               &   ' Anderson DMS model tuned parameters:                       DMS slope   = ',dmsslp,'. -- Default = 8.24 '
+            endif
+
+            WRITE(numout,*) '=== UKESM1 --  coupled Chl to the atmosphere'
+            WRITE(numout,*)        &
+               &   ' Scaling factor to export tuned Chl to the atmosphere       scl_chl  = ', scl_chl
+            IF (chl_out .eq. 1) THEN
+               WRITE(numout,*)        &
+               &   ' Chl field to be scaled and sent to the atmosphere:         chl_out  = Surface Chl field '
+            ELSEIF (chl_out .eq. 2) THEN
+               WRITE(numout,*)        &
+               &   ' Chl field to be scaled and sent to the atmosphere:         chl_out  = MLD Chl field '
+            ENDIF
+         ENDIF ! IF lk_oasis=true
+!!
+      ENDIF
+!!
+!! Key depth positions (with thanks to Andrew Coward for bug-fixing this bit)
+      DO jk = 1,jpk
+         !! level thickness
+         fthk  = e3t_1d(jk)
+         !! level depth (top of level)
+         fdep  = gdepw_1d(jk)
+         !! level depth (bottom of level)
+         fdep1 = fdep + fthk
+         !!
+         if (fdep.lt.100.0.AND.fdep1.gt.100.0) then        !  100 m
+            i0100 = jk
+         elseif (fdep.lt.150.0.AND.fdep1.gt.150.0) then    !  150 m (for BASIN)
+            i0150 = jk
+         elseif (fdep.lt.200.0.AND.fdep1.gt.200.0) then    !  200 m
+            i0200 = jk
+         elseif (fdep.lt.500.0.AND.fdep1.gt.500.0) then    !  500 m
+            i0500 = jk
+         elseif (fdep.lt.1000.0.AND.fdep1.gt.1000.0) then  ! 1000 m
+            i1000 = jk
+         elseif (fdep1.lt.1100.0) then                     ! 1100 m (for Moore et al. sedimentary iron)
+            i1100 = jk
+         endif
+      enddo
+      !!
+      IF(lwp) THEN
+          WRITE(numout,*) '=== Position of key depths'
+          WRITE(numout,*)     & 
+          &   ' jk position of  100 m horizon                              i0100       = ', i0100
+          WRITE(numout,*)     &
+          &   ' jk position of  150 m horizon                              i0150       = ', i0150
+          WRITE(numout,*)     & 
+          &   ' jk position of  200 m horizon                              i0200       = ', i0200
+          WRITE(numout,*)     & 
+          &   ' jk position of  500 m horizon                              i0500       = ', i0500
+          WRITE(numout,*)     & 
+          &   ' jk position of 1000 m horizon                              i1000       = ', i1000
+          WRITE(numout,*)     & 
+          &   ' jk position of 1100 m horizon [*]                          i1100       = ', i1100
+          WRITE(numout,*) 'Got here ' , SIZE(friver_dep)
+          CALL flush(numout)
+      ENDIF
+
+#if defined key_roam
+
+      ! 1.4b namelist natroam : ROAM parameters
+      ! ---------------------------------------
+      
+      xthetaphy = 0.
+      xthetazoo = 0.
+      xthetanit = 0.
+      xthetarem = 0.
+      xo2min    = 0.
+
+      !READ(numnatm,natroam)
+         ! Namelist natroam
+         ! -------------------
+         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
+!!       xthetaphy :  oxygen evolution/consumption by phytoplankton
+!!       xthetazoo :  oxygen consumption by zooplankton
+!!       xthetanit :  oxygen consumption by nitrogen remineralisation
+!!       xthetarem :  oxygen consumption by carbon remineralisation
+!!       xo2min    :  oxygen minimum concentration
+
+      IF(lwp) THEN
+          WRITE(numout,*) 'natroam'
+          WRITE(numout,*) ' '
+!!
+!! ROAM carbon, alkalinity and oxygen cycle parameters
+          WRITE(numout,*) '=== ROAM carbon, alkalinity and oxygen cycle parameters'
+          WRITE(numout,*)     &
+          &   ' oxygen evolution/consumption by phytoplankton              xthetaphy   = ', xthetaphy
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by zooplankton                          xthetazoo   = ', xthetazoo
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by nitrogen remineralisation            xthetanit   = ', xthetanit
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by carbon remineralisation              xthetarem   = ', xthetarem
+          WRITE(numout,*)     &
+          &   ' oxygen minimum concentration                               xo2min      = ', xo2min
+       ENDIF
+
+#endif
+
+      CALL flush(numout)
+
+      ! 1.5 namelist natopt : parameters for optic
+      ! ------------------------------------------
+
+      xkg0  = 0.
+      xkr0  = 0.
+      xkgp  = 0.
+      xkrp  = 0.
+      xlg   = 0.
+      xlr   = 0.
+      rpig  = 0.
+
+      !READ(numnatm,natopt)
+         ! Namelist natopt
+         ! -------------------
+         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 , '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 , 'natopt in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natopt )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'natopt'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' green   water absorption coeff  xkg0  = ',xkg0
+         WRITE(numout,*) ' red water absorption coeff      xkr0  = ',xkr0
+         WRITE(numout,*) ' pigment red absorption coeff    xkrp  = ',xkrp
+         WRITE(numout,*) ' pigment green absorption coeff  xkgp  = ',xkgp
+         WRITE(numout,*) ' green chl exposant              xlg   = ',xlg
+         WRITE(numout,*) ' red   chl exposant              xlr   = ',xlr
+         WRITE(numout,*) ' chla/chla+phea ratio            rpig  = ',rpig
+         WRITE(numout,*) ' '
+
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'NaN check'
+         WRITE(numout,*) ' '
+         q1 = -1.
+         q2 = 0.
+         q3 = log(q1)
+         write (numout,*) 'q3 = ', q3
+         if ( ieee_is_nan( q3 ) ) then
+            write (numout,*) 'NaN detected'
+         else
+            write (numout,*) 'NaN not detected'
+         endif
+         WRITE(numout,*) ' '
+       ENDIF
+
+   END SUBROUTINE trc_nam_medusa
+   
+   SUBROUTINE trc_nam_iom_medusa
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_iom_medusa  ***
+      !!
+      !! ** Purpose : read all diag requested in iodef file through iom_use
+      !!              So it is done only once 
+      !!            ** All diagnostic MEDUSA could asked are registered in
+      !!            the med_diag type with a boolean value
+      !!            So if required, one diagnostic will be true.
+      !!
+      !!---------------------------------------------------------------------
+      !!
+      !!
+      !!----------------------------------------------------------------------            
+      !! Variable conventions
+      !!----------------------------------------------------------------------
+      !!
+      IF (iom_use("INVTN")) THEN 
+          med_diag%INVTN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTSI")) THEN 
+          med_diag%INVTSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTFE")) THEN 
+          med_diag%INVTFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PRN")) THEN 
+          med_diag%PRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%PRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MPN")) THEN 
+          med_diag%MPN%dgsave = .TRUE.
+      ELSE 
+          med_diag%MPN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PRD")) THEN 
+          med_diag%PRD%dgsave = .TRUE.
+      ELSE 
+          med_diag%PRD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MPD")) THEN 
+          med_diag%MPD%dgsave = .TRUE.
+      ELSE 
+          med_diag%MPD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DSED")) THEN 
+          med_diag%DSED%dgsave = .TRUE.
+      ELSE 
+          med_diag%DSED%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OPAL")) THEN 
+          med_diag%OPAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OPAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OPALDISS")) THEN 
+          med_diag%OPALDISS%dgsave = .TRUE.
+      ELSE 
+          med_diag%OPALDISS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMIPn")) THEN 
+          med_diag%GMIPn%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMIPn%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMID")) THEN 
+          med_diag%GMID%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMID%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MZMI")) THEN 
+          med_diag%MZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%MZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEPN")) THEN 
+          med_diag%GMEPN%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEPN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEPD")) THEN 
+          med_diag%GMEPD%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEPD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEZMI")) THEN 
+          med_diag%GMEZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMED")) THEN 
+          med_diag%GMED%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMED%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MZME")) THEN 
+          med_diag%MZME%dgsave = .TRUE.
+      ELSE 
+          med_diag%MZME%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DEXP")) THEN 
+          med_diag%DEXP%dgsave = .TRUE.
+      ELSE 
+          med_diag%DEXP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETN")) THEN 
+          med_diag%DETN%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MDET")) THEN 
+          med_diag%MDET%dgsave = .TRUE.
+      ELSE 
+          med_diag%MDET%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("AEOLIAN")) THEN 
+          med_diag%AEOLIAN%dgsave = .TRUE.
+      ELSE 
+          med_diag%AEOLIAN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BENTHIC")) THEN 
+          med_diag%BENTHIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%BENTHIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SCAVENGE")) THEN 
+          med_diag%SCAVENGE%dgsave = .TRUE.
+      ELSE 
+          med_diag%SCAVENGE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_JLIM")) THEN 
+          med_diag%PN_JLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_JLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_NLIM")) THEN 
+          med_diag%PN_NLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_NLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_FELIM")) THEN 
+          med_diag%PN_FELIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_FELIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_JLIM")) THEN 
+          med_diag%PD_JLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_JLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_NLIM")) THEN 
+          med_diag%PD_NLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_NLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_FELIM")) THEN 
+          med_diag%PD_FELIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_FELIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_SILIM")) THEN 
+          med_diag%PD_SILIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_SILIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDSILIM2")) THEN 
+          med_diag%PDSILIM2%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDSILIM2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__100")) THEN 
+          med_diag%SDT__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__200")) THEN 
+          med_diag%SDT__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__500")) THEN 
+          med_diag%SDT__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT_1000")) THEN 
+          med_diag%SDT_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TOTREG_N")) THEN 
+          med_diag%TOTREG_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%TOTREG_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TOTRG_SI")) THEN 
+          med_diag%TOTRG_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%TOTRG_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__100")) THEN 
+          med_diag%REG__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__200")) THEN 
+          med_diag%REG__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__500")) THEN 
+          med_diag%REG__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG_1000")) THEN 
+          med_diag%REG_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTN")) THEN 
+          med_diag%FASTN%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTSI")) THEN 
+          med_diag%FASTSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTFE")) THEN 
+          med_diag%FASTFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTC")) THEN 
+          med_diag%FASTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTCA")) THEN 
+          med_diag%FASTCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__100")) THEN 
+          med_diag%FDT__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__200")) THEN 
+          med_diag%FDT__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__500")) THEN 
+          med_diag%FDT__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT_1000")) THEN 
+          med_diag%FDT_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__100F")) THEN 
+          med_diag%RG__100F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__100F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__200F")) THEN 
+          med_diag%RG__200F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__200F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__500F")) THEN 
+          med_diag%RG__500F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__500F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG_1000F")) THEN 
+          med_diag%RG_1000F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG_1000F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__100")) THEN 
+          med_diag%FDS__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__200")) THEN 
+          med_diag%FDS__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__500")) THEN 
+          med_diag%FDS__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS_1000")) THEN 
+          med_diag%FDS_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_100F")) THEN 
+          med_diag%RGS_100F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_100F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_200F")) THEN 
+          med_diag%RGS_200F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_200F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_500F")) THEN 
+          med_diag%RGS_500F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_500F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS1000F")) THEN 
+          med_diag%RGS1000F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS1000F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINN")) THEN 
+          med_diag%REMINN%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINSI")) THEN 
+          med_diag%REMINSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINFE")) THEN 
+          med_diag%REMINFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINC")) THEN 
+          med_diag%REMINC%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINCA")) THEN 
+          med_diag%REMINCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRN")) THEN 
+          med_diag%SEAFLRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRSI")) THEN 
+          med_diag%SEAFLRSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRFE")) THEN 
+          med_diag%SEAFLRFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRC")) THEN 
+          med_diag%SEAFLRC%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRCA")) THEN 
+          med_diag%SEAFLRCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_QSR")) THEN 
+          med_diag%MED_QSR%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_QSR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_XPAR")) THEN 
+          med_diag%MED_XPAR%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_XPAR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_N")) THEN 
+          med_diag%INTFLX_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_SI")) THEN 
+          med_diag%INTFLX_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_FE")) THEN 
+          med_diag%INTFLX_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_PN")) THEN 
+          med_diag%INT_PN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_PN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_PD")) THEN 
+          med_diag%INT_PD%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_PD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ML_PRN")) THEN 
+          med_diag%ML_PRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%ML_PRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ML_PRD")) THEN 
+          med_diag%ML_PRD%dgsave = .TRUE.
+      ELSE 
+          med_diag%ML_PRD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCAL_CCD")) THEN 
+          med_diag%OCAL_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCAL_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCAL_LVL")) THEN 
+          med_diag%OCAL_LVL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCAL_LVL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0000")) THEN 
+          med_diag%FE_0000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0100")) THEN 
+          med_diag%FE_0100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0200")) THEN 
+          med_diag%FE_0200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0500")) THEN 
+          med_diag%FE_0500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_1000")) THEN 
+          med_diag%FE_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_XZE")) THEN 
+          med_diag%MED_XZE%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_XZE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("WIND")) THEN 
+          med_diag%WIND%dgsave = .TRUE.
+      ELSE 
+          med_diag%WIND%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_PCO2")) THEN 
+          med_diag%ATM_PCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_PCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_PH")) THEN 
+          med_diag%OCN_PH%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_PH%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_PCO2")) THEN 
+          med_diag%OCN_PCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_PCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCNH2CO3")) THEN 
+          med_diag%OCNH2CO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCNH2CO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_HCO3")) THEN 
+          med_diag%OCN_HCO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_HCO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_CO3")) THEN 
+          med_diag%OCN_CO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_CO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO2FLUX")) THEN 
+          med_diag%CO2FLUX%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO2FLUX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_CAL")) THEN 
+          med_diag%OM_CAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_CAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_ARG")) THEN 
+          med_diag%OM_ARG%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_ARG%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TCO2")) THEN 
+          med_diag%TCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%TCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TALK")) THEN 
+          med_diag%TALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%TALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("KW660")) THEN 
+          med_diag%KW660%dgsave = .TRUE.
+      ELSE 
+          med_diag%KW660%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_PP0")) THEN 
+          med_diag%ATM_PP0%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_PP0%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2FLUX")) THEN 
+          med_diag%O2FLUX%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2FLUX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2SAT")) THEN 
+          med_diag%O2SAT%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2SAT%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CAL_CCD")) THEN 
+          med_diag%CAL_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%CAL_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ARG_CCD")) THEN 
+          med_diag%ARG_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%ARG_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SFR_OCAL")) THEN 
+          med_diag%SFR_OCAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%SFR_OCAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SFR_OARG")) THEN 
+          med_diag%SFR_OARG%dgsave = .TRUE.
+      ELSE 
+          med_diag%SFR_OARG%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("N_PROD")) THEN 
+          med_diag%N_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%N_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("N_CONS")) THEN 
+          med_diag%N_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%N_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("C_PROD")) THEN 
+          med_diag%C_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%C_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("C_CONS")) THEN 
+          med_diag%C_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%C_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_PROD")) THEN 
+          med_diag%O2_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_CONS")) THEN 
+          med_diag%O2_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_ANOX")) THEN 
+          med_diag%O2_ANOX%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_ANOX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_0100")) THEN 
+          med_diag%RR_0100%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_0100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_0500")) THEN 
+          med_diag%RR_0500%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_0500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_1000")) THEN 
+          med_diag%RR_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_N")) THEN 
+          med_diag%IBEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_FE")) THEN 
+          med_diag%IBEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_C")) THEN 
+          med_diag%IBEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_SI")) THEN 
+          med_diag%IBEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_CA")) THEN 
+          med_diag%IBEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_N")) THEN 
+          med_diag%OBEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_FE")) THEN 
+          med_diag%OBEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_C")) THEN 
+          med_diag%OBEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_SI")) THEN 
+          med_diag%OBEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_CA")) THEN 
+          med_diag%OBEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_N")) THEN 
+          med_diag%BEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_FE")) THEN 
+          med_diag%BEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_C")) THEN 
+          med_diag%BEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_SI")) THEN 
+          med_diag%BEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_CA")) THEN 
+          med_diag%BEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RUNOFF")) THEN 
+          med_diag%RUNOFF%dgsave = .TRUE.
+      ELSE 
+          med_diag%RUNOFF%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_N")) THEN 
+          med_diag%RIV_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_SI")) THEN 
+          med_diag%RIV_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_C")) THEN 
+          med_diag%RIV_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_ALK")) THEN 
+          med_diag%RIV_ALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_ALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETC")) THEN 
+          med_diag%DETC%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__100")) THEN 
+          med_diag%SDC__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__200")) THEN 
+          med_diag%SDC__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__500")) THEN 
+          med_diag%SDC__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC_1000")) THEN 
+          med_diag%SDC_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTC")) THEN 
+          med_diag%INVTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTALK")) THEN 
+          med_diag%INVTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTO2")) THEN 
+          med_diag%INVTO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("LYSO_CA")) THEN 
+          med_diag%LYSO_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%LYSO_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("COM_RESP")) THEN 
+          med_diag%COM_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%COM_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_LLOSS")) THEN 
+          med_diag%PN_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_LLOSS")) THEN 
+          med_diag%PD_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_LLOSS")) THEN 
+          med_diag%ZI_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_LLOSS")) THEN 
+          med_diag%ZE_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_N")) THEN 
+          med_diag%ZI_MES_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_D")) THEN 
+          med_diag%ZI_MES_D%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_D%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_C")) THEN 
+          med_diag%ZI_MES_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MESDC")) THEN 
+          med_diag%ZI_MESDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MESDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_EXCR")) THEN 
+          med_diag%ZI_EXCR%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_EXCR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_RESP")) THEN 
+          med_diag%ZI_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_GROW")) THEN 
+          med_diag%ZI_GROW%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_GROW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_N")) THEN 
+          med_diag%ZE_MES_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_D")) THEN 
+          med_diag%ZE_MES_D%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_D%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_C")) THEN 
+          med_diag%ZE_MES_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MESDC")) THEN 
+          med_diag%ZE_MESDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MESDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_EXCR")) THEN 
+          med_diag%ZE_EXCR%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_EXCR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_RESP")) THEN 
+          med_diag%ZE_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_GROW")) THEN 
+          med_diag%ZE_GROW%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_GROW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MDETC")) THEN 
+          med_diag%MDETC%dgsave = .TRUE.
+      ELSE 
+          med_diag%MDETC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMIDC")) THEN 
+          med_diag%GMIDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMIDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEDC")) THEN 
+          med_diag%GMEDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_ZMI")) THEN 
+          med_diag%INT_ZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_ZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_ZME")) THEN 
+          med_diag%INT_ZME%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_ZME%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_DET")) THEN 
+          med_diag%INT_DET%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_DET%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_DTC")) THEN 
+          med_diag%INT_DTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_DTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_SURF")) THEN 
+          med_diag%DMS_SURF%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_SURF%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ANDR")) THEN 
+          med_diag%DMS_ANDR%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ANDR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_SIMO")) THEN 
+          med_diag%DMS_SIMO%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_SIMO%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ARAN")) THEN 
+          med_diag%DMS_ARAN%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ARAN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_HALL")) THEN 
+          med_diag%DMS_HALL%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_HALL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ANDM")) THEN 
+          med_diag%DMS_ANDM%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ANDM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_XCO2")) THEN 
+          med_diag%ATM_XCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_XCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_FCO2")) THEN 
+          med_diag%OCN_FCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_FCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_FCO2")) THEN 
+          med_diag%ATM_FCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_FCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_RHOSW")) THEN 
+          med_diag%OCN_RHOSW%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_RHOSW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_SCHCO2")) THEN 
+          med_diag%OCN_SCHCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_SCHCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_KWCO2")) THEN 
+          med_diag%OCN_KWCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_KWCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_K0")) THEN 
+          med_diag%OCN_K0%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_K0%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO2STARAIR")) THEN 
+          med_diag%CO2STARAIR%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO2STARAIR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_DPCO2")) THEN 
+          med_diag%OCN_DPCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_DPCO2%dgsave = .FALSE.
+      ENDIF
+      !! UKESM additional
+      IF  (iom_use("CHL_MLD")) THEN 
+          med_diag%CHL_MLD%dgsave = .TRUE.
+      ELSE 
+          med_diag%CHL_MLD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CHL_CPL")) THEN 
+          med_diag%CHL_CPL%dgsave = .TRUE.
+      ELSE 
+          med_diag%CHL_CPL%dgsave = .FALSE.
+      ENDIF
+      !! 3D
+      IF  (iom_use("TPP3")) THEN 
+          med_diag%TPP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%TPP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETFLUX3")) THEN 
+          med_diag%DETFLUX3%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETFLUX3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMIN3N")) THEN 
+          med_diag%REMIN3N%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMIN3N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PH3")) THEN 
+          med_diag%PH3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PH3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_CAL3")) THEN 
+          med_diag%OM_CAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_CAL3%dgsave = .FALSE.
+      ENDIF
+      !!
+      !!----------------------------------------------------------------------
+      !! AXY (03/11/16): add in additional CMIP6 diagnostics
+      !!----------------------------------------------------------------------
+      !!
+      !! 2D fields
+      IF  (iom_use("epC100")) THEN 
+          med_diag%epC100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epC100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epCALC100")) THEN 
+          med_diag%epCALC100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epCALC100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epN100")) THEN 
+          med_diag%epN100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epN100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epSI100")) THEN 
+          med_diag%epSI100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epSI100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FGCO2")) THEN 
+          med_diag%FGCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%FGCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSIC")) THEN 
+          med_diag%INTDISSIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSIN")) THEN 
+          med_diag%INTDISSIN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSIN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSISI")) THEN 
+          med_diag%INTDISSISI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSISI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTTALK")) THEN 
+          med_diag%INTTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2min")) THEN 
+          med_diag%O2min%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2min%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZO2min")) THEN 
+          med_diag%ZO2min%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZO2min%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTALK")) THEN 
+          med_diag%FBDDTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIC")) THEN 
+          med_diag%FBDDTDIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIFE")) THEN 
+          med_diag%FBDDTDIFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIN")) THEN 
+          med_diag%FBDDTDIN%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDISI")) THEN 
+          med_diag%FBDDTDISI%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDISI%dgsave = .FALSE.
+      ENDIF
+      !!
+      !! 3D
+      IF  (iom_use("TPPD3")) THEN 
+          med_diag%TPPD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%TPPD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTALK3")) THEN 
+          med_diag%BDDTALK3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTALK3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIC3")) THEN 
+          med_diag%BDDTDIC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIFE3")) THEN 
+          med_diag%BDDTDIFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIN3")) THEN 
+          med_diag%BDDTDIN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDISI3")) THEN 
+          med_diag%BDDTDISI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDISI3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_NIT3")) THEN 
+          med_diag%FD_NIT3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_NIT3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_SIL3")) THEN 
+          med_diag%FD_SIL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_SIL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_CAR3")) THEN 
+          med_diag%FD_CAR3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_CAR3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_CAL3")) THEN 
+          med_diag%FD_CAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_CAL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO33")) THEN 
+          med_diag%CO33%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO33%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO3SATARAG3")) THEN 
+          med_diag%CO3SATARAG3%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO3SATARAG3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO3SATCALC3")) THEN 
+          med_diag%CO3SATCALC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO3SATCALC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DCALC3")) THEN 
+          med_diag%DCALC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%DCALC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("EXPC3")) THEN 
+          med_diag%EXPC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%EXPC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("EXPN3")) THEN 
+          med_diag%EXPN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%EXPN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FEDISS3")) THEN 
+          med_diag%FEDISS3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FEDISS3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FESCAV3")) THEN 
+          med_diag%FESCAV3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FESCAV3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MIGRAZP3")) THEN 
+          med_diag%MIGRAZP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MIGRAZP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MIGRAZD3")) THEN 
+          med_diag%MIGRAZD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MIGRAZD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZP3")) THEN 
+          med_diag%MEGRAZP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZD3")) THEN 
+          med_diag%MEGRAZD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZZ3")) THEN 
+          med_diag%MEGRAZZ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZZ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2SAT3")) THEN 
+          med_diag%O2SAT3%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2SAT3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PBSI3")) THEN 
+          med_diag%PBSI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PBSI3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PCAL3")) THEN 
+          med_diag%PCAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PCAL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMOC3")) THEN 
+          med_diag%REMOC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMOC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMJ3")) THEN 
+          med_diag%PNLIMJ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMJ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMN3")) THEN 
+          med_diag%PNLIMN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMFE3")) THEN 
+          med_diag%PNLIMFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMJ3")) THEN 
+          med_diag%PDLIMJ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMJ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMN3")) THEN 
+          med_diag%PDLIMN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMFE3")) THEN 
+          med_diag%PDLIMFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMSI3")) THEN 
+          med_diag%PDLIMSI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMSI3%dgsave = .FALSE.
+      ENDIF
+
+   END SUBROUTINE   trc_nam_iom_medusa
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                             No MEDUSA
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_medusa                      ! Empty routine
+   END  SUBROUTINE  trc_nam_medusa
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcopt_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcopt_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcopt_medusa.F90	(revision 9824)
@@ -0,0 +1,187 @@
+MODULE trcopt_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcopt_medusa  ***
+   !! TOP :   MEDUSA Compute the light availability in the water column
+   !!======================================================================
+   !! History :    -   !  1995-05  (M. Levy) Original code
+   !!              -   !  1999-09  (J.-M. Andre, M. Levy) 
+   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial
+   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x))
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                      MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_opt_medusa        :   Compute the light availability in the water column
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE prtctl_trc      ! Print control for debbuging
+   USE sms_medusa
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_opt_medusa   ! called in trcprg.F90
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_opt_medusa( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_opt_medusa  ***
+      !!
+      !! ** Purpose :   computes the light propagation in the water column
+      !!              and the euphotic layer depth
+      !!
+      !! ** Method  :   local par is computed in w layers using light propagation
+      !!              mean par in t layers are computed by integration
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zpig                                    ! total pigment
+      REAL(wp) ::   zkr                                     ! total absorption coefficient in red
+      REAL(wp) ::   zkg                                     ! total absorption coefficient in green
+      REAL(wp) ::   totchl                                  ! total Chl concentreation
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar100         ! irradiance at euphotic layer depth
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par
+
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      !! IF( kt == nit000 ) THEN
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_opt_medusa: MEDUSA optic-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      ! determination of surface irradiance
+      ! -----------------------------------
+      ! 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); 
+      !                 a "solution" to this is to set zpar0m to some minimal
+      !                 value such that zpar100 also has a non-zero value and
+      !                 euphotic depth can be calculated properly; note that,
+      !                 in older, non-diurnal versions of NEMO, this was much
+      !                 less of a problem; note also that, if pushed, I will
+      !                 claim that my minimal value of zpar0m refers to light
+      !                 from stars
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zpar0m(ji,jj) <= 0.0 ) zpar0m(ji,jj) = 0.001  ! = 1 mW/m2
+         ENDDO
+      ENDDO
+      zpar100(:,:)   = zpar0m(:,:) * 0.01
+      xpar   (:,:,1) = zpar0m(:,:)
+      zparr  (:,:,1) = 0.5 * zpar0m(:,:)
+      zparg  (:,:,1) = 0.5 * zpar0m(:,:)
+
+      ! determination of xpar
+      ! ---------------------
+
+      DO jk = 2, jpk                     ! determination of local par in w levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               totchl =trn(ji,jj,jk-1,jpchn)+trn(ji,jj,jk-1,jpchd)
+               zpig = MAX( TINY(0.), totchl/rpig) 
+               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
+               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
+            END DO
+        END DO
+      END DO
+
+      DO jk = 1, jpkm1                   ! mean par in t levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               totchl =trn(ji,jj,jk  ,jpchn)+trn(ji,jj,jk  ,jpchd)
+               zpig = MAX( TINY(0.), totchl/rpig) 
+               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
+               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
+               zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) )
+               zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) )
+               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
+            END DO
+         END DO
+      END DO
+
+      ! 3. Determination of euphotic layer depth
+      ! ----------------------------------------
+
+      ! Euphotic layer bottom level
+      neln(:,:) = 1                                           ! initialisation of EL level
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom
+              !                                                  ! nb. this is to ensure compatibility with
+              !                                                  ! nmld_trc definition in trd_mld_trc_zint
+           END DO
+         END DO
+      ENDDO
+
+      ! Euphotic layer depth
+      !! Jpalm -- 06-03-2017 -- add init xze, to avoid halo problems within the
+      !!                        writing process
+      xze(:,:) = 0.0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            xze(ji,jj) = fsdepw( ji, jj, neln(ji,jj) )            ! exact EL depth
+         END DO
+      ENDDO 
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('opt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+
+   END SUBROUTINE trc_opt_medusa
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_opt_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_opt_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_opt_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcopt_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcoxy_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcoxy_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcoxy_medusa.F90	(revision 9824)
@@ -0,0 +1,280 @@
+MODULE trcoxy_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcoxy_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2011-07  (A. Yool)             added for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA oxygen cycle
+   !!----------------------------------------------------------------------
+   !!   trc_oxy_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+
+      IMPLICIT NONE
+      PRIVATE
+      
+      PUBLIC   trc_oxy_medusa    ! called in trc_bio_medusa
+      PUBLIC   oxy_sato          ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - trc_oxy_medusa
+!      - CALLS oxy_schmidt
+!      - CALLS oxy_sato
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2,  &  !! inputs
+      kwo2, o2flux, o2sat )                               !! outputs
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates O2 change due to air-sea gas exchange
+      !! Author : Andrew Yool
+      !! Date   : 15/10/04 (revised 08/07/11)
+      !!
+      !! This subroutine calculates oxygen air-sea gas exchange in the
+      !! surface layer of the ocean.  The formulation is taken from one 
+      !! written by Ray Najjar for the OCMIP-2 project.  The routine
+      !! calls two other subroutines, oxy_schmidt.f (calculates Schmidt 
+      !! 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)
+      !!     kw660   gas transfer velocity           (m/s)
+      !!     pp0     surface pressure                (divided by 1 atm)
+      !!     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).  
+      !!
+!=======================================================================
+
+      implicit none
+!
+      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( out )   :: kwo2, o2flux, o2sat
+!
+      REAL(wp) :: o2schmidt, o2sato, mol_o2
+!
+! Oxygen to mol / m3
+!
+      mol_o2 = o2 / 1000.
+!
+! Calculate oxygen Schmidt number
+! 
+      call oxy_schmidt(pt, o2schmidt)
+!
+! Calculate the transfer velocity for O2 (m/s)
+!
+      kwo2 = kw660 * (660 / o2schmidt)**0.5
+!
+! Calculate the saturation concentration for oxygen (mol/m3)
+!
+      call oxy_sato(pt, ps, o2sato)
+      o2sat = o2sato * pp0
+!
+! Calculate time rate of change of O2 due to gas exchange (mol/m3/s)
+!
+      o2flux = kwo2 * (o2sat - mol_o2)
+!
+! Oxygen flux and saturation to mmol / m3
+!
+      o2sat  =  o2sat * 1000.
+      o2flux = o2flux * 1000.
+!
+      END SUBROUTINE trc_oxy_medusa
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+   SUBROUTINE oxy_schmidt( pt, &  !! input
+      o2_schmidt )                !! output
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates Schmidt number for ocean uptake of O2
+      !! Author : Andrew Yool
+      !! Date   : 14/10/04 (revised 08/07/11)
+      !! 
+      !! This subroutine calculates the Schmidt number for O2 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 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)
+      !! (*) o2_schmidt  oxygen Schmidt number
+      !! 
+      !! Where (*) is the function output.
+      !!
+!=======================================================================
+
+      implicit none
+!
+      REAL(wp) :: pt, o2_schmidt
+      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
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+   SUBROUTINE oxy_sato( pt, ps, &  !! inputs 
+      o2_sato )                    !! output
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates O2 saturation at 1 atm pressure
+      !! Author : Andrew Yool
+      !! Date   : 14/10/04 (revised 08/07/11)
+      !! 
+      !! This subroutine calculates the oxygen saturation concentration
+      !! at 1 atmosphere pressure in mol/m3 given ambient temperature
+      !! and salinity.  This formulation is (ostensibly) taken from 
+      !! Garcia & Gordon (1992, L&O, 1307-1312).  The function works
+      !! in the range -1.9 <= T <= 40, 0 <= S <= 42.
+      !!
+      !! Function inputs are (in order) : 
+      !!     pt       temperature (degrees C)
+      !!     ps       salinity (PSU)
+      !! (*) o2_sato  oxygen saturation (mol/m3)
+      !!
+      !! Where (*) is the function output (note its units).  
+      !!
+      !! Check value : T = 10, S = 35, oxy_sato = 0.282015 mol/m3
+      !!
+!=======================================================================
+
+      implicit none
+!
+      REAL(wp) :: pt, ps, o2_sato
+!
+      REAL(wp) :: a0, a1, a2, a3, a4, a5
+      REAL(wp) :: b0, b1, b2, b3
+      REAL(wp) :: c0
+!
+      REAL(wp) :: tt, tk, ts, ts2, ts3, ts4, ts5
+      REAL(wp) :: ans1, ans2
+!
+      data a0 /  2.00907    /
+      data a1 /  3.22014    /
+      data a2 /  4.05010    /
+      data a3 /  4.94457    /
+      data a4 / -2.56847E-1 /
+      data a5 /  3.88767    /
+!
+      data b0 / -6.24523E-3 /
+      data b1 / -7.37614E-3 /
+      data b2 / -1.03410E-2 /
+      data b3 / -8.17083E-3 /
+!
+      data c0 / -4.88682E-7 /
+!     
+      tt   = 298.15 - pt
+      tk   = 273.15 + pt
+      ts   = log(tt / tk)
+      ts2  = ts**2
+      ts3  = ts**3
+      ts4  = ts**4
+      ts5  = ts**5
+      ans1 = a0 + a1*ts + a2*ts2 + a3*ts3 + a4*ts4 + a5*ts5  &
+           + ps*(b0 + b1*ts + b2*ts2 + b3*ts3)               &
+           + c0*(ps*ps)
+      ans2 = exp(ans1)
+!
+!  Convert from ml/l to mol/m3
+!
+      o2_sato = (ans2 / 22391.6) * 1000.0
+!
+      END SUBROUTINE oxy_sato
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+   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( inout ) :: o2flux, o2sat
+
+      WRITE(*,*) 'trc_oxy_medusa: You should not have seen this print! error?', kt
+
+   END SUBROUTINE trc_oxy_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcoxy_medusa
+  
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsed_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsed_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsed_medusa.F90	(revision 9824)
@@ -0,0 +1,423 @@
+MODULE trcsed_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcsed_medusa  ***
+   !! TOP :   MEDUSA Compute loss of organic matter in the sediments
+   !!======================================================================
+   !! History :    -   !  1995-06 (M. Levy)  original code
+   !!              -   !  2000-12 (E. Kestenare)  clean up
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                      MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_sed_medusa        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_medusa
+   !! AXY (10/02/09)
+   USE iom
+   !! USE trc_nam_dia                   ! JPALM 13-11-2015 -- if iom_use for diag
+   !! USE trc_nam_iom_medusa            ! JPALM 13-11-2015 -- if iom_use for diag
+   USE fldread                          !  time interpolation
+   USE lbclnk
+   USE prtctl_trc                       ! Print control for debbuging
+   !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm
+   USE sbc_oce, ONLY: lk_oasis
+   USE oce,     ONLY: Dust_in_cpl
+   !! Check Dust dep
+# if defined key_debug_medusa   
+   !! USE trcrst, ONLY: trc_rst_dia_stat   !! variable stat
+# endif
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sed_medusa     ! called in ???
+   PUBLIC   trc_sed_medusa_sbc     
+   PUBLIC   trc_sed_medusa_dust 
+
+   !! * Module variables
+   !! INTEGER ::                   &
+     !! ryyss,                     &  !: number of seconds per year
+     !! rmtss                         !: number of seconds per month
+
+   !! AXY (10/02/09)
+   LOGICAL, PUBLIC  ::   bdustfer  !: boolean for dust input from the atmosphere
+   REAL(wp), PUBLIC ::                 &
+      sedfeinput = 1.e-9_wp  ,         &
+      dustsolub  = 0.014_wp
+   REAL(wp), PARAMETER :: Fe_dust_mratio = 0.035   !! Fe:dust mass ratio = 0.035
+   INTEGER , PARAMETER ::        nbtimes = 365     !: maximum number of times record in a file
+   INTEGER  :: ntimes_dust                         ! number of time steps in a file
+
+   INTEGER ::                          &
+      numdust,                         &
+      nflx1,  nflx2,                   &
+      nflx11, nflx12
+   
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
+
+   
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sed_medusa( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sed_medusa  ***
+      !!
+      !! ** Purpose :   compute the now trend due to the vertical sedimentation of
+      !!              detritus and add it to the general trend of detritus equations
+      !!
+      !! ** Method  :   this ROUTINE compute not exactly the advection but the
+      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr)
+      !!              using an upstream scheme
+      !!              the now vertical advection of tracers is given by:
+      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
+      !!              add this trend now to the general trend of tracer (ta,sa,tra):
+      !!                             tra = tra + dz(trn wn)
+      !!        
+      !!              IF 'key_trc_diabio' is defined, the now vertical advection
+      !!              trend of passive tracers is saved for futher diagnostics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !! AXY (10/02/09)
+      INTEGER  ::   jnt
+      !!
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   ztra
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork
+
+      !! AXY (10/02/09)
+      REAL(wp) ::   rfact2
+
+      CHARACTER (len=25) :: charout
+      
+      !! JPALM - 26-11-2015 -add iom_use for diagnostic
+       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+      !!---------------------------------------------------------------------
+      !!
+      IF( lk_iomput) THEN  
+           IF( med_diag%DSED%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,      zw2d )
+                zw2d(:,:)      = 0.0      !!
+           ENDIF
+      ENDIF
+      
+      !! AXY (10/02/09)
+      jnt = 1
+      rfact2 = 1.0
+
+      ! Number of seconds per year and per month
+      !! ryyss = nyear_len(1) * rday
+      !! rmtss = ryyss / raamo
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sed_medusa: MEDUSA sedimentation'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      ! sedimentation of detrital nitrogen : upstream scheme
+      ! ----------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital nitrogen sedimentation only - jpdet
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      !!    DO ji = 1, jpi
+      !!       zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) &
+      !!       & * rfact2 / fse3t(ji,jj,1)
+      !!       zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / &
+      !!       & (fse3t(ji,jj,1) * 28.1 * rmtss)
+      !!    END DO
+      !! END DO
+
+      ! sedimentation of detrital nitrogen : upstream scheme
+      ! ----------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital nitrogen sedimentation only - jpdet
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+      !
+      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
+      DO jk = 2, jpk
+         ! AXY (17/07/14): change "0.d0" to "0."
+         ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.d0) * tmask(:,:,jk-1)
+         zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.) * tmask(:,:,jk-1)
+         !
+         ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability 
+         !                 in shallower grid cells
+         ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0
+      END DO
+      !
+      ! tracer flux divergence at t-point added to the general trend
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1,jpi
+               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra
+               IF( med_diag%DSED%dgsave ) THEN
+                   zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400.
+               ENDIF   
+                
+            END DO
+         END DO
+      END DO
+      !
+      IF( med_diag%DSED%dgsave ) THEN
+           CALL iom_put( "DSED"  ,  zw2d)
+           CALL wrk_dealloc( jpi, jpj,    zw2d  )
+      ENDIF
+      !!
+# if defined key_roam
+
+      ! sedimentation of detrital carbon : upstream scheme
+      ! --------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital carbon sedimentation only - jpdtc
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+      !
+      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
+      DO jk = 2, jpk
+         ! AXY (17/07/14): change "0.d0" to "0."
+         ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.d0) * tmask(:,:,jk-1)
+         zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.) * tmask(:,:,jk-1)
+         !
+         ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability 
+         !                 in shallower grid cells
+         ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0
+      END DO
+      !
+      ! tracer flux divergence at t-point added to the general trend
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1,jpi
+               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra
+            END DO
+         END DO
+      END DO
+      !
+
+# endif
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sed')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+   END SUBROUTINE trc_sed_medusa
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (10/02/09)
+   !! JPALM -- 31-03-2016 -- Completely change trc_sed_medusa_sbc.
+   !!                     -- We now need to read dust file through a namelist.
+   !!                     To be able to use time varying dust depositions from
+   !!                     -- copy and adapt the PISCES p4z_sbc_ini subroutine
+   !!                     -- Only use the dust related part.      
+   SUBROUTINE trc_sed_medusa_sbc(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sed_medusa_sbc  ***
+      !!
+      !! ** Purpose :   Read and dust namelist and files.
+      !!                The interpolation is done in trc_sed through 
+      !!                "CALL fld_read( kt, 1, sf_dust )"
+      !!
+      !! ** Method  :   Read the sbc namelist, and the adapted dust file, if required
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   -- namelist sbc ref and cfg
+      !!                -- external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER  :: ji, jj, jk, jm, ifpr
+      INTEGER  :: ii0, ii1, ij0, ij1
+      INTEGER  :: numdust
+      INTEGER  :: ierr 
+      INTEGER  :: jfld                ! dummy loop arguments
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: isrow               ! index for ORCA1 starting row
+      REAL(wp) :: ztimes_dust
+      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust
+      !
+      CHARACTER(len=100)         ::  cn_dir       ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION(1)  ::   slf_d       ! array of namelist informations on the fields to read
+      TYPE(FLD_N)                ::   sn_dust     ! informations about the fields to be read
+      !
+      NAMELIST/nammedsbc/cn_dir, sn_dust, bdustfer 
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sed_medusa_sbc')
+      !
+      !                            !* set file information
+      REWIND( numnatp_ref )        ! Namelist nammedsbc in reference namelist : MEDUSA external sources of Dust
+      READ  ( numnatp_ref, nammedsbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )        ! Namelist nammedsbc in configuration namelist : MEDUSA external sources of Dust
+      READ  ( numnatp_cfg, nammedsbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nammedsbc )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' namelist : nammedsbc '
+          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
+          WRITE(numout,*) '    dust input from the atmosphere bdustfer     = ', bdustfer
+      END IF
+
+      ! dust input from the atmosphere
+      ! ------------------------------
+      IF( bdustfer ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         !! already allocated in sms_medusa
+         !!ALLOCATE( dust(jpi,jpj) )    ! allocation
+         !
+         slf_d(1) = sn_dust                          ! store namelist information in an array
+         !
+         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trc_sed_medusa_sbc: unable to allocate sf_dust structure' )
+         ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1))
+         IF( slf_d(1)%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
+         !
+         CALL fld_fill( sf_dust, slf_d, cn_dir, 'trc_sed_medusa_sbc', 'Atmospheric dust deposition', 'nammedsed' )
+         !
+         CALL fld_read( kt, 1, sf_dust )
+         dust(:,:) = sf_dust(1)%fnow(:,:,1)
+         !
+      ELSEIF (lk_oasis) THEN
+         dust = Dust_in_cpl
+      ELSE
+         dust(:,:) = 0.0
+      END IF
+      !
+      zirondep(:,:) = 0.e0     !! Initialisation of deposition variables
+      zirondep(:,:) = dust(:,:) * Fe_dust_mratio / xfe_mass * 1.e6 * 86400.      !! mmol-Fe/m2/d
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sed_medusa_sbc')
+      !
+   END SUBROUTINE trc_sed_medusa_sbc
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY & JPALM (28/02/17)
+
+   SUBROUTINE trc_sed_medusa_dust( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sed_medusa_dust  ***
+      !!
+      !! ** Purpose : compute current dust *before* trc_bio_medusa call
+      !!
+      !! ** Method  : does what it says on the tin
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sed_medusa_dust: MEDUSA dust timestep'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      !! AXY (04/11/13): replace this with a call in trc_ini_medusa
+      !! AXY (25/02/10)
+      !! call routine for populating CCD array if this is the first time-step
+      !! IF( kt == nittrc000 ) CALL medusa_ccd( kt )
+
+      !! AXY (04/11/13): replace this with a call in trc_ini_medusa
+      !! AXY (26/01/12)
+      !! call routine for populating river arrays if this is the first time-step
+      !! IF( kt == nittrc000 ) CALL medusa_river( kt )
+
+      !! AXY (10/02/09)
+      !! IF( (jnt == 1) .and. (bdustfer) )  CALL trc_sed_medusa_sbc( kt )
+
+      !! JPALM -- 31-03-2016 -- rewrite trc_sed_medusa_sbc.
+      !! IF (kt == nittrc000 ) CALL trc_sed_medusa_sbc 
+
+      !! JPALM -- 20-07-2016 -- adapt dust forcing fields reading and conversion
+      !!                     To read dust dep in kg-dust/m2/s instead of g-Fe/m2/month 
+      !!                     So all forcings and coupling dust dep are in the same SI units
+      !!                     and then convert in mmol-Fe/m2/day
+
+      IF( bdustfer ) THEN
+            CALL fld_read( kt, 1, sf_dust )
+            dust(:,:) = sf_dust(1)%fnow(:,:,1)
+      ELSEIF (lk_oasis) THEN
+         dust = Dust_in_cpl
+      ELSE
+         dust(:,:) = 0.0
+      ENDIF
+      !!
+      zirondep(:,:) = 0.e0     !! Initialisation of deposition variables
+      zirondep(:,:) = dust(:,:) * Fe_dust_mratio / xfe_mass * 1.e6 * 86400.  !! mmol-Fe/m2/d
+      
+      !! JPALM -- 20-07-2016 -- Zirondep and zsidep are not used.
+      !!                     So comment out the following lines. but keep them
+      !!                     as we may want to used them later on
+      !!================================================     
+      !!
+      !! zirondep(:,:,:) = 0.e0     !! Initialisation of deposition variables
+      !! zsidep  (:,:)   = 0.e0
+      !!
+      !! Iron and Si deposition at the surface
+      !! -------------------------------------
+      !!
+      !! DO jj = 1, jpj
+      !!    DO ji = 1, jpi
+      !!       zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) &
+      !!       & * rfact2 / fse3t(ji,jj,1)
+      !!       zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / &
+      !!       & (fse3t(ji,jj,1) * 28.1 * rmtss)
+      !!    END DO
+      !! END DO
+
+   END SUBROUTINE trc_sed_medusa_dust
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sed_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sed_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sed_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcsed_medusa
+
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsms_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsms_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcsms_medusa.F90	(revision 9824)
@@ -0,0 +1,143 @@
+MODULE trcsms_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcsms_medusa  ***
+   !! TOP :   Main module of the MEDUSA tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2017-08  (A. Yool) amend for slow detritus bug
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                       bio tracers
+   !!----------------------------------------------------------------------
+   !! trc_sms_medusa   : MEDUSA_TRC model main routine 
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE trcbio_medusa
+   USE trcopt_medusa
+   USE trcsed_medusa
+   USE trcavg_medusa
+   !! for SMS trends
+   USE par_medusa,    ONLY: jp_msa0, jp_msa1, jp_medusa
+   USE par_oce,       ONLY: jpi, jpj, jpk
+   USE trd_oce,       ONLY: jptra_sms, l_trdtrc
+   USE trdtrc
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_medusa   ! called by trcsms.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sms_medusa( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_medusa  ***  
+      !!
+      !! ** Purpose :   main routine of MEDUSA_TRC model
+      !!
+      !! ** Method  : - 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt   ! ocean time-step index
+      !! Loop variables
+      INTEGER :: jn
+      !! trend temporary array:
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrmed
+
+
+# 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,*)
+       IF(lwp) WRITE(numout,*) ' trc_sms_medusa:  MEDUSA model'
+       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ENDIF
+
+      !! MEDUSA SMS trends:
+      IF( l_trdtrc ) THEN
+          CALL wrk_alloc( jpi, jpj, jpk, jp_medusa, ztrmed )
+          ztrmed(:,:,:,:)=0.0  
+          DO jn = 1, jp_medusa
+            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)
+          END DO
+      END IF
+
+      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
+
+      !! AXY & JPALM (28/02/17): call dust before trc_bio_medusa (because of coupling)
+      CALL trc_sed_medusa_dust( kt ) ! dust submodel
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa_dust'
+      CALL flush(numout)
+# endif
+
+# if defined key_kill_medusa
+      !! MEDUSA skipped
+      IF(lwp) WRITE(numout,*) ' MEDUSA killed at kt =', kt
+      CALL flush(numout)
+# 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
+      
+!! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90)
+!!       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
+
+      !! MEDUSA SMS trends:
+      IF( l_trdtrc ) THEN
+          DO jn = 1, jp_medusa
+            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)-ztrmed(:,:,:,jn)
+            CALL trd_trc( ztrmed(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+          END DO
+          CALL wrk_dealloc( jpi, jpj, jpk, jp_medusa, ztrmed )
+      END IF
+
+
+   END SUBROUTINE trc_sms_medusa
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MEDUSA model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_medusa( kt )             ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcsms_medusa
+
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcwri_medusa.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcwri_medusa.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/trcwri_medusa.F90	(revision 9824)
@@ -0,0 +1,60 @@
+MODULE trcwri_medusa
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    MEDUSA :   Output of MEDUSA tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!             1.1  !  2013-05 (A. Yool)  converted for MEDUSA
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput && defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                           MEDUSA model
+   !!----------------------------------------------------------------------
+   !! trc_wri_medusa   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE trc         ! passive tracers common variables 
+   USE sms_medusa  ! MEDUSA variables
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_medusa 
+
+CONTAINS
+
+   SUBROUTINE trc_wri_medusa
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_msa0, jp_msa1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_wri_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_medusa
+CONTAINS
+   SUBROUTINE trc_wri_medusa                     ! Empty routine  
+   END SUBROUTINE trc_wri_medusa
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_medusa
Index: /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/zooplankton.F90
===================================================================
--- /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/zooplankton.F90	(revision 9824)
+++ /branches/UKMO/dev_r5518_NIWA-ifort-syntax-fix/zooplankton.F90	(revision 9824)
@@ -0,0 +1,318 @@
+MODULE zooplankton_mod
+   !!======================================================================
+   !!                         ***  MODULE zooplankton_mod  ***
+   !! Calculates the zooplankton grazing
+   !!======================================================================
+   !! History :
+   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                                   MEDUSA bio-model
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+      
+   PUBLIC   zooplankton        ! Called in plankton.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zooplankton( jk )
+      !!------------------------------------------------------------------
+      !!                     ***  ROUTINE zooplankton  ***
+      !! This called from PLANKTON and calculates the zooplankton 
+      !! grazing
+      !!------------------------------------------------------------------
+      USE bio_medusa_mod,    ONLY: fgmed, fgmedc, fgmepd, fgmepds,       &
+                                   fgmepn, fgmezmi,                      & 
+                                   fgmid, fgmidc, fgmipn,                &
+                                   ficme, ficmi, finme, finmi,           &
+                                   fmeexcr, fmegrow, fmeresp,            &
+                                   fmiexcr, fmigrow, fmiresp,            & 
+                                   fsin,                                 &
+                                   fzme_i, fzme_o, fzmi_i, fzmi_o,       &
+                                   idf, idfval,                          &
+                                   zdet, zdtc, zphd, zphn, zzme, zzmi
+      USE dom_oce,           ONLY: e3t_0, e3t_n, tmask
+      USE par_kind,          ONLY: wp
+      USE in_out_manager,    ONLY: lwp, numout
+      USE par_oce,           ONLY: jpim1, jpjm1
+      USE phycst,            ONLY: rsmall
+      USE sms_medusa,        ONLY: xbetac, xbetan, xgme, xgmi,           &
+                                   xkc, xkme, xkmi, xphi,                &
+                                   xpmed, xpmepd, xpmepn, xpmezmi,       &
+                                   xpmid, xpmipn,                        &
+                                   xthetapd, xthetapn,                   &
+                                   xthetazme, xthetazmi
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+
+      !! Level
+      INTEGER, INTENT( in ) :: jk
+
+      INTEGER :: ji, jj
+
+      !! Microzooplankton grazing
+      REAL(wp) :: fmi1, fmi
+      REAL(wp) :: fstarmi, fmith
+      !!
+      !! Mesozooplankton grazing
+      REAL(wp) :: fme1, fme
+      REAL(wp) :: fstarme, fmeth
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk) == 1) then
+
+               !!----------------------------------------------------------
+               !! Zooplankton Grazing 
+               !! this code supplements the base grazing model with one that
+               !! considers the C:N ratio of grazed food and balances this
+               !! against the requirements of zooplankton growth; this model 
+               !! is derived from that of Anderson & Pondaven (2003)
+               !!
+               !! The current version of the code assumes a fixed C:N ratio 
+               !! for detritus (in contrast to Anderson & Pondaven, 2003), 
+               !! though the full equations are retained for future extension
+               !!----------------------------------------------------------
+               !!
+               !!----------------------------------------------------------
+               !! Microzooplankton first
+               !!----------------------------------------------------------
+               !!
+               fmi1           = (xkmi * xkmi) + (xpmipn * zphn(ji,jj) *      &
+                                                 zphn(ji,jj)) +              &
+                                (xpmid * zdet(ji,jj) * zdet(ji,jj))
+               fmi            = xgmi * zzmi(ji,jj) / fmi1
+               !! grazing on non-diatoms
+               fgmipn(ji,jj)  = fmi * xpmipn * zphn(ji,jj) * zphn(ji,jj)
+               !! grazing on detrital nitrogen
+               fgmid(ji,jj)   = fmi * xpmid  * zdet(ji,jj) * zdet(ji,jj)
+# if defined key_roam   
+               ! acc            
+               fgmidc(ji,jj)  = rsmall
+               !! grazing on detrital carbon
+               IF ( zdet(ji,jj) .GT. rsmall ) fgmidc(ji,jj)  =               &
+                  (zdtc(ji,jj) / (zdet(ji,jj) + tiny(zdet(ji,jj)))) *        &
+                  fgmid(ji,jj)
+# else
+               !! AXY (26/11/08): implicit detrital carbon change
+               !! grazing on detrital carbon
+               fgmidc(ji,jj)  = xthetad * fgmid(ji,jj)
+# endif
+# if defined key_debug_medusa
+               !! report microzooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! which translates to these incoming N and C fluxes
+               finmi(ji,jj)   = (1.0 - xphi) * (fgmipn(ji,jj) + fgmid(ji,jj))
+               ficmi(ji,jj)   = (1.0 - xphi) * ((xthetapn * fgmipn(ji,jj)) + &
+                                                fgmidc(ji,jj))
+               !!
+               !! the ideal food C:N ratio for microzooplankton
+               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
+               fstarmi = (xbetan * xthetazmi) / (xbetac * xkc)
+               !!
+               !! process these to determine proportioning of grazed N and C
+               !! (since there is no explicit consideration of respiration,
+               !! only growth and excretion are calculated here)
+               fmith = (ficmi(ji,jj) / (finmi(ji,jj) + tiny(finmi(ji,jj))))
+               if (fmith.ge.fstarmi) then
+                  fmigrow(ji,jj) = xbetan * finmi(ji,jj)
+                  fmiexcr(ji,jj) = 0.0
+               else
+                  fmigrow(ji,jj) = (xbetac * xkc * ficmi(ji,jj)) / xthetazmi
+                  fmiexcr(ji,jj) = ficmi(ji,jj) *                            &
+                                   ((xbetan / (fmith + tiny(fmith))) -       &
+                                    ((xbetac * xkc) / xthetazmi))
+               endif
+# if defined key_roam
+               fmiresp(ji,jj) = (xbetac * ficmi(ji,jj)) -                    &
+                                (xthetazmi * fmigrow(ji,jj))
+# endif
+
+# if defined key_debug_medusa
+               !! report microzooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmidc(',jk,')  = ', fgmidc(ji,jj)
+                  IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi(ji,jj)
+                  IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi(ji,jj)
+                  IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi
+                  IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith
+                  IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow(ji,jj)
+                  IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr(ji,jj)
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp(ji,jj)
+#  endif
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!----------------------------------------------------------
+               !! Mesozooplankton second
+               !!----------------------------------------------------------
+               !!
+               fme1           = (xkme * xkme) + (xpmepn * zphn(ji,jj) *       &
+                                                 zphn(ji,jj)) +               &
+                                (xpmepd * zphd(ji,jj) * zphd(ji,jj)) +        & 
+                                (xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)) +       &
+                                (xpmed * zdet(ji,jj) * zdet(ji,jj))
+               fme            = xgme * zzme(ji,jj) / fme1
+               !! grazing on non-diatoms
+               fgmepn(ji,jj)  = fme * xpmepn  * zphn(ji,jj) * zphn(ji,jj)
+               !! grazing on diatoms
+               fgmepd(ji,jj)  = fme * xpmepd  * zphd(ji,jj) * zphd(ji,jj)
+               !! grazing on diatom silicon
+               fgmepds(ji,jj) = fsin(ji,jj) * fgmepd(ji,jj)
+               !! grazing on microzooplankton
+               fgmezmi(ji,jj) = fme * xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)
+               !! grazing on detrital nitrogen
+               fgmed(ji,jj)   = fme * xpmed   * zdet(ji,jj) * zdet(ji,jj)
+# if defined key_roam
+               !! acc
+               fgmedc(ji,jj)  = rsmall
+               !! grazing on detrital carbon
+               IF ( zdet(ji,jj) .GT. rsmall ) fgmedc(ji,jj)  = (zdtc(ji,jj) / &
+                  (zdet(ji,jj) + tiny(zdet(ji,jj)))) * fgmed(ji,jj)
+# else
+               !! AXY (26/11/08): implicit detrital carbon change
+               !! grazing on detrital carbon
+               fgmedc(ji,jj)  = xthetad * fgmed(ji,jj)
+# endif
+               !!
+               !! which translates to these incoming N and C fluxes
+               finme(ji,jj)   = (1.0 - xphi) *                               &
+                                (fgmepn(ji,jj) + fgmepd(ji,jj) +             &
+                                 fgmezmi(ji,jj) + fgmed(ji,jj))
+               ficme(ji,jj)   = (1.0 - xphi) *                               &
+                                ((xthetapn * fgmepn(ji,jj)) +                &
+                                (xthetapd * fgmepd(ji,jj)) +                 &
+                                (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj))
+# if defined key_debug_medusa
+               !! report mesozooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1
+                  IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               !!
+               !! the ideal food C:N ratio for mesozooplankton
+               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
+               fstarme        = (xbetan * xthetazme) / (xbetac * xkc)
+               !!
+               !! process these to determine proportioning of grazed N and C
+               !! (since there is no explicit consideration of respiration,
+               !! only growth and excretion are calculated here)
+               fmeth   = (ficme(ji,jj) / (finme(ji,jj) + tiny(finme(ji,jj))))
+               if (fmeth.ge.fstarme) then
+                  fmegrow(ji,jj) = xbetan * finme(ji,jj)
+                  fmeexcr(ji,jj) = 0.0
+               else
+                  fmegrow(ji,jj) = (xbetac * xkc * ficme(ji,jj)) / xthetazme
+                  fmeexcr(ji,jj) = ficme(ji,jj) *                            &
+                                   ((xbetan / (fmeth + tiny(fmeth))) -       &
+                                    ((xbetac * xkc) / xthetazme))
+               endif
+# if defined key_roam
+               fmeresp(ji,jj) = (xbetac * ficme(ji,jj)) - (xthetazme *       &
+                                                           fmegrow(ji,jj))
+# endif
+
+# if defined key_debug_medusa
+               !! report mesozooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmed(',jk,')   = ', fgmed(ji,jj)
+                  IF (lwp) write (numout,*) 'fgmedc(',jk,')  = ', fgmedc(ji,jj)
+                  IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme(ji,jj)
+                  IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme(ji,jj)
+                  IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme
+                  IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth
+                  IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow(ji,jj)
+                  IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr(ji,jj)
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp(ji,jj)
+#  endif
+               endif
+# endif
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            if (tmask(ji,jj,jk) == 1) then
+               fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fse3t(ji,jj,jk) *          &
+                                ( fgmipn(ji,jj) + fgmid(ji,jj) )
+               fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fse3t(ji,jj,jk) *          &
+                                ( fmigrow(ji,jj) +                          &
+                                  (xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) + &
+                                  fmiexcr(ji,jj) + ((1.0 - xbetan) *        &
+                                                    finmi(ji,jj)) )
+               fzme_i(ji,jj)  = fzme_i(ji,jj)  + fse3t(ji,jj,jk) *          &
+                                ( fgmepn(ji,jj) + fgmepd(ji,jj) +           &
+                                  fgmezmi(ji,jj) + fgmed(ji,jj) )
+               fzme_o(ji,jj)  = fzme_o(ji,jj)  + fse3t(ji,jj,jk) *          &
+                                ( fmegrow(ji,jj) +                          &
+                                  (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) +  &
+                                  fgmezmi(ji,jj) + fgmed(ji,jj))) +         &
+                                  fmeexcr(ji,jj) + ((1.0 - xbetan) *        &
+                                                    finme(ji,jj)) )
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE zooplankton
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE zooplankton( )                    ! Empty routine
+      WRITE(*,*) 'zooplankton: You should not have seen this print! error?'
+   END SUBROUTINE zooplankton
+#endif 
+
+   !!======================================================================
+END MODULE zooplankton_mod
