Ignore:
Timestamp:
2017-05-25T18:43:39+02:00 (4 years ago)
Author:
jpalmier
Message:

JPALM — reverse MEDUSA cleaning and update MOCSY

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r7894 r8074  
    2020   !!  -   !  2015-10  (J. Palm)              Update for diag outputs through iom_use   
    2121   !!  -   !  2016-11  (A. Yool)              Updated diags for CMIP6 
    22    !!  -   !  2017-03  (A. Yool)              Updated DMS for DIN limitation 
    23    !!  -   !  2017-04  (A. Yool)              Simplify code to remove unused options, etc. 
    24    !!                                         - remove ln_diatrc, etc. code 
    25    !!                                         - remove PML carbonate chemistry code 
    26    !!                                         - remove defunct iron scavenging code 
    27    !!                                         - remove defunct debug diagnostic code 
    2822   !!---------------------------------------------------------------------- 
    2923   !! 
     
    3226   !! Updates for the ROAM project include: 
    3327   !!   - addition of DIC, alkalinity, detrital carbon and oxygen tracers 
    34    !!   - addition of air-sea fluxes of CO2 and oxygen (updated with MOCSY) 
     28   !!   - addition of air-sea fluxes of CO2 and oxygen 
    3529   !!   - periodic (monthly) calculation of full 3D carbonate chemistry  
    3630   !!   - detrital C:N ratio now free to evolve dynamically 
     
    4337   !!   - switch for ballast vs. Martin vs. Henson fast detritus remin. 
    4438   !!   - per GMD referee remarks, xfdfrac3 introduced for grazed PDS 
     39   !!---------------------------------------------------------------------- 
     40#endif 
    4541   !! 
     42#if defined key_mocsy 
     43   !!---------------------------------------------------------------------- 
    4644   !! Updates with the addition of MOCSY include: 
    4745   !!   - option to use PML or MOCSY carbonate chemistry (the latter is  
     
    7775# if defined key_roam 
    7876      USE gastransfer 
     77#  if defined key_mocsy 
    7978      USE mocsy_wrapper 
     79#  else 
     80      USE trcco2_medusa 
    8081#  endif 
    8182      USE trcoxy_medusa 
     
    110111CONTAINS 
    111112 
    112   SUBROUTINE trc_bio_medusa( kt ) 
    113     !!--------------------------------------------------------------------- 
    114     !!                     ***  ROUTINE trc_bio  *** 
    115     !! 
    116     !! ** Purpose :   compute the now trend due to biogeochemical processes 
    117     !!              and add it to the general trend of passive tracers equations 
    118     !! 
    119     !! ** Method  :   each now biological flux is calculated in function of now 
    120     !!              concentrations of tracers. 
    121     !!              depending on the tracer, these fluxes are sources or sinks. 
    122     !!              the total of the sources and sinks for each tracer 
    123     !!              is added to the general trend. 
    124     !!         
    125     !!                      tra = tra + zf...tra - zftra... 
    126     !!                                     |         | 
    127     !!                                     |         | 
    128     !!                                  source      sink 
    129     !!--------------------------------------------------------------------- 
    130     !! 
    131     !! 
    132     !!----------------------------------------------------------------------             
    133     !! Variable conventions 
    134     !!---------------------------------------------------------------------- 
    135     !! 
    136     !! names: z*** - state variable  
    137     !!        f*** - function (or temporary variable used in part of a function) 
    138     !!        x*** - parameter 
    139     !!        b*** - right-hand part (sources and sinks) 
    140     !!        i*** - integer variable (usually used in yes/no flags) 
    141     !! 
    142     !! time (integer timestep) 
    143     INTEGER, INTENT( in ) ::    kt 
    144     !! 
    145     !! spatial array indices 
    146     INTEGER  ::    ji,jj,jk,jn 
    147     !! 
    148     !! AXY (27/07/10): add in indices for depth horizons (for sinking flux 
    149     !!                 and seafloor iron inputs) 
    150     !! INTEGER  ::    i0100, i0200, i0500, i1000, i1100 
    151     !! 
    152     !! model state variables 
    153     REAL(wp) ::    zchn,zchd,zphn,zphd,zpds,zzmi 
    154     REAL(wp) ::    zzme,zdet,zdtc,zdin,zsil,zfer 
     113   SUBROUTINE trc_bio_medusa( kt ) 
     114      !!--------------------------------------------------------------------- 
     115      !!                     ***  ROUTINE trc_bio  *** 
     116      !! 
     117      !! ** Purpose :   compute the now trend due to biogeochemical processes 
     118      !!              and add it to the general trend of passive tracers equations 
     119      !! 
     120      !! ** Method  :   each now biological flux is calculated in function of now 
     121      !!              concentrations of tracers. 
     122      !!              depending on the tracer, these fluxes are sources or sinks. 
     123      !!              the total of the sources and sinks for each tracer 
     124      !!              is added to the general trend. 
     125      !!         
     126      !!                      tra = tra + zf...tra - zftra... 
     127      !!                                     |         | 
     128      !!                                     |         | 
     129      !!                                  source      sink 
     130      !!         
     131      !!              IF 'key_trc_diabio' defined , the biogeochemical trends 
     132      !!              for passive tracers are saved for futher diagnostics. 
     133      !!--------------------------------------------------------------------- 
     134      !! 
     135      !! 
     136      !!----------------------------------------------------------------------             
     137      !! Variable conventions 
     138      !!---------------------------------------------------------------------- 
     139      !! 
     140      !! names: z*** - state variable  
     141      !!        f*** - function (or temporary variable used in part of a function) 
     142      !!        x*** - parameter 
     143      !!        b*** - right-hand part (sources and sinks) 
     144      !!        i*** - integer variable (usually used in yes/no flags) 
     145      !! 
     146      !! time (integer timestep) 
     147      INTEGER, INTENT( in ) ::    kt 
     148      !! 
     149      !! spatial array indices 
     150      INTEGER  ::    ji,jj,jk,jn 
     151      !! 
     152      !! AXY (27/07/10): add in indices for depth horizons (for sinking flux 
     153      !!                 and seafloor iron inputs) 
     154      !! INTEGER  ::    i0100, i0200, i0500, i1000, i1100 
     155      !! 
     156      !! model state variables 
     157      REAL(wp) ::    zchn,zchd,zphn,zphd,zpds,zzmi 
     158      REAL(wp) ::    zzme,zdet,zdtc,zdin,zsil,zfer 
     159      REAL(wp) ::    zage 
    155160# if defined key_roam 
    156     REAL(wp) ::    zdic, zalk, zoxy 
    157     REAL(wp) ::    ztmp, zsal 
    158     REAL(wp) ::    zpho 
    159 # endif 
    160     !! 
    161     !! integrated source and sink terms 
    162     REAL(wp) ::    b0 
    163     !! AXY (23/08/13): changed from individual variables for each flux to 
    164     !!                 an array that holds all fluxes 
    165     REAL(wp), DIMENSION(jp_medusa) ::    btra 
    166     !! 
    167     !! primary production and chl related quantities       
    168     REAL(wp)                     ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn 
    169     REAL(wp)                     ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd 
    170     !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) 
    171     REAL(wp)                     ::    fjlim_pn, fjlim_pd 
    172     !! AXY (03/02/11): add in Liebig terms 
    173     REAL(wp) ::    fpnlim, fpdlim 
    174     !! AXY (16/07/09): add in Eppley curve functionality 
    175     REAL(wp) ::    loc_T,fun_T,xvpnT,xvpdT 
    176     INTEGER  ::    ieppley 
    177     !! AXY (16/05/11): per Katya's prompting, add in new T-dependence 
    178     !!                 for phytoplankton growth only (i.e. no change 
    179     !!                 for remineralisation) 
    180     REAL(wp) ::    fun_Q10 
    181     !! AXY (01/03/10): add in mixed layer PP diagnostics 
    182     REAL(wp), DIMENSION(jpi,jpj) ::  fprn_ml,fprd_ml 
    183     !! 
    184     !! nutrient limiting factors 
    185     REAL(wp) ::    fnln,ffln            !! N and Fe 
    186     REAL(wp) ::    fnld,ffld,fsld,fsld2 !! N, Fe and Si 
    187     !! 
    188     !! silicon cycle 
    189     REAL(wp) ::    fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss 
    190     !! 
    191     !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 
    192     REAL(wp) ::    ffetop,ffebot,ffescav 
    193     REAL(wp) ::    xLgF, xFeT, xFeF, xFeL         !! state variables for iron-ligand system 
    194     REAL(wp), DIMENSION(jpi,jpj) ::  xFree        !! state variables for iron-ligand system 
    195     REAL(wp) ::    xb_coef_tmp, xb2M4ac           !! iron-ligand parameters 
    196     REAL(wp) ::    xmaxFeF,fdeltaFe               !! max Fe' parameters 
    197     !! 
    198     !! local parameters for Moore et al. (2004) alternative scavenging scheme 
    199     REAL(wp) ::    fbase_scav,fscal_sink,fscal_part,fscal_scav 
    200     !! 
    201     !! local parameters for Moore et al. (2008) alternative scavenging scheme 
    202     REAL(wp) ::    fscal_csink,fscal_sisink,fscal_casink 
    203     !! 
    204     !! local parameters for Galbraith et al. (2010) alternative scavenging scheme 
    205     REAL(wp) ::    xCscav1, xCscav2, xk_org, xORGscav  !! organic portion of scavenging 
    206     REAL(wp) ::    xk_inorg, xINORGscav                !! inorganic portion of scavenging 
    207     !! 
    208     !! microzooplankton grazing 
    209     REAL(wp) ::    fmi1,fmi,fgmipn,fgmid,fgmidc 
    210     REAL(wp) ::    finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp 
    211     !! 
    212     !! mesozooplankton grazing 
    213     REAL(wp) ::    fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc 
    214     REAL(wp) ::    finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp 
    215     !! 
    216     !! mortality/Remineralisation (defunct parameter "fz" removed) 
    217     REAL(wp) ::    fdpn,fdpd,fdpds,fdzmi,fdzme,fdd 
     161      REAL(wp) ::    zdic, zalk, zoxy 
     162      REAL(wp) ::    ztmp, zsal 
     163# endif 
     164# if defined key_mocsy 
     165      REAL(wp) ::    zpho 
     166# endif 
     167      !! 
     168      !! integrated source and sink terms 
     169      REAL(wp) ::    b0 
     170      !! AXY (23/08/13): changed from individual variables for each flux to 
     171      !!                 an array that holds all fluxes 
     172      REAL(wp), DIMENSION(jp_medusa) ::    btra 
     173      !! 
     174      !! primary production and chl related quantities       
     175      REAL(wp)                     ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn 
     176      REAL(wp)                     ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd 
     177      !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) 
     178      REAL(wp)                     ::    fjlim_pn, fjlim_pd 
     179      !! AXY (03/02/11): add in Liebig terms 
     180      REAL(wp) ::    fpnlim, fpdlim 
     181      !! AXY (16/07/09): add in Eppley curve functionality 
     182      REAL(wp) ::    loc_T,fun_T,xvpnT,xvpdT 
     183      INTEGER  ::    ieppley 
     184      !! AXY (16/05/11): per Katya's prompting, add in new T-dependence 
     185      !!                 for phytoplankton growth only (i.e. no change 
     186      !!                 for remineralisation) 
     187      REAL(wp) ::    fun_Q10 
     188      !! AXY (01/03/10): add in mixed layer PP diagnostics 
     189      REAL(wp), DIMENSION(jpi,jpj) ::  fprn_ml,fprd_ml 
     190      !! 
     191      !! nutrient limiting factors 
     192      REAL(wp) ::    fnln,ffln            !! N and Fe 
     193      REAL(wp) ::    fnld,ffld,fsld,fsld2 !! N, Fe and Si 
     194      !! 
     195      !! silicon cycle 
     196      REAL(wp) ::    fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss 
     197      !! 
     198      !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 
     199      REAL(wp) ::    ffetop,ffebot,ffescav 
     200      REAL(wp) ::    xLgF, xFeT, xFeF, xFeL         !! state variables for iron-ligand system 
     201      REAL(wp), DIMENSION(jpi,jpj) ::  xFree        !! state variables for iron-ligand system 
     202      REAL(wp) ::    xb_coef_tmp, xb2M4ac           !! iron-ligand parameters 
     203      REAL(wp) ::    xmaxFeF,fdeltaFe               !! max Fe' parameters 
     204      !! 
     205      !! local parameters for Moore et al. (2004) alternative scavenging scheme 
     206      REAL(wp) ::    fbase_scav,fscal_sink,fscal_part,fscal_scav 
     207      !! 
     208      !! local parameters for Moore et al. (2008) alternative scavenging scheme 
     209      REAL(wp) ::    fscal_csink,fscal_sisink,fscal_casink 
     210      !! 
     211      !! local parameters for Galbraith et al. (2010) alternative scavenging scheme 
     212      REAL(wp) ::    xCscav1, xCscav2, xk_org, xORGscav  !! organic portion of scavenging 
     213      REAL(wp) ::    xk_inorg, xINORGscav                !! inorganic portion of scavenging 
     214      !! 
     215      !! microzooplankton grazing 
     216      REAL(wp) ::    fmi1,fmi,fgmipn,fgmid,fgmidc 
     217      REAL(wp) ::    finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp 
     218      !! 
     219      !! mesozooplankton grazing 
     220      REAL(wp) ::    fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc 
     221      REAL(wp) ::    finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp 
     222      !! 
     223      !! mortality/Remineralisation (defunct parameter "fz" removed) 
     224      REAL(wp) ::    fdpn,fdpd,fdpds,fdzmi,fdzme,fdd 
    218225# if defined key_roam 
    219     REAL(wp) ::    fddc 
    220 # endif 
    221     REAL(wp) ::    fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2 
    222     REAL(wp) ::    fslown, fslowc 
    223     REAL(wp), DIMENSION(jpi,jpj) ::    fslownflux, fslowcflux 
    224     REAL(wp) ::    fregen,fregensi 
    225     REAL(wp), DIMENSION(jpi,jpj) ::    fregenfast,fregenfastsi 
     226      REAL(wp) ::    fddc 
     227# endif 
     228      REAL(wp) ::    fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2 
     229      REAL(wp) ::    fslown, fslowc 
     230      REAL(wp), DIMENSION(jpi,jpj) ::    fslownflux, fslowcflux 
     231      REAL(wp) ::    fregen,fregensi 
     232      REAL(wp), DIMENSION(jpi,jpj) ::    fregenfast,fregenfastsi 
    226233# if defined key_roam 
    227     REAL(wp) ::    fregenc 
    228     REAL(wp), DIMENSION(jpi,jpj) ::    fregenfastc 
    229 # endif 
    230     !! 
    231     !! particle flux 
    232     REAL(WP) ::    fthk,fdep,fdep1,fdep2,flat,fcaco3 
    233     REAL(WP) ::    ftempn,ftempsi,ftempfe,ftempc,ftempca 
    234     REAL(wp) ::    freminn,freminsi,freminfe,freminc,freminca 
    235     REAL(wp), DIMENSION(jpi,jpj) ::    ffastn,ffastsi,ffastfe,ffastc,ffastca 
    236     REAL(wp) ::    fleftn,fleftsi,fleftfe,fleftc,fleftca 
    237     REAL(wp) ::    fheren,fheresi,fherefe,fherec,fhereca 
    238     REAL(wp) ::    fprotf 
    239     REAL(wp), DIMENSION(jpi,jpj) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca 
    240     REAL(wp), DIMENSION(jpi,jpj) ::    fccd 
    241     REAL(wp) ::    fccd_dep 
    242     !! AXY (28/11/16): fix mbathy bug 
    243     INTEGER  ::    jmbathy 
    244     !! 
    245     !! AXY (06/07/11): alternative fast detritus schemes 
    246     REAL(wp) ::    fb_val, fl_sst 
    247     !! 
    248     !! AXY (08/07/11): fate of fast detritus reaching the seafloor 
    249     REAL(wp) ::    ffast2slown,ffast2slowfe,ffast2slowc 
    250     !! 
    251     !! conservation law 
    252     REAL(wp) ::    fnit0,fsil0,ffer0  
     234      REAL(wp) ::    fregenc 
     235      REAL(wp), DIMENSION(jpi,jpj) ::    fregenfastc 
     236# endif 
     237      !! 
     238      !! particle flux 
     239      REAL(WP) ::    fthk,fdep,fdep1,fdep2,flat,fcaco3 
     240      REAL(WP) ::    ftempn,ftempsi,ftempfe,ftempc,ftempca 
     241      REAL(wp) ::    freminn,freminsi,freminfe,freminc,freminca 
     242      REAL(wp), DIMENSION(jpi,jpj) ::    ffastn,ffastsi,ffastfe,ffastc,ffastca 
     243      REAL(wp) ::    fleftn,fleftsi,fleftfe,fleftc,fleftca 
     244      REAL(wp) ::    fheren,fheresi,fherefe,fherec,fhereca 
     245      REAL(wp) ::    fprotf 
     246      REAL(wp), DIMENSION(jpi,jpj) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca 
     247      REAL(wp), DIMENSION(jpi,jpj) ::    fccd 
     248      REAL(wp) ::    fccd_dep 
     249      !! AXY (28/11/16): fix mbathy bug 
     250      INTEGER  ::    jmbathy 
     251      !! 
     252      !! AXY (06/07/11): alternative fast detritus schemes 
     253      REAL(wp) ::    fb_val, fl_sst 
     254      !! 
     255      !! AXY (08/07/11): fate of fast detritus reaching the seafloor 
     256      REAL(wp) ::    ffast2slown,ffast2slowfe,ffast2slowc 
     257      !! 
     258      !! conservation law 
     259      REAL(wp) ::    fnit0,fsil0,ffer0  
    253260# if defined key_roam 
    254     REAL(wp) ::    fcar0,falk0,foxy0  
     261      REAL(wp) ::    fcar0,falk0,foxy0  
    255262# endif       
    256     !!  
    257     !! temporary variables 
    258     REAL(wp) ::    fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8,fq9 
    259     !! 
    260     !! water column nutrient and flux integrals 
    261     REAL(wp), DIMENSION(jpi,jpj) ::    ftot_n,ftot_si,ftot_fe 
    262     REAL(wp), DIMENSION(jpi,jpj) ::    fflx_n,fflx_si,fflx_fe 
    263     REAL(wp), DIMENSION(jpi,jpj) ::    fifd_n,fifd_si,fifd_fe 
    264     REAL(wp), DIMENSION(jpi,jpj) ::    fofd_n,fofd_si,fofd_fe 
     263      !!  
     264      !! temporary variables 
     265      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8,fq9 
     266      !! 
     267      !! water column nutrient and flux integrals 
     268      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_n,ftot_si,ftot_fe 
     269      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_n,fflx_si,fflx_fe 
     270      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_n,fifd_si,fifd_fe 
     271      REAL(wp), DIMENSION(jpi,jpj) ::    fofd_n,fofd_si,fofd_fe 
    265272# if defined key_roam 
    266     REAL(wp), DIMENSION(jpi,jpj) ::    ftot_c,ftot_a,ftot_o2 
    267     REAL(wp), DIMENSION(jpi,jpj) ::    fflx_c,fflx_a,fflx_o2 
    268     REAL(wp), DIMENSION(jpi,jpj) ::    fifd_c,fifd_a,fifd_o2 
    269     REAL(wp), DIMENSION(jpi,jpj) ::    fofd_c,fofd_a,fofd_o2 
    270 # endif 
    271     !! 
    272     !! zooplankton grazing integrals 
    273     REAL(wp), DIMENSION(jpi,jpj) ::    fzmi_i,fzmi_o,fzme_i,fzme_o 
    274     !! 
    275     !! limitation term temporary variables 
    276     REAL(wp), DIMENSION(jpi,jpj) ::    ftot_pn,ftot_pd 
    277     REAL(wp), DIMENSION(jpi,jpj) ::    ftot_zmi,ftot_zme,ftot_det,ftot_dtc 
    278     !! use ballast scheme (1) or simple exponential scheme (0; a conservation test) 
    279     INTEGER  ::    iball 
    280     !! use biological fluxes (1) or not (0) 
    281     INTEGER  ::    ibio_switch 
    282     !! 
    283     !! diagnose fluxes (should only be used in 1D runs) 
    284     INTEGER  ::    idf, idfval 
    285     !! 
    286     !! nitrogen and silicon production and consumption 
    287     REAL(wp) ::    fn_prod, fn_cons, fs_prod, fs_cons 
    288     REAL(wp), DIMENSION(jpi,jpj) ::    fnit_prod, fnit_cons, fsil_prod, fsil_cons 
     273      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_c,ftot_a,ftot_o2 
     274      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_c,fflx_a,fflx_o2 
     275      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_c,fifd_a,fifd_o2 
     276      REAL(wp), DIMENSION(jpi,jpj) ::    fofd_c,fofd_a,fofd_o2 
     277# endif 
     278      !! 
     279      !! zooplankton grazing integrals 
     280      REAL(wp), DIMENSION(jpi,jpj) ::    fzmi_i,fzmi_o,fzme_i,fzme_o 
     281      !! 
     282      !! limitation term temporary variables 
     283      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_pn,ftot_pd 
     284      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_zmi,ftot_zme,ftot_det,ftot_dtc 
     285      !! use ballast scheme (1) or simple exponential scheme (0; a conservation test) 
     286      INTEGER  ::    iball 
     287      !! use biological fluxes (1) or not (0) 
     288      INTEGER  ::    ibio_switch 
     289      !! 
     290      !! diagnose fluxes (should only be used in 1D runs) 
     291      INTEGER  ::    idf, idfval 
     292      !! 
     293      !! nitrogen and silicon production and consumption 
     294      REAL(wp) ::    fn_prod, fn_cons, fs_prod, fs_cons 
     295      REAL(wp), DIMENSION(jpi,jpj) ::    fnit_prod, fnit_cons, fsil_prod, fsil_cons 
    289296# if defined key_roam 
    290     !! 
    291     !! flags to help with calculating the position of the CCD 
    292     INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg 
    293     !! 
    294     !! ROAM air-sea flux and diagnostic parameters 
    295     REAL(wp) ::    f_wind 
    296     !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) 
    297     REAL(wp) ::    f_xco2a 
    298     REAL(wp) ::    f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux 
    299     REAL(wp) ::    f_TDIC, f_TALK, f_dcf, f_henry 
    300     REAL(wp) ::    f_uwind, f_vwind, f_pp0 
    301     REAL(wp) ::    f_kw660, f_o2flux, f_o2sat, f_o2sat3 
    302     REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg 
    303     !! 
    304     !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
    305     REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm 
    306     REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 
    307     !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s 
    308     REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol 
    309     REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d 
    310     REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day 
    311     !! 
    312     INTEGER  ::    iters 
    313     REAL(wp) ::    f_year 
    314     INTEGER  ::    i_year 
    315     INTEGER  ::    iyr1, iyr2 
    316     !! 
    317     !! carbon, alkalinity production and consumption 
    318     REAL(wp) ::    fc_prod, fc_cons, fa_prod, fa_cons 
    319     REAL(wp), DIMENSION(jpi,jpj) ::    fcomm_resp 
    320     REAL(wp), DIMENSION(jpi,jpj) ::    fcar_prod, fcar_cons 
    321     !! 
    322     !! oxygen production and consumption (and non-consumption) 
    323     REAL(wp) ::    fo2_prod, fo2_cons, fo2_ncons, fo2_ccons 
    324     REAL(wp), DIMENSION(jpi,jpj) ::    foxy_prod, foxy_cons, foxy_anox 
    325     !! Jpalm (11-08-2014) 
    326     !! add DMS in MEDUSA for UKESM1 model 
    327     REAL(wp) ::    dms_surf 
    328     !! AXY (13/03/15): add in other DMS calculations 
    329     REAL(wp) ::    dms_andr, dms_simo, dms_aran, dms_hall, dms_nlim, dms_wtkn 
    330 # endif 
    331     !!  
    332     !! benthic fluxes 
    333     INTEGER  ::    ibenthic 
    334     REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe,              f_sbenin_c 
    335     REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca 
    336     REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca 
    337     REAL(wp) ::    zfact 
    338     !!  
    339     !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline 
    340     REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca 
    341     !! 
    342     !! riverine fluxes 
    343     REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 
    344     !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface 
    345     REAL(wp) ::    f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 
    346     !! 
    347     !! horizontal grid location 
    348     REAL(wp) ::    flatx, flonx 
    349     !! 
    350     !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 
    351     !! 2D var for diagnostics. 
    352     REAL(wp), POINTER, DIMENSION(:,:  ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d 
    353     REAL(wp), POINTER, DIMENSION(:,:  ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d 
    354     REAL(wp), POINTER, DIMENSION(:,:  ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d 
    355     REAL(wp), POINTER, DIMENSION(:,:  ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 
    356     REAL(wp), POINTER, DIMENSION(:,:  ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d 
    357     REAL(wp), POINTER, DIMENSION(:,:  ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d 
    358     REAL(wp), POINTER, DIMENSION(:,:  ) :: freminc2d, freminca2d 
    359     REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
     297      !! 
     298      !! flags to help with calculating the position of the CCD 
     299      INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg 
     300      !! 
     301      !! ROAM air-sea flux and diagnostic parameters 
     302      REAL(wp) ::    f_wind 
     303      !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) 
     304      REAL(wp) ::    f_xco2a 
     305      REAL(wp) ::    f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux 
     306      REAL(wp) ::    f_TDIC, f_TALK, f_dcf, f_henry 
     307      REAL(wp) ::    f_uwind, f_vwind, f_pp0 
     308      REAL(wp) ::    f_kw660, f_o2flux, f_o2sat, f_o2sat3 
     309      REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg 
     310      !! 
     311      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
     312      REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm 
     313      REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 
     314      !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s 
     315      REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol 
     316      REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d 
     317      REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day 
     318 
     319      !! 
     320      INTEGER  ::    iters 
     321      REAL(wp) ::    f_year 
     322      INTEGER  ::    i_year 
     323      INTEGER  ::    iyr1, iyr2 
     324      !! 
     325      !! carbon, alkalinity production and consumption 
     326      REAL(wp) ::    fc_prod, fc_cons, fa_prod, fa_cons 
     327      REAL(wp), DIMENSION(jpi,jpj) ::    fcomm_resp 
     328      REAL(wp), DIMENSION(jpi,jpj) ::    fcar_prod, fcar_cons 
     329      !! 
     330      !! oxygen production and consumption (and non-consumption) 
     331      REAL(wp) ::    fo2_prod, fo2_cons, fo2_ncons, fo2_ccons 
     332      REAL(wp), DIMENSION(jpi,jpj) ::    foxy_prod, foxy_cons, foxy_anox 
     333      !! Jpalm (11-08-2014) 
     334      !! add DMS in MEDUSA for UKESM1 model 
     335      REAL(wp) ::    dms_surf 
     336      !! AXY (13/03/15): add in other DMS calculations 
     337      REAL(wp) ::    dms_andr, dms_simo, dms_aran, dms_hall 
     338 
     339# endif 
     340      !!  
     341      !! benthic fluxes 
     342      INTEGER  ::    ibenthic 
     343      REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe,              f_sbenin_c 
     344      REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca 
     345      REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca 
     346      REAL(wp) ::    zfact 
     347      !!  
     348      !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline 
     349      REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca 
     350      !! 
     351      !! riverine fluxes 
     352      REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 
     353      !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface 
     354      REAL(wp) ::    f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 
     355      !! 
     356      !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 
     357      !! 2D var for diagnostics. 
     358      REAL(wp), POINTER, DIMENSION(:,:  ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d 
     359      REAL(wp), POINTER, DIMENSION(:,:  ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d 
     360      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d 
     361      REAL(wp), POINTER, DIMENSION(:,:  ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 
     362      REAL(wp), POINTER, DIMENSION(:,:  ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d 
     363      REAL(wp), POINTER, DIMENSION(:,:  ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d 
     364      REAL(wp), POINTER, DIMENSION(:,:  ) :: freminc2d, freminca2d 
     365      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    360366# if defined key_roam 
    361     REAL(wp), POINTER, DIMENSION(:,:  ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d 
    362     REAL(wp), POINTER, DIMENSION(:,:  ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d 
    363     REAL(wp), POINTER, DIMENSION(:,:  ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d 
    364     REAL(wp), POINTER, DIMENSION(:,:  ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d 
    365     REAL(wp), POINTER, DIMENSION(:,:  ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d 
    366     REAL(wp), POINTER, DIMENSION(:,:  ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d 
    367     REAL(wp), POINTER, DIMENSION(:,:  ) :: dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d, dms_surf2d 
    368     REAL(wp), POINTER, DIMENSION(:,:  ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d 
    369     REAL(wp), POINTER, DIMENSION(:,:  ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d 
    370     REAL(wp), POINTER, DIMENSION(:,:  ) :: sfr_oarg2d, lyso_ca2d  
    371     !! AXY (23/11/16): extra MOCSY diagnostics 
    372     REAL(wp), POINTER, DIMENSION(:,:  ) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d 
    373     REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnrhosw_2d, f_ocnschco2_2d, f_ocnkwco2_2d 
    374     REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnk0_2d, f_co2starair_2d, f_ocndpco2_2d 
    375 # endif 
    376     !! 
    377     !! 3D var for diagnostics. 
    378     REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn 
    379     !! 
     367      REAL(wp), POINTER, DIMENSION(:,:  ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d 
     368      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d 
     369      REAL(wp), POINTER, DIMENSION(:,:  ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d 
     370      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d 
     371      REAL(wp), POINTER, DIMENSION(:,:  ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d 
     372      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d 
     373      REAL(wp), POINTER, DIMENSION(:,:  ) :: dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d, dms_surf2d 
     374      REAL(wp), POINTER, DIMENSION(:,:  ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d 
     375      REAL(wp), POINTER, DIMENSION(:,:  ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d 
     376      REAL(wp), POINTER, DIMENSION(:,:  ) :: sfr_oarg2d, lyso_ca2d  
     377      !! AXY (23/11/16): extra MOCSY diagnostics 
     378      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d 
     379      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnrhosw_2d, f_ocnschco2_2d, f_ocnkwco2_2d 
     380      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnk0_2d, f_co2starair_2d, f_ocndpco2_2d 
     381# endif 
     382      !! 
     383      !! 3D var for diagnostics. 
     384      REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn 
     385      !! 
    380386# if defined key_roam 
    381     !! AXY (04/11/16) 
    382     !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef for simplicity) 
    383     REAL(wp), POINTER, DIMENSION(:,:  ) :: fgco2, intdissic, intdissin, intdissisi, inttalk, o2min, zo2min 
    384     REAL(wp), POINTER, DIMENSION(:,:  ) :: fbddtalk, fbddtdic, fbddtdife, fbddtdin, fbddtdisi 
    385     !! 
    386     !! 3D var for new CMIP6 diagnostics 
    387     REAL(wp), POINTER, DIMENSION(:,:,:) :: tppd3 
    388     REAL(wp), POINTER, DIMENSION(:,:,:) :: bddtalk3, bddtdic3, bddtdife3, bddtdin3, bddtdisi3 
    389     REAL(wp), POINTER, DIMENSION(:,:,:) :: fd_nit3, fd_sil3, fd_car3, fd_cal3 
    390     REAL(wp), POINTER, DIMENSION(:,:,:) :: co33, co3satarag3, co3satcalc3, dcalc3 
    391     REAL(wp), POINTER, DIMENSION(:,:,:) :: expc3, expn3 
    392     REAL(wp), POINTER, DIMENSION(:,:,:) :: fediss3, fescav3 
    393     REAL(wp), POINTER, DIMENSION(:,:,:) :: migrazp3, migrazd3, megrazp3, megrazd3, megrazz3 
    394     REAL(wp), POINTER, DIMENSION(:,:,:) :: o2sat3, pbsi3, pcal3, remoc3 
    395     REAL(wp), POINTER, DIMENSION(:,:,:) :: pnlimj3, pnlimn3, pnlimfe3, pdlimj3, pdlimn3, pdlimfe3, pdlimsi3 
    396 # endif 
    397     !!--------------------------------------------------------------------- 
     387      !! AXY (04/11/16) 
     388      !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef for simplicity) 
     389      REAL(wp), POINTER, DIMENSION(:,:  ) :: fgco2, intdissic, intdissin, intdissisi, inttalk, o2min, zo2min 
     390      REAL(wp), POINTER, DIMENSION(:,:  ) :: fbddtalk, fbddtdic, fbddtdife, fbddtdin, fbddtdisi 
     391      !! 
     392      !! 3D var for new CMIP6 diagnostics 
     393      REAL(wp), POINTER, DIMENSION(:,:,:) :: tppd3 
     394      REAL(wp), POINTER, DIMENSION(:,:,:) :: bddtalk3, bddtdic3, bddtdife3, bddtdin3, bddtdisi3 
     395      REAL(wp), POINTER, DIMENSION(:,:,:) :: fd_nit3, fd_sil3, fd_car3, fd_cal3 
     396      REAL(wp), POINTER, DIMENSION(:,:,:) :: co33, co3satarag3, co3satcalc3, dcalc3 
     397      REAL(wp), POINTER, DIMENSION(:,:,:) :: expc3, expn3 
     398      REAL(wp), POINTER, DIMENSION(:,:,:) :: fediss3, fescav3 
     399      REAL(wp), POINTER, DIMENSION(:,:,:) :: migrazp3, migrazd3, megrazp3, megrazd3, megrazz3 
     400      REAL(wp), POINTER, DIMENSION(:,:,:) :: o2sat3, pbsi3, pcal3, remoc3 
     401      REAL(wp), POINTER, DIMENSION(:,:,:) :: pnlimj3, pnlimn3, pnlimfe3, pdlimj3, pdlimn3, pdlimfe3, pdlimsi3 
     402# endif 
     403      !!--------------------------------------------------------------------- 
    398404 
    399405# if defined key_debug_medusa 
    400     IF ( lwp ) write (numout,*) 'trc_bio_medusa: variables defined' 
    401     CALL flush(numout) 
     406      IF (lwp) write (numout,*) 'trc_bio_medusa: variables defined' 
     407      CALL flush(numout) 
    402408# endif  
    403409 
    404     !! AXY (20/11/14): alter this to report on first MEDUSA call 
    405     !! IF( kt == nit000 ) THEN 
    406     IF( kt == nittrc000 ) THEN 
    407        IF(lwp) WRITE(numout,*) 
    408        IF(lwp) WRITE(numout,*) ' trc_bio: MEDUSA bio-model' 
    409        IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    410        IF(lwp) WRITE(numout,*) ' kt =',kt 
    411     ENDIF 
    412  
    413     !! AXY (13/01/12): is benthic model properly interactive? 0 = no, 1 = yes 
    414     ibenthic = 1 
    415  
    416     !!---------------------------------------------------------------------- 
    417     !! b0 is present for debugging purposes; using b0 = 0 sets the tendency 
    418     !! terms of all biological equations to 0. 
    419     !!---------------------------------------------------------------------- 
    420     !! 
    421     !! AXY (03/09/14): probably not the smartest move ever, but it'll fit 
    422     !!                 the bill for now; another item on the things-to-sort- 
    423     !!       out-in-the-future list ... 
     410      !! AXY (20/11/14): alter this to report on first MEDUSA call 
     411      !! IF( kt == nit000 ) THEN 
     412      IF( kt == nittrc000 ) THEN 
     413         IF(lwp) WRITE(numout,*) 
     414         IF(lwp) WRITE(numout,*) ' trc_bio: MEDUSA bio-model' 
     415         IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     416    IF(lwp) WRITE(numout,*) ' kt =',kt 
     417      ENDIF 
     418 
     419      !! AXY (13/01/12): is benthic model properly interactive? 0 = no, 1 = yes 
     420      ibenthic = 1 
     421 
     422      !! not sure what this is for; it's not used anywhere; commenting out 
     423      !! fbodn(:,:) = 0.e0    
     424 
     425      !! 
     426      IF( ln_diatrc ) THEN 
     427         !! blank 2D diagnostic array 
     428         trc2d(:,:,:) = 0.e0 
     429         !! 
     430         !! blank 3D diagnostic array 
     431         trc3d(:,:,:,:) = 0.e0 
     432      ENDIF 
     433 
     434      !!---------------------------------------------------------------------- 
     435      !! b0 is present for debugging purposes; using b0 = 0 sets the tendency 
     436      !! terms of all biological equations to 0. 
     437      !!---------------------------------------------------------------------- 
     438      !! 
     439      !! AXY (03/09/14): probably not the smartest move ever, but it'll fit 
     440      !!                 the bill for now; another item on the things-to-sort- 
     441      !!     out-in-the-future list ... 
    424442# if defined key_kill_medusa 
    425     b0 = 0. 
     443      b0 = 0. 
    426444# else 
    427     b0 = 1. 
    428 # endif 
    429     !!---------------------------------------------------------------------- 
    430     !! fast detritus ballast scheme (0 = no; 1 = yes) 
    431     !! alternative to ballast scheme is same scheme but with no ballast 
    432     !! protection (not dissimilar to Martin et al., 1987) 
    433     !!---------------------------------------------------------------------- 
    434     !! 
    435     iball = 1 
    436  
    437     !!---------------------------------------------------------------------- 
    438     !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output 
    439     !! these should *only* be used in 1D since they give comprehensive 
    440     !! output for ecological functions in the model; primarily used in 
    441     !! debugging 
    442     !!---------------------------------------------------------------------- 
    443     !! 
    444     idf    = 0 
    445     !! 
    446     !! timer mechanism 
    447     if (kt/120*120.eq.kt) then 
    448        idfval = 1 
    449     else 
    450        idfval = 0 
    451     endif 
    452  
    453     !!---------------------------------------------------------------------- 
    454     !! blank fast-sinking detritus 2D fields 
    455     !!---------------------------------------------------------------------- 
    456     !! 
    457     ffastn(:,:)  = 0.0        !! organic nitrogen 
    458     ffastsi(:,:) = 0.0        !! biogenic silicon 
    459     ffastfe(:,:) = 0.0        !! organic iron 
    460     ffastc(:,:)  = 0.0        !! organic carbon 
    461     ffastca(:,:) = 0.0        !! biogenic calcium carbonate 
    462     !! 
    463     fsedn(:,:)   = 0.0        !! Seafloor flux of N  
    464     fsedsi(:,:)  = 0.0        !! Seafloor flux of Si 
    465     fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe 
    466     fsedc(:,:)   = 0.0        !! Seafloor flux of C 
    467     fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3 
    468     !! 
    469     fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus) 
    470     fregenfastsi(:,:) = 0.0   !! integrated Si regeneration (fast detritus) 
     445      b0 = 1. 
     446# endif 
     447      !!---------------------------------------------------------------------- 
     448      !! fast detritus ballast scheme (0 = no; 1 = yes) 
     449      !! alternative to ballast scheme is same scheme but with no ballast 
     450      !! protection (not dissimilar to Martin et al., 1987) 
     451      !!---------------------------------------------------------------------- 
     452      !! 
     453      iball = 1 
     454 
     455      !!---------------------------------------------------------------------- 
     456      !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output 
     457      !! these should *only* be used in 1D since they give comprehensive 
     458      !! output for ecological functions in the model; primarily used in 
     459      !! debugging 
     460      !!---------------------------------------------------------------------- 
     461      !! 
     462      idf    = 0 
     463      !! 
     464      !! timer mechanism 
     465      if (kt/120*120.eq.kt) then 
     466         idfval = 1 
     467      else 
     468         idfval = 0 
     469      endif 
     470 
     471      !!---------------------------------------------------------------------- 
     472      !! blank fast-sinking detritus 2D fields 
     473      !!---------------------------------------------------------------------- 
     474      !! 
     475      ffastn(:,:)  = 0.0        !! organic nitrogen 
     476      ffastsi(:,:) = 0.0        !! biogenic silicon 
     477      ffastfe(:,:) = 0.0        !! organic iron 
     478      ffastc(:,:)  = 0.0        !! organic carbon 
     479      ffastca(:,:) = 0.0        !! biogenic calcium carbonate 
     480      !! 
     481      fsedn(:,:)   = 0.0        !! Seafloor flux of N  
     482      fsedsi(:,:)  = 0.0        !! Seafloor flux of Si 
     483      fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe 
     484      fsedc(:,:)   = 0.0        !! Seafloor flux of C 
     485      fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3 
     486      !! 
     487      fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus) 
     488      fregenfastsi(:,:) = 0.0   !! integrated Si regeneration (fast detritus) 
    471489# if defined key_roam 
    472     fregenfastc(:,:)  = 0.0   !! integrated  C regeneration (fast detritus) 
    473 # endif 
    474     !! 
    475     fccd(:,:)    = 0.0        !! last depth level before CCD 
    476  
    477     !!---------------------------------------------------------------------- 
    478     !! blank nutrient/flux inventories 
    479     !!---------------------------------------------------------------------- 
    480     !! 
    481     fflx_n(:,:)  = 0.0        !! nitrogen flux total 
    482     fflx_si(:,:) = 0.0        !! silicon  flux total 
    483     fflx_fe(:,:) = 0.0        !! iron     flux total 
    484     fifd_n(:,:)  = 0.0        !! nitrogen fast detritus production 
    485     fifd_si(:,:) = 0.0        !! silicon  fast detritus production 
    486     fifd_fe(:,:) = 0.0        !! iron     fast detritus production 
    487     fofd_n(:,:)  = 0.0        !! nitrogen fast detritus remineralisation 
    488     fofd_si(:,:) = 0.0        !! silicon  fast detritus remineralisation 
    489     fofd_fe(:,:) = 0.0        !! iron     fast detritus remineralisation 
     490      fregenfastc(:,:)  = 0.0   !! integrated  C regeneration (fast detritus) 
     491# endif 
     492      !! 
     493      fccd(:,:)    = 0.0        !! last depth level before CCD 
     494 
     495      !!---------------------------------------------------------------------- 
     496      !! blank nutrient/flux inventories 
     497      !!---------------------------------------------------------------------- 
     498      !! 
     499      fflx_n(:,:)  = 0.0        !! nitrogen flux total 
     500      fflx_si(:,:) = 0.0        !! silicon  flux total 
     501      fflx_fe(:,:) = 0.0        !! iron     flux total 
     502      fifd_n(:,:)  = 0.0        !! nitrogen fast detritus production 
     503      fifd_si(:,:) = 0.0        !! silicon  fast detritus production 
     504      fifd_fe(:,:) = 0.0        !! iron     fast detritus production 
     505      fofd_n(:,:)  = 0.0        !! nitrogen fast detritus remineralisation 
     506      fofd_si(:,:) = 0.0        !! silicon  fast detritus remineralisation 
     507      fofd_fe(:,:) = 0.0        !! iron     fast detritus remineralisation 
    490508# if defined key_roam 
    491     fflx_c(:,:)  = 0.0        !! carbon     flux total 
    492     fflx_a(:,:)  = 0.0        !! alkalinity flux total 
    493     fflx_o2(:,:) = 0.0        !! oxygen     flux total 
    494     ftot_c(:,:)  = 0.0        !! carbon     inventory 
    495     ftot_a(:,:)  = 0.0        !! alkalinity inventory 
    496     ftot_o2(:,:) = 0.0        !! oxygen     inventory 
    497     fifd_c(:,:)  = 0.0        !! carbon     fast detritus production 
    498     fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production 
    499     fifd_o2(:,:) = 0.0        !! oxygen     fast detritus production 
    500     fofd_c(:,:)  = 0.0        !! carbon     fast detritus remineralisation 
    501     fofd_a(:,:)  = 0.0        !! alkalinity fast detritus remineralisation 
    502     fofd_o2(:,:) = 0.0        !! oxygen     fast detritus remineralisation 
    503     !! 
    504     fnit_prod(:,:) = 0.0      !! (organic)   nitrogen production 
    505     fnit_cons(:,:) = 0.0      !! (organic)   nitrogen consumption 
    506     fsil_prod(:,:) = 0.0      !! (inorganic) silicon production 
    507     fsil_cons(:,:) = 0.0      !! (inorganic) silicon consumption 
    508     fcar_prod(:,:) = 0.0      !! (organic)   carbon production 
    509     fcar_cons(:,:) = 0.0      !! (organic)   carbon consumption 
    510     !! 
    511     foxy_prod(:,:) = 0.0      !! oxygen production 
    512     foxy_cons(:,:) = 0.0      !! oxygen consumption 
    513     foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption 
    514     !! 
    515 # endif 
    516     ftot_n(:,:)   = 0.0       !! N inventory  
    517     ftot_si(:,:)  = 0.0       !! Si inventory 
    518     ftot_fe(:,:)  = 0.0       !! Fe inventory 
    519     ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton 
    520     ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton 
    521     ftot_zmi(:,:) = 0.0       !! integrated microzooplankton 
    522     ftot_zme(:,:) = 0.0       !! integrated mesozooplankton 
    523     ftot_det(:,:) = 0.0       !! integrated slow detritus, nitrogen 
    524     ftot_dtc(:,:) = 0.0       !! integrated slow detritus, carbon 
    525     !! 
    526     fzmi_i(:,:)  = 0.0        !! material grazed by microzooplankton 
    527     fzmi_o(:,:)  = 0.0        !! ... sum of fate of this material 
    528     fzme_i(:,:)  = 0.0        !! material grazed by  mesozooplankton 
    529     fzme_o(:,:)  = 0.0        !! ... sum of fate of this material 
    530     !! 
    531     f_sbenin_n(:,:)  = 0.0    !! slow detritus N  -> benthic pool 
    532     f_sbenin_fe(:,:) = 0.0    !! slow detritus Fe -> benthic pool 
    533     f_sbenin_c(:,:)  = 0.0    !! slow detritus C  -> benthic pool 
    534     f_fbenin_n(:,:)  = 0.0    !! fast detritus N  -> benthic pool 
    535     f_fbenin_fe(:,:) = 0.0    !! fast detritus Fe -> benthic pool 
    536     f_fbenin_si(:,:) = 0.0    !! fast detritus Si -> benthic pool 
    537     f_fbenin_c(:,:)  = 0.0    !! fast detritus C  -> benthic pool 
    538     f_fbenin_ca(:,:) = 0.0    !! fast detritus Ca -> benthic pool 
    539     !! 
    540     f_benout_n(:,:)  = 0.0    !! benthic N  pool  -> dissolved 
    541     f_benout_fe(:,:) = 0.0    !! benthic Fe pool  -> dissolved 
    542     f_benout_si(:,:) = 0.0    !! benthic Si pool  -> dissolved 
    543     f_benout_c(:,:)  = 0.0    !! benthic C  pool  -> dissolved 
    544     f_benout_ca(:,:) = 0.0    !! benthic Ca pool  -> dissolved 
    545     !! 
    546     f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool  -> dissolved (when it shouldn't!) 
    547     !! 
    548     f_runoff(:,:)  = 0.0      !! riverine runoff 
    549     f_riv_n(:,:)   = 0.0      !! riverine N   input  
    550     f_riv_si(:,:)  = 0.0      !! riverine Si  input  
    551     f_riv_c(:,:)   = 0.0      !! riverine C   input  
    552     f_riv_alk(:,:) = 0.0      !! riverine alk input  
    553     !!  
    554     !! Jpalm -- 06-03-2017 -- Forgotten var to init 
    555     f_omarg(:,:) = 0.0        !! 
    556     f_omcal(:,:) = 0.0  
    557     xFree(:,:) = 0.0          !! state variables for iron-ligand system 
    558     fcomm_resp(:,:) = 0.0  
    559     fprn_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
    560     fprd_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
    561  
    562     !!---------------------------------------------------------------------- 
    563     !! allocate and initiate 2D diag 
    564     !!---------------------------------------------------------------------- 
    565     !! 
    566     IF ( lk_iomput .AND. .NOT.  ln_diatrc ) THEN  
    567        !! Juju :: add kt condition !! 
    568        if ( kt == nittrc000 )   CALL trc_nam_iom_medusa !! initialise iom_use test 
     509      fflx_c(:,:)  = 0.0        !! carbon     flux total 
     510      fflx_a(:,:)  = 0.0        !! alkalinity flux total 
     511      fflx_o2(:,:) = 0.0        !! oxygen     flux total 
     512      ftot_c(:,:)  = 0.0        !! carbon     inventory 
     513      ftot_a(:,:)  = 0.0        !! alkalinity inventory 
     514      ftot_o2(:,:) = 0.0        !! oxygen     inventory 
     515      fifd_c(:,:)  = 0.0        !! carbon     fast detritus production 
     516      fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production 
     517      fifd_o2(:,:) = 0.0        !! oxygen     fast detritus production 
     518      fofd_c(:,:)  = 0.0        !! carbon     fast detritus remineralisation 
     519      fofd_a(:,:)  = 0.0        !! alkalinity fast detritus remineralisation 
     520      fofd_o2(:,:) = 0.0        !! oxygen     fast detritus remineralisation 
     521      !! 
     522      fnit_prod(:,:) = 0.0      !! (organic)   nitrogen production 
     523      fnit_cons(:,:) = 0.0      !! (organic)   nitrogen consumption 
     524      fsil_prod(:,:) = 0.0      !! (inorganic) silicon production 
     525      fsil_cons(:,:) = 0.0      !! (inorganic) silicon consumption 
     526      fcar_prod(:,:) = 0.0      !! (organic)   carbon production 
     527      fcar_cons(:,:) = 0.0      !! (organic)   carbon consumption 
     528      !! 
     529      foxy_prod(:,:) = 0.0      !! oxygen production 
     530      foxy_cons(:,:) = 0.0      !! oxygen consumption 
     531      foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption 
     532      !! 
     533# endif 
     534      ftot_n(:,:)   = 0.0       !! N inventory  
     535      ftot_si(:,:)  = 0.0       !! Si inventory 
     536      ftot_fe(:,:)  = 0.0       !! Fe inventory 
     537      ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton 
     538      ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton 
     539      ftot_zmi(:,:) = 0.0       !! integrated microzooplankton 
     540      ftot_zme(:,:) = 0.0       !! integrated mesozooplankton 
     541      ftot_det(:,:) = 0.0       !! integrated slow detritus, nitrogen 
     542      ftot_dtc(:,:) = 0.0       !! integrated slow detritus, carbon 
     543      !! 
     544      fzmi_i(:,:)  = 0.0        !! material grazed by microzooplankton 
     545      fzmi_o(:,:)  = 0.0        !! ... sum of fate of this material 
     546      fzme_i(:,:)  = 0.0        !! material grazed by  mesozooplankton 
     547      fzme_o(:,:)  = 0.0        !! ... sum of fate of this material 
     548      !! 
     549      f_sbenin_n(:,:)  = 0.0    !! slow detritus N  -> benthic pool 
     550      f_sbenin_fe(:,:) = 0.0    !! slow detritus Fe -> benthic pool 
     551      f_sbenin_c(:,:)  = 0.0    !! slow detritus C  -> benthic pool 
     552      f_fbenin_n(:,:)  = 0.0    !! fast detritus N  -> benthic pool 
     553      f_fbenin_fe(:,:) = 0.0    !! fast detritus Fe -> benthic pool 
     554      f_fbenin_si(:,:) = 0.0    !! fast detritus Si -> benthic pool 
     555      f_fbenin_c(:,:)  = 0.0    !! fast detritus C  -> benthic pool 
     556      f_fbenin_ca(:,:) = 0.0    !! fast detritus Ca -> benthic pool 
     557      !! 
     558      f_benout_n(:,:)  = 0.0    !! benthic N  pool  -> dissolved 
     559      f_benout_fe(:,:) = 0.0    !! benthic Fe pool  -> dissolved 
     560      f_benout_si(:,:) = 0.0    !! benthic Si pool  -> dissolved 
     561      f_benout_c(:,:)  = 0.0    !! benthic C  pool  -> dissolved 
     562      f_benout_ca(:,:) = 0.0    !! benthic Ca pool  -> dissolved 
     563      !! 
     564      f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool  -> dissolved (when it shouldn't!) 
     565      !! 
     566      f_runoff(:,:)  = 0.0      !! riverine runoff 
     567      f_riv_n(:,:)   = 0.0      !! riverine N   input  
     568      f_riv_si(:,:)  = 0.0      !! riverine Si  input  
     569      f_riv_c(:,:)   = 0.0      !! riverine C   input  
     570      f_riv_alk(:,:) = 0.0      !! riverine alk input  
     571      !!  
     572      !! Jpalm -- 06-03-2017 -- Forgotten var to init 
     573      f_omarg(:,:) = 0.0        !! 
     574      f_omcal(:,:) = 0.0  
     575      xFree(:,:) = 0.0          !! state variables for iron-ligand system 
     576      fcomm_resp(:,:) = 0.0  
     577      fprn_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
     578      fprd_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
     579 
     580      !! 
     581      !! allocate and initiate 2D diag 
     582      !! ----------------------------- 
     583      !! Juju :: add kt condition !! 
     584      IF ( lk_iomput .AND. .NOT.  ln_diatrc ) THEN  
     585         !! 
     586         if ( kt == nittrc000 )   CALL trc_nam_iom_medusa !! initialise iom_use test 
     587         !! 
     588         CALL wrk_alloc( jpi, jpj,      zw2d ) 
     589         zw2d(:,:)      = 0.0   !! 
     590         IF ( med_diag%PRN%dgsave ) THEN 
     591            CALL wrk_alloc( jpi, jpj,   fprn2d    ) 
     592            fprn2d(:,:)      = 0.0 !! 
     593         ENDIF 
     594         IF ( med_diag%MPN%dgsave ) THEN 
     595            CALL wrk_alloc( jpi, jpj,   fdpn2d    ) 
     596            fdpn2d(:,:)      = 0.0 !! 
     597         ENDIF 
     598         IF ( med_diag%PRD%dgsave ) THEN 
     599            CALL wrk_alloc( jpi, jpj,   fprd2d    ) 
     600            fprd2d(:,:)      = 0.0 !! 
     601         ENDIF 
     602         IF( med_diag%MPD%dgsave ) THEN 
     603            CALL wrk_alloc( jpi, jpj,   fdpd2d    ) 
     604            fdpd2d(:,:)      = 0.0 !! 
     605         ENDIF 
     606         IF( med_diag%OPAL%dgsave ) THEN 
     607            CALL wrk_alloc( jpi, jpj,   fprds2d    ) 
     608            fprds2d(:,:)      = 0.0 !! 
     609         ENDIF 
     610         IF( med_diag%OPALDISS%dgsave ) THEN 
     611            CALL wrk_alloc( jpi, jpj,   fsdiss2d    ) 
     612            fsdiss2d(:,:)      = 0.0 !! 
     613         ENDIF 
     614         IF( med_diag%GMIPn%dgsave ) THEN 
     615            CALL wrk_alloc( jpi, jpj,   fgmipn2d    ) 
     616            fgmipn2d(:,:)      = 0.0 !! 
     617         ENDIF 
     618         IF( med_diag%GMID%dgsave ) THEN 
     619            CALL wrk_alloc( jpi, jpj,   fgmid2d    ) 
     620            fgmid2d(:,:)      = 0.0 !! 
     621         ENDIF 
     622         IF( med_diag%MZMI%dgsave ) THEN 
     623            CALL wrk_alloc( jpi, jpj,   fdzmi2d    ) 
     624            fdzmi2d(:,:)      = 0.0 !! 
     625         ENDIF 
     626         IF( med_diag%GMEPN%dgsave ) THEN 
     627            CALL wrk_alloc( jpi, jpj,   fgmepn2d    ) 
     628            fgmepn2d(:,:)      = 0.0 !! 
     629         ENDIF 
     630         IF( med_diag%GMEPD%dgsave ) THEN 
     631            CALL wrk_alloc( jpi, jpj,   fgmepd2d    ) 
     632            fgmepd2d(:,:)      = 0.0 !! 
     633         ENDIF 
     634         IF( med_diag%GMEZMI%dgsave ) THEN 
     635            CALL wrk_alloc( jpi, jpj,   fgmezmi2d    ) 
     636            fgmezmi2d(:,:)      = 0.0 !! 
     637         ENDIF 
     638         IF( med_diag%GMED%dgsave ) THEN 
     639            CALL wrk_alloc( jpi, jpj,   fgmed2d    ) 
     640            fgmed2d(:,:)      = 0.0 !! 
     641         ENDIF 
     642         IF( med_diag%MZME%dgsave ) THEN 
     643            CALL wrk_alloc( jpi, jpj,   fdzme2d    ) 
     644            fdzme2d(:,:)      = 0.0 !! 
     645         ENDIF 
     646         IF( med_diag%DETN%dgsave ) THEN 
     647            CALL wrk_alloc( jpi, jpj,   fslown2d    ) 
     648            fslown2d(:,:)      = 0.0 !! 
     649         ENDIF 
     650         IF( med_diag%MDET%dgsave ) THEN 
     651            CALL wrk_alloc( jpi, jpj,   fdd2d    ) 
     652            fdd2d(:,:)      = 0.0 !! 
     653         ENDIF       
     654         IF( med_diag%AEOLIAN%dgsave ) THEN 
     655            CALL wrk_alloc( jpi, jpj,   ffetop2d    ) 
     656            ffetop2d(:,:)      = 0.0 !! 
     657         ENDIF 
     658         IF( med_diag%BENTHIC%dgsave ) THEN 
     659            CALL wrk_alloc( jpi, jpj,    ffebot2d   ) 
     660            ffebot2d(:,:)      = 0.0 !! 
     661         ENDIF 
     662         IF( med_diag%SCAVENGE%dgsave ) THEN 
     663            CALL wrk_alloc( jpi, jpj,   ffescav2d    ) 
     664            ffescav2d(:,:)      = 0.0 !! 
     665         ENDIF 
     666         IF( med_diag%PN_JLIM%dgsave ) THEN 
     667            CALL wrk_alloc( jpi, jpj,   fjln2d    ) 
     668            fjln2d(:,:)      = 0.0 !! 
     669         ENDIF 
     670         IF( med_diag%PN_NLIM%dgsave ) THEN 
     671            CALL wrk_alloc( jpi, jpj,   fnln2d    ) 
     672            fnln2d(:,:)      = 0.0 !! 
     673         ENDIF 
     674         IF( med_diag%PN_FELIM%dgsave ) THEN 
     675            CALL wrk_alloc( jpi, jpj,   ffln2d    ) 
     676            ffln2d(:,:)      = 0.0 !! 
     677         ENDIF 
     678         IF( med_diag%PD_JLIM%dgsave ) THEN 
     679            CALL wrk_alloc( jpi, jpj,   fjld2d    ) 
     680            fjld2d(:,:)      = 0.0 !! 
     681         ENDIF 
     682         IF( med_diag%PD_NLIM%dgsave ) THEN 
     683            CALL wrk_alloc( jpi, jpj,   fnld2d    ) 
     684            fnld2d(:,:)      = 0.0 !! 
     685         ENDIF 
     686         IF( med_diag%PD_FELIM%dgsave ) THEN 
     687            CALL wrk_alloc( jpi, jpj,   ffld2d    ) 
     688            ffld2d(:,:)      = 0.0 !! 
     689         ENDIF 
     690         IF( med_diag%PD_SILIM%dgsave ) THEN 
     691            CALL wrk_alloc( jpi, jpj,   fsld2d2    ) 
     692            fsld2d2(:,:)      = 0.0 !! 
     693         ENDIF 
     694         IF( med_diag%PDSILIM2%dgsave ) THEN 
     695            CALL wrk_alloc( jpi, jpj,   fsld2d    ) 
     696            fsld2d(:,:)      = 0.0 !! 
     697         ENDIF 
     698!! 
     699!! skip SDT_XXXX diagnostics here 
     700!! 
     701         IF( med_diag%TOTREG_N%dgsave ) THEN 
     702            CALL wrk_alloc( jpi, jpj,   fregen2d    ) 
     703            fregen2d(:,:)      = 0.0 !! 
     704         ENDIF 
     705         IF( med_diag%TOTRG_SI%dgsave ) THEN 
     706            CALL wrk_alloc( jpi, jpj,   fregensi2d    ) 
     707            fregensi2d(:,:)      = 0.0 !! 
     708         ENDIF 
     709!! 
     710!! skip REG_XXXX diagnostics here 
     711!! 
     712         IF( med_diag%FASTN%dgsave ) THEN 
     713            CALL wrk_alloc( jpi, jpj,   ftempn2d    ) 
     714            ftempn2d(:,:)      = 0.0 !! 
     715         ENDIF 
     716         IF( med_diag%FASTSI%dgsave ) THEN 
     717            CALL wrk_alloc( jpi, jpj,   ftempsi2d    ) 
     718            ftempsi2d(:,:)      = 0.0 !! 
     719         ENDIF 
     720         IF( med_diag%FASTFE%dgsave ) THEN 
     721            CALL wrk_alloc( jpi, jpj,  ftempfe2d     ) 
     722            ftempfe2d(:,:)      = 0.0 !! 
     723         ENDIF 
     724         IF( med_diag%FASTC%dgsave ) THEN 
     725            CALL wrk_alloc( jpi, jpj,  ftempc2d     ) 
     726            ftempc2d(:,:)      = 0.0 !! 
     727         ENDIF 
     728         IF( med_diag%FASTCA%dgsave ) THEN 
     729            CALL wrk_alloc( jpi, jpj,   ftempca2d    ) 
     730            ftempca2d(:,:)      = 0.0 !! 
     731         ENDIF      
     732!! 
     733!! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here 
     734!! 
     735         IF( med_diag%REMINN%dgsave ) THEN 
     736            CALL wrk_alloc( jpi, jpj,    freminn2d   ) 
     737            freminn2d(:,:)      = 0.0 !! 
     738         ENDIF 
     739         IF( med_diag%REMINSI%dgsave ) THEN 
     740            CALL wrk_alloc( jpi, jpj,    freminsi2d   ) 
     741            freminsi2d(:,:)      = 0.0 !! 
     742         ENDIF 
     743         IF( med_diag%REMINFE%dgsave ) THEN 
     744            CALL wrk_alloc( jpi, jpj,    freminfe2d   ) 
     745            freminfe2d(:,:)      = 0.0 !! 
     746         ENDIF 
     747         IF( med_diag%REMINC%dgsave ) THEN 
     748            CALL wrk_alloc( jpi, jpj,   freminc2d    ) 
     749            freminc2d(:,:)      = 0.0 !!  
     750         ENDIF 
     751         IF( med_diag%REMINCA%dgsave ) THEN 
     752            CALL wrk_alloc( jpi, jpj,   freminca2d    ) 
     753            freminca2d(:,:)      = 0.0 !! 
     754         ENDIF 
     755# if defined key_roam 
     756!! 
     757!! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here 
     758!! 
     759         IF( med_diag%RR_0100%dgsave ) THEN 
     760            CALL wrk_alloc( jpi, jpj,    ffastca2d   ) 
     761            ffastca2d(:,:)      = 0.0 !! 
     762         ENDIF 
     763 
     764         IF( med_diag%ATM_PCO2%dgsave ) THEN 
     765            CALL wrk_alloc( jpi, jpj,    f_pco2a2d   ) 
     766            f_pco2a2d(:,:)      = 0.0 !! 
     767         ENDIF 
     768!! 
     769!! skip OCN_PH diagnostic here 
     770!! 
     771         IF( med_diag%OCN_PCO2%dgsave ) THEN 
     772            CALL wrk_alloc( jpi, jpj,    f_pco2w2d   ) 
     773            f_pco2w2d(:,:)      = 0.0 !! 
     774         ENDIF 
     775!! 
     776!! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here 
     777!! 
     778         IF( med_diag%CO2FLUX%dgsave ) THEN 
     779            CALL wrk_alloc( jpi, jpj,   f_co2flux2d    ) 
     780            f_co2flux2d(:,:)      = 0.0 !! 
     781         ENDIF 
     782!! 
     783!! skip OM_XXX diagnostics here 
     784!! 
     785         IF( med_diag%TCO2%dgsave ) THEN 
     786            CALL wrk_alloc( jpi, jpj,   f_TDIC2d    ) 
     787            f_TDIC2d(:,:)      = 0.0 !! 
     788         ENDIF 
     789         IF( med_diag%TALK%dgsave ) THEN 
     790            CALL wrk_alloc( jpi, jpj,    f_TALK2d   ) 
     791            f_TALK2d(:,:)      = 0.0 !! 
     792         ENDIF 
     793         IF( med_diag%KW660%dgsave ) THEN 
     794            CALL wrk_alloc( jpi, jpj,    f_kw6602d   ) 
     795            f_kw6602d(:,:)      = 0.0 !! 
     796         ENDIF 
     797         IF( med_diag%ATM_PP0%dgsave ) THEN 
     798            CALL wrk_alloc( jpi, jpj,    f_pp02d   ) 
     799            f_pp02d(:,:)      = 0.0 !! 
     800         ENDIF 
     801         IF( med_diag%O2FLUX%dgsave ) THEN 
     802            CALL wrk_alloc( jpi, jpj,   f_o2flux2d    ) 
     803            f_o2flux2d(:,:)      = 0.0 !! 
     804         ENDIF 
     805         IF( med_diag%O2SAT%dgsave ) THEN 
     806            CALL wrk_alloc( jpi, jpj,    f_o2sat2d   ) 
     807            f_o2sat2d(:,:)      = 0.0 !! 
     808         ENDIF  
     809!! 
     810!! skip XXX_CCD diagnostics here 
     811!!  
     812         IF( med_diag%SFR_OCAL%dgsave ) THEN 
     813            CALL wrk_alloc( jpi, jpj,    sfr_ocal2d  ) 
     814            sfr_ocal2d(:,:)      = 0.0 !! 
     815         ENDIF 
     816         IF( med_diag%SFR_OARG%dgsave ) THEN 
     817            CALL wrk_alloc( jpi, jpj,    sfr_oarg2d  ) 
     818            sfr_oarg2d(:,:)      = 0.0 !! 
     819         ENDIF 
     820!! 
     821!! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here 
     822!!  
     823         IF( med_diag%IBEN_N%dgsave ) THEN 
     824            CALL wrk_alloc( jpi, jpj,    iben_n2d  ) 
     825            iben_n2d(:,:)      = 0.0 !! 
     826         ENDIF 
     827         IF( med_diag%IBEN_FE%dgsave ) THEN 
     828            CALL wrk_alloc( jpi, jpj,   iben_fe2d   ) 
     829            iben_fe2d(:,:)      = 0.0 !! 
     830         ENDIF 
     831         IF( med_diag%IBEN_C%dgsave ) THEN 
     832            CALL wrk_alloc( jpi, jpj,   iben_c2d   ) 
     833            iben_c2d(:,:)      = 0.0 !! 
     834         ENDIF 
     835         IF( med_diag%IBEN_SI%dgsave ) THEN 
     836            CALL wrk_alloc( jpi, jpj,   iben_si2d   ) 
     837            iben_si2d(:,:)      = 0.0 !! 
     838         ENDIF 
     839         IF( med_diag%IBEN_CA%dgsave ) THEN 
     840            CALL wrk_alloc( jpi, jpj,   iben_ca2d   ) 
     841            iben_ca2d(:,:)      = 0.0 !! 
     842         ENDIF 
     843         IF( med_diag%OBEN_N%dgsave ) THEN 
     844            CALL wrk_alloc( jpi, jpj,    oben_n2d  ) 
     845            oben_n2d(:,:)      = 0.0 !! 
     846         ENDIF 
     847         IF( med_diag%OBEN_FE%dgsave ) THEN 
     848            CALL wrk_alloc( jpi, jpj,    oben_fe2d  ) 
     849            oben_fe2d(:,:)      = 0.0 !! 
     850         ENDIF 
     851         IF( med_diag%OBEN_C%dgsave ) THEN 
     852            CALL wrk_alloc( jpi, jpj,    oben_c2d  ) 
     853            oben_c2d(:,:)      = 0.0 !! 
     854         ENDIF 
     855         IF( med_diag%OBEN_SI%dgsave ) THEN 
     856            CALL wrk_alloc( jpi, jpj,    oben_si2d  ) 
     857            oben_si2d(:,:)      = 0.0 !! 
     858         ENDIF 
     859         IF( med_diag%OBEN_CA%dgsave ) THEN 
     860            CALL wrk_alloc( jpi, jpj,    oben_ca2d  ) 
     861            oben_ca2d(:,:)      = 0.0 !! 
     862         ENDIF 
     863!! 
     864!! skip BEN_XX diagnostics here 
     865!! 
     866         IF( med_diag%RIV_N%dgsave ) THEN 
     867            CALL wrk_alloc( jpi, jpj,    rivn2d   ) 
     868            rivn2d(:,:)      = 0.0 !! 
     869         ENDIF 
     870         IF( med_diag%RIV_SI%dgsave ) THEN 
     871            CALL wrk_alloc( jpi, jpj,    rivsi2d   ) 
     872            rivsi2d(:,:)      = 0.0 !! 
     873         ENDIF 
     874         IF( med_diag%RIV_C%dgsave ) THEN 
     875            CALL wrk_alloc( jpi, jpj,   rivc2d    ) 
     876            rivc2d(:,:)      = 0.0 !! 
     877         ENDIF 
     878         IF( med_diag%RIV_ALK%dgsave ) THEN 
     879            CALL wrk_alloc( jpi, jpj,    rivalk2d   ) 
     880            rivalk2d(:,:)      = 0.0 !! 
     881         ENDIF 
     882         IF( med_diag%DETC%dgsave ) THEN 
     883            CALL wrk_alloc( jpi, jpj,    fslowc2d   ) 
     884            fslowc2d(:,:)      = 0.0 !! 
     885         ENDIF  
     886!! 
     887!! skip SDC_XXXX, INVTXXX diagnostics here 
     888!! 
     889         IF( med_diag%LYSO_CA%dgsave ) THEN 
     890            CALL wrk_alloc( jpi, jpj,    lyso_ca2d  ) 
     891            lyso_ca2d(:,:)      = 0.0 !! 
     892         ENDIF 
     893!! 
     894!! skip COM_RESP diagnostic here 
     895!! 
     896         IF( med_diag%PN_LLOSS%dgsave ) THEN 
     897            CALL wrk_alloc( jpi, jpj,    fdpn22d   ) 
     898            fdpn22d(:,:)      = 0.0 !! 
     899         ENDIF 
     900         IF( med_diag%PD_LLOSS%dgsave ) THEN 
     901            CALL wrk_alloc( jpi, jpj,    fdpd22d   ) 
     902            fdpd22d(:,:)      = 0.0 !! 
     903         ENDIF 
     904         IF( med_diag%ZI_LLOSS%dgsave ) THEN 
     905            CALL wrk_alloc( jpi, jpj,    fdzmi22d   ) 
     906            fdzmi22d(:,:)      = 0.0 !! 
     907         ENDIF 
     908         IF( med_diag%ZE_LLOSS%dgsave ) THEN 
     909            CALL wrk_alloc( jpi, jpj,   fdzme22d    ) 
     910            fdzme22d(:,:)      = 0.0 !! 
     911         ENDIF 
     912         IF( med_diag%ZI_MES_N%dgsave ) THEN    
     913            CALL wrk_alloc( jpi, jpj,   zimesn2d    ) 
     914            zimesn2d(:,:)      = 0.0 !! 
     915         ENDIF 
     916         IF( med_diag%ZI_MES_D%dgsave ) THEN 
     917            CALL wrk_alloc( jpi, jpj,    zimesd2d   ) 
     918            zimesd2d(:,:)      = 0.0 !! 
     919         ENDIF 
     920         IF( med_diag%ZI_MES_C%dgsave ) THEN 
     921            CALL wrk_alloc( jpi, jpj,    zimesc2d   ) 
     922            zimesc2d(:,:)      = 0.0 !! 
     923         ENDIF 
     924         IF( med_diag%ZI_MESDC%dgsave ) THEN 
     925            CALL wrk_alloc( jpi, jpj,    zimesdc2d   ) 
     926            zimesdc2d(:,:)      = 0.0 !! 
     927         ENDIF 
     928         IF( med_diag%ZI_EXCR%dgsave ) THEN 
     929            CALL wrk_alloc( jpi, jpj,     ziexcr2d  ) 
     930            ziexcr2d(:,:)      = 0.0 !! 
     931         ENDIF 
     932         IF( med_diag%ZI_RESP%dgsave ) THEN 
     933            CALL wrk_alloc( jpi, jpj,    ziresp2d   ) 
     934            ziresp2d(:,:)      = 0.0 !! 
     935         ENDIF 
     936         IF( med_diag%ZI_GROW%dgsave ) THEN 
     937            CALL wrk_alloc( jpi, jpj,    zigrow2d   ) 
     938            zigrow2d(:,:)      = 0.0 !! 
     939         ENDIF 
     940         IF( med_diag%ZE_MES_N%dgsave ) THEN 
     941            CALL wrk_alloc( jpi, jpj,   zemesn2d    ) 
     942            zemesn2d(:,:)      = 0.0 !! 
     943         ENDIF 
     944         IF( med_diag%ZE_MES_D%dgsave ) THEN 
     945            CALL wrk_alloc( jpi, jpj,    zemesd2d   ) 
     946            zemesd2d(:,:)      = 0.0 !! 
     947         ENDIF 
     948         IF( med_diag%ZE_MES_C%dgsave ) THEN 
     949            CALL wrk_alloc( jpi, jpj,    zemesc2d   ) 
     950            zemesc2d(:,:)      = 0.0 !! 
     951         ENDIF 
     952         IF( med_diag%ZE_MESDC%dgsave ) THEN 
     953            CALL wrk_alloc( jpi, jpj,    zemesdc2d   ) 
     954            zemesdc2d(:,:)      = 0.0 !! 
     955         ENDIF 
     956         IF( med_diag%ZE_EXCR%dgsave ) THEN 
     957            CALL wrk_alloc( jpi, jpj,    zeexcr2d   ) 
     958            zeexcr2d(:,:)      = 0.0 !! 
     959         ENDIF                   
     960         IF( med_diag%ZE_RESP%dgsave ) THEN 
     961            CALL wrk_alloc( jpi, jpj,    zeresp2d   ) 
     962            zeresp2d(:,:)      = 0.0 !! 
     963         ENDIF 
     964         IF( med_diag%ZE_GROW%dgsave ) THEN 
     965            CALL wrk_alloc( jpi, jpj,    zegrow2d   ) 
     966            zegrow2d(:,:)      = 0.0 !! 
     967         ENDIF 
     968         IF( med_diag%MDETC%dgsave ) THEN 
     969            CALL wrk_alloc( jpi, jpj,   mdetc2d    ) 
     970            mdetc2d(:,:)      = 0.0 !! 
     971         ENDIF 
     972         IF( med_diag%GMIDC%dgsave ) THEN 
     973            CALL wrk_alloc( jpi, jpj,    gmidc2d   ) 
     974            gmidc2d(:,:)      = 0.0 !! 
     975         ENDIF 
     976         IF( med_diag%GMEDC%dgsave ) THEN 
     977            CALL wrk_alloc( jpi, jpj,    gmedc2d   ) 
     978            gmedc2d(:,:)      = 0.0 !! 
     979         ENDIF 
     980!! 
     981!! skip INT_XXX diagnostics here 
     982!! 
     983         IF (jdms .eq. 1) THEN 
     984            IF( med_diag%DMS_SURF%dgsave ) THEN 
     985               CALL wrk_alloc( jpi, jpj,   dms_surf2d    ) 
     986               dms_surf2d(:,:)      = 0.0 !! 
     987            ENDIF 
     988            IF( med_diag%DMS_ANDR%dgsave ) THEN 
     989               CALL wrk_alloc( jpi, jpj,   dms_andr2d    ) 
     990               dms_andr2d(:,:)      = 0.0 !! 
     991            ENDIF 
     992            IF( med_diag%DMS_SIMO%dgsave ) THEN 
     993               CALL wrk_alloc( jpi, jpj,  dms_simo2d     ) 
     994               dms_simo2d(:,:)      = 0.0 !! 
     995            ENDIF 
     996            IF( med_diag%DMS_ARAN%dgsave ) THEN 
     997               CALL wrk_alloc( jpi, jpj,   dms_aran2d    ) 
     998               dms_aran2d(:,:)      = 0.0 !! 
     999            ENDIF 
     1000            IF( med_diag%DMS_HALL%dgsave ) THEN 
     1001               CALL wrk_alloc( jpi, jpj,   dms_hall2d    ) 
     1002               dms_hall2d(:,:)      = 0.0 !! 
     1003            ENDIF 
     1004         ENDIF    
     1005         !! 
     1006         !! AXY (24/11/16): extra MOCSY diagnostics, 2D 
     1007         IF( med_diag%ATM_XCO2%dgsave ) THEN 
     1008            CALL wrk_alloc( jpi, jpj, f_xco2a_2d      ) 
     1009            f_xco2a_2d(:,:)      = 0.0 !! 
     1010         ENDIF 
     1011         IF( med_diag%OCN_FCO2%dgsave ) THEN 
     1012            CALL wrk_alloc( jpi, jpj, f_fco2w_2d      ) 
     1013            f_fco2w_2d(:,:)      = 0.0 !! 
     1014         ENDIF 
     1015         IF( med_diag%ATM_FCO2%dgsave ) THEN 
     1016            CALL wrk_alloc( jpi, jpj, f_fco2a_2d      ) 
     1017            f_fco2a_2d(:,:)      = 0.0 !! 
     1018         ENDIF 
     1019         IF( med_diag%OCN_RHOSW%dgsave ) THEN 
     1020            CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d   ) 
     1021            f_ocnrhosw_2d(:,:)      = 0.0 !! 
     1022         ENDIF 
     1023         IF( med_diag%OCN_SCHCO2%dgsave ) THEN 
     1024            CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d  ) 
     1025            f_ocnschco2_2d(:,:)      = 0.0 !! 
     1026         ENDIF 
     1027         IF( med_diag%OCN_KWCO2%dgsave ) THEN 
     1028            CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d   ) 
     1029            f_ocnkwco2_2d(:,:)      = 0.0 !! 
     1030         ENDIF 
     1031         IF( med_diag%OCN_K0%dgsave ) THEN 
     1032            CALL wrk_alloc( jpi, jpj, f_ocnk0_2d      ) 
     1033            f_ocnk0_2d(:,:)      = 0.0 !! 
     1034         ENDIF 
     1035         IF( med_diag%CO2STARAIR%dgsave ) THEN 
     1036            CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) 
     1037            f_co2starair_2d(:,:)      = 0.0 !! 
     1038         ENDIF 
     1039         IF( med_diag%OCN_DPCO2%dgsave ) THEN 
     1040            CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d   ) 
     1041            f_ocndpco2_2d(:,:)      = 0.0 !! 
     1042         ENDIF 
     1043# endif   
     1044         IF( med_diag%TPP3%dgsave ) THEN 
     1045            CALL wrk_alloc( jpi, jpj, jpk,       tpp3d ) 
     1046            tpp3d(:,:,:)      = 0.0 !!  
     1047         ENDIF 
     1048         IF( med_diag%DETFLUX3%dgsave ) THEN 
     1049            CALL wrk_alloc( jpi, jpj, jpk,        detflux3d ) 
     1050            detflux3d(:,:,:)      = 0.0 !!  
     1051         ENDIF 
     1052         IF( med_diag%REMIN3N%dgsave ) THEN 
     1053             CALL wrk_alloc( jpi, jpj, jpk,        remin3dn ) 
     1054             remin3dn(:,:,:)      = 0.0 !!  
     1055          ENDIF 
     1056          !!  
     1057          !! AXY (10/11/16): CMIP6 diagnostics, 2D 
     1058          !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request 
     1059          !!                   needed for coupling/passed through restart 
     1060          !! IF( med_diag%FGCO2%dgsave ) THEN 
     1061             CALL wrk_alloc( jpi, jpj,   fgco2    ) 
     1062             fgco2(:,:)      = 0.0 !! 
     1063          !! ENDIF 
     1064          IF( med_diag%INTDISSIC%dgsave ) THEN 
     1065             CALL wrk_alloc( jpi, jpj,   intdissic    ) 
     1066             intdissic(:,:)  = 0.0 !! 
     1067          ENDIF           
     1068          IF( med_diag%INTDISSIN%dgsave ) THEN 
     1069             CALL wrk_alloc( jpi, jpj,   intdissin    ) 
     1070             intdissin(:,:)  = 0.0 !! 
     1071          ENDIF           
     1072          IF( med_diag%INTDISSISI%dgsave ) THEN 
     1073             CALL wrk_alloc( jpi, jpj,   intdissisi    ) 
     1074             intdissisi(:,:)  = 0.0 !! 
     1075          ENDIF           
     1076          IF( med_diag%INTTALK%dgsave ) THEN 
     1077             CALL wrk_alloc( jpi, jpj,   inttalk    ) 
     1078             inttalk(:,:)  = 0.0 !! 
     1079          ENDIF           
     1080          IF( med_diag%O2min%dgsave ) THEN 
     1081             CALL wrk_alloc( jpi, jpj,   o2min    ) 
     1082             o2min(:,:)  = 1.e3 !! set to high value as we're looking for min(o2) 
     1083          ENDIF           
     1084          IF( med_diag%ZO2min%dgsave ) THEN 
     1085             CALL wrk_alloc( jpi, jpj,   zo2min    ) 
     1086             zo2min(:,:)  = 0.0 !! 
     1087          ENDIF           
     1088          IF( med_diag%FBDDTALK%dgsave  ) THEN 
     1089             CALL wrk_alloc( jpi, jpj, fbddtalk  ) 
     1090             fbddtalk(:,:)  = 0.0 !!  
     1091          ENDIF 
     1092          IF( med_diag%FBDDTDIC%dgsave  ) THEN 
     1093             CALL wrk_alloc( jpi, jpj, fbddtdic  ) 
     1094             fbddtdic(:,:)  = 0.0 !!  
     1095          ENDIF 
     1096          IF( med_diag%FBDDTDIFE%dgsave ) THEN 
     1097             CALL wrk_alloc( jpi, jpj, fbddtdife ) 
     1098             fbddtdife(:,:) = 0.0 !!  
     1099          ENDIF 
     1100          IF( med_diag%FBDDTDIN%dgsave  ) THEN 
     1101             CALL wrk_alloc( jpi, jpj, fbddtdin  ) 
     1102             fbddtdin(:,:)  = 0.0 !!  
     1103          ENDIF 
     1104          IF( med_diag%FBDDTDISI%dgsave ) THEN 
     1105             CALL wrk_alloc( jpi, jpj, fbddtdisi ) 
     1106             fbddtdisi(:,:) = 0.0 !!  
     1107          ENDIF 
     1108          !!  
     1109          !! AXY (10/11/16): CMIP6 diagnostics, 3D 
     1110          IF( med_diag%TPPD3%dgsave     ) THEN 
     1111             CALL wrk_alloc( jpi, jpj, jpk, tppd3     ) 
     1112             tppd3(:,:,:)     = 0.0 !!  
     1113          ENDIF 
     1114          IF( med_diag%BDDTALK3%dgsave  ) THEN 
     1115             CALL wrk_alloc( jpi, jpj, jpk, bddtalk3  ) 
     1116             bddtalk3(:,:,:)  = 0.0 !!  
     1117          ENDIF 
     1118          IF( med_diag%BDDTDIC3%dgsave  ) THEN 
     1119             CALL wrk_alloc( jpi, jpj, jpk, bddtdic3  ) 
     1120             bddtdic3(:,:,:)  = 0.0 !!  
     1121          ENDIF 
     1122          IF( med_diag%BDDTDIFE3%dgsave ) THEN 
     1123             CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) 
     1124             bddtdife3(:,:,:) = 0.0 !!  
     1125          ENDIF 
     1126          IF( med_diag%BDDTDIN3%dgsave  ) THEN 
     1127             CALL wrk_alloc( jpi, jpj, jpk, bddtdin3  ) 
     1128             bddtdin3(:,:,:)  = 0.0 !!  
     1129          ENDIF 
     1130          IF( med_diag%BDDTDISI3%dgsave ) THEN 
     1131             CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) 
     1132             bddtdisi3(:,:,:) = 0.0 !!  
     1133          ENDIF 
     1134          IF( med_diag%FD_NIT3%dgsave   ) THEN 
     1135             CALL wrk_alloc( jpi, jpj, jpk, fd_nit3   ) 
     1136             fd_nit3(:,:,:)   = 0.0 !!  
     1137          ENDIF 
     1138          IF( med_diag%FD_SIL3%dgsave   ) THEN 
     1139             CALL wrk_alloc( jpi, jpj, jpk, fd_sil3   ) 
     1140             fd_sil3(:,:,:)   = 0.0 !!  
     1141          ENDIF 
     1142          IF( med_diag%FD_CAR3%dgsave   ) THEN 
     1143             CALL wrk_alloc( jpi, jpj, jpk, fd_car3   ) 
     1144             fd_car3(:,:,:)   = 0.0 !!  
     1145          ENDIF 
     1146          IF( med_diag%FD_CAL3%dgsave   ) THEN 
     1147             CALL wrk_alloc( jpi, jpj, jpk, fd_cal3   ) 
     1148             fd_cal3(:,:,:)   = 0.0 !!  
     1149          ENDIF 
     1150          IF( med_diag%DCALC3%dgsave    ) THEN 
     1151             CALL wrk_alloc( jpi, jpj, jpk, dcalc3    ) 
     1152             dcalc3(:,:,: )   = 0.0 !!  
     1153          ENDIF 
     1154          IF( med_diag%EXPC3%dgsave     ) THEN 
     1155             CALL wrk_alloc( jpi, jpj, jpk, expc3   ) 
     1156             expc3(:,:,: )    = 0.0 !!  
     1157          ENDIF 
     1158          IF( med_diag%EXPN3%dgsave     ) THEN 
     1159             CALL wrk_alloc( jpi, jpj, jpk, expn3   ) 
     1160             expn3(:,:,: )    = 0.0 !!  
     1161          ENDIF 
     1162          IF( med_diag%FEDISS3%dgsave   ) THEN 
     1163             CALL wrk_alloc( jpi, jpj, jpk, fediss3   ) 
     1164             fediss3(:,:,: )  = 0.0 !!  
     1165          ENDIF 
     1166          IF( med_diag%FESCAV3%dgsave   ) THEN 
     1167             CALL wrk_alloc( jpi, jpj, jpk, fescav3   ) 
     1168             fescav3(:,:,: )  = 0.0 !!  
     1169          ENDIF 
     1170          IF( med_diag%MIGRAZP3%dgsave   ) THEN 
     1171             CALL wrk_alloc( jpi, jpj, jpk, migrazp3  ) 
     1172             migrazp3(:,:,: )  = 0.0 !!  
     1173          ENDIF 
     1174          IF( med_diag%MIGRAZD3%dgsave   ) THEN 
     1175             CALL wrk_alloc( jpi, jpj, jpk, migrazd3  ) 
     1176             migrazd3(:,:,: )  = 0.0 !!  
     1177          ENDIF 
     1178          IF( med_diag%MEGRAZP3%dgsave   ) THEN 
     1179             CALL wrk_alloc( jpi, jpj, jpk, megrazp3  ) 
     1180             megrazp3(:,:,: )  = 0.0 !!  
     1181          ENDIF 
     1182          IF( med_diag%MEGRAZD3%dgsave   ) THEN 
     1183             CALL wrk_alloc( jpi, jpj, jpk, megrazd3  ) 
     1184             megrazd3(:,:,: )  = 0.0 !!  
     1185          ENDIF 
     1186          IF( med_diag%MEGRAZZ3%dgsave   ) THEN 
     1187             CALL wrk_alloc( jpi, jpj, jpk, megrazz3  ) 
     1188             megrazz3(:,:,: )  = 0.0 !!  
     1189          ENDIF 
     1190          IF( med_diag%O2SAT3%dgsave     ) THEN 
     1191             CALL wrk_alloc( jpi, jpj, jpk, o2sat3    ) 
     1192             o2sat3(:,:,: )    = 0.0 !!  
     1193          ENDIF 
     1194          IF( med_diag%PBSI3%dgsave      ) THEN 
     1195             CALL wrk_alloc( jpi, jpj, jpk, pbsi3     ) 
     1196             pbsi3(:,:,: )     = 0.0 !!  
     1197          ENDIF 
     1198          IF( med_diag%PCAL3%dgsave      ) THEN 
     1199             CALL wrk_alloc( jpi, jpj, jpk, pcal3     ) 
     1200             pcal3(:,:,: )     = 0.0 !!  
     1201          ENDIF 
     1202          IF( med_diag%REMOC3%dgsave     ) THEN 
     1203             CALL wrk_alloc( jpi, jpj, jpk, remoc3    ) 
     1204             remoc3(:,:,: )    = 0.0 !!  
     1205          ENDIF 
     1206          IF( med_diag%PNLIMJ3%dgsave    ) THEN 
     1207             CALL wrk_alloc( jpi, jpj, jpk, pnlimj3   ) 
     1208             pnlimj3(:,:,: )   = 0.0 !!  
     1209          ENDIF 
     1210          IF( med_diag%PNLIMN3%dgsave    ) THEN 
     1211             CALL wrk_alloc( jpi, jpj, jpk, pnlimn3   ) 
     1212             pnlimn3(:,:,: )   = 0.0 !!  
     1213          ENDIF 
     1214          IF( med_diag%PNLIMFE3%dgsave   ) THEN 
     1215             CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3  ) 
     1216             pnlimfe3(:,:,: )  = 0.0 !!  
     1217          ENDIF 
     1218          IF( med_diag%PDLIMJ3%dgsave    ) THEN 
     1219             CALL wrk_alloc( jpi, jpj, jpk, pdlimj3   ) 
     1220             pdlimj3(:,:,: )   = 0.0 !!  
     1221          ENDIF 
     1222          IF( med_diag%PDLIMN3%dgsave    ) THEN 
     1223             CALL wrk_alloc( jpi, jpj, jpk, pdlimn3   ) 
     1224             pdlimn3(:,:,: )   = 0.0 !!  
     1225          ENDIF 
     1226          IF( med_diag%PDLIMFE3%dgsave   ) THEN 
     1227             CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3  ) 
     1228             pdlimfe3(:,:,: )  = 0.0 !!  
     1229          ENDIF 
     1230          IF( med_diag%PDLIMSI3%dgsave   ) THEN 
     1231             CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3  ) 
     1232             pdlimsi3(:,:,: )  = 0.0 !!  
     1233          ENDIF 
     1234 
     1235       ENDIF 
     1236       !! lk_iomput                                    
    5691237       !! 
    570        CALL wrk_alloc( jpi, jpj,      zw2d ) 
    571        zw2d(:,:)      = 0.0   !! 
    572        IF ( med_diag%PRN%dgsave ) THEN 
    573           CALL wrk_alloc( jpi, jpj,   fprn2d    ) 
    574           fprn2d(:,:)      = 0.0 !! 
    575        ENDIF 
    576        IF ( med_diag%MPN%dgsave ) THEN 
    577           CALL wrk_alloc( jpi, jpj,   fdpn2d    ) 
    578           fdpn2d(:,:)      = 0.0 !! 
    579        ENDIF 
    580        IF ( med_diag%PRD%dgsave ) THEN 
    581           CALL wrk_alloc( jpi, jpj,   fprd2d    ) 
    582           fprd2d(:,:)      = 0.0 !! 
    583        ENDIF 
    584        IF( med_diag%MPD%dgsave ) THEN 
    585           CALL wrk_alloc( jpi, jpj,   fdpd2d    ) 
    586           fdpd2d(:,:)      = 0.0 !! 
    587        ENDIF 
    588        IF( med_diag%OPAL%dgsave ) THEN 
    589           CALL wrk_alloc( jpi, jpj,   fprds2d    ) 
    590           fprds2d(:,:)      = 0.0 !! 
    591        ENDIF 
    592        IF( med_diag%OPALDISS%dgsave ) THEN 
    593           CALL wrk_alloc( jpi, jpj,   fsdiss2d    ) 
    594           fsdiss2d(:,:)      = 0.0 !! 
    595        ENDIF 
    596        IF( med_diag%GMIPn%dgsave ) THEN 
    597           CALL wrk_alloc( jpi, jpj,   fgmipn2d    ) 
    598           fgmipn2d(:,:)      = 0.0 !! 
    599        ENDIF 
    600        IF( med_diag%GMID%dgsave ) THEN 
    601           CALL wrk_alloc( jpi, jpj,   fgmid2d    ) 
    602           fgmid2d(:,:)      = 0.0 !! 
    603        ENDIF 
    604        IF( med_diag%MZMI%dgsave ) THEN 
    605           CALL wrk_alloc( jpi, jpj,   fdzmi2d    ) 
    606           fdzmi2d(:,:)      = 0.0 !! 
    607        ENDIF 
    608        IF( med_diag%GMEPN%dgsave ) THEN 
    609           CALL wrk_alloc( jpi, jpj,   fgmepn2d    ) 
    610           fgmepn2d(:,:)      = 0.0 !! 
    611        ENDIF 
    612        IF( med_diag%GMEPD%dgsave ) THEN 
    613           CALL wrk_alloc( jpi, jpj,   fgmepd2d    ) 
    614           fgmepd2d(:,:)      = 0.0 !! 
    615        ENDIF 
    616        IF( med_diag%GMEZMI%dgsave ) THEN 
    617           CALL wrk_alloc( jpi, jpj,   fgmezmi2d    ) 
    618           fgmezmi2d(:,:)      = 0.0 !! 
    619        ENDIF 
    620        IF( med_diag%GMED%dgsave ) THEN 
    621           CALL wrk_alloc( jpi, jpj,   fgmed2d    ) 
    622           fgmed2d(:,:)      = 0.0 !! 
    623        ENDIF 
    624        IF( med_diag%MZME%dgsave ) THEN 
    625           CALL wrk_alloc( jpi, jpj,   fdzme2d    ) 
    626           fdzme2d(:,:)      = 0.0 !! 
    627        ENDIF 
    628        IF( med_diag%DETN%dgsave ) THEN 
    629           CALL wrk_alloc( jpi, jpj,   fslown2d    ) 
    630           fslown2d(:,:)      = 0.0 !! 
    631        ENDIF 
    632        IF( med_diag%MDET%dgsave ) THEN 
    633           CALL wrk_alloc( jpi, jpj,   fdd2d    ) 
    634           fdd2d(:,:)      = 0.0 !! 
    635        ENDIF 
    636        IF( med_diag%AEOLIAN%dgsave ) THEN 
    637           CALL wrk_alloc( jpi, jpj,   ffetop2d    ) 
    638           ffetop2d(:,:)      = 0.0 !! 
    639        ENDIF 
    640        IF( med_diag%BENTHIC%dgsave ) THEN 
    641           CALL wrk_alloc( jpi, jpj,    ffebot2d   ) 
    642           ffebot2d(:,:)      = 0.0 !! 
    643        ENDIF 
    644        IF( med_diag%SCAVENGE%dgsave ) THEN 
    645           CALL wrk_alloc( jpi, jpj,   ffescav2d    ) 
    646           ffescav2d(:,:)      = 0.0 !! 
    647        ENDIF 
    648        IF( med_diag%PN_JLIM%dgsave ) THEN 
    649           CALL wrk_alloc( jpi, jpj,   fjln2d    ) 
    650           fjln2d(:,:)      = 0.0 !! 
    651        ENDIF 
    652        IF( med_diag%PN_NLIM%dgsave ) THEN 
    653           CALL wrk_alloc( jpi, jpj,   fnln2d    ) 
    654           fnln2d(:,:)      = 0.0 !! 
    655        ENDIF 
    656        IF( med_diag%PN_FELIM%dgsave ) THEN 
    657           CALL wrk_alloc( jpi, jpj,   ffln2d    ) 
    658           ffln2d(:,:)      = 0.0 !! 
    659        ENDIF 
    660        IF( med_diag%PD_JLIM%dgsave ) THEN 
    661           CALL wrk_alloc( jpi, jpj,   fjld2d    ) 
    662           fjld2d(:,:)      = 0.0 !! 
    663        ENDIF 
    664        IF( med_diag%PD_NLIM%dgsave ) THEN 
    665           CALL wrk_alloc( jpi, jpj,   fnld2d    ) 
    666           fnld2d(:,:)      = 0.0 !! 
    667        ENDIF 
    668        IF( med_diag%PD_FELIM%dgsave ) THEN 
    669           CALL wrk_alloc( jpi, jpj,   ffld2d    ) 
    670           ffld2d(:,:)      = 0.0 !! 
    671        ENDIF 
    672        IF( med_diag%PD_SILIM%dgsave ) THEN 
    673           CALL wrk_alloc( jpi, jpj,   fsld2d2    ) 
    674           fsld2d2(:,:)      = 0.0 !! 
    675        ENDIF 
    676        IF( med_diag%PDSILIM2%dgsave ) THEN 
    677           CALL wrk_alloc( jpi, jpj,   fsld2d    ) 
    678           fsld2d(:,:)      = 0.0 !! 
    679        ENDIF 
    680        !! 
    681        !! skip SDT_XXXX diagnostics here 
    682        !! 
    683        IF( med_diag%TOTREG_N%dgsave ) THEN 
    684           CALL wrk_alloc( jpi, jpj,   fregen2d    ) 
    685           fregen2d(:,:)      = 0.0 !! 
    686        ENDIF 
    687        IF( med_diag%TOTRG_SI%dgsave ) THEN 
    688           CALL wrk_alloc( jpi, jpj,   fregensi2d    ) 
    689           fregensi2d(:,:)      = 0.0 !! 
    690        ENDIF 
    691        !! 
    692        !! skip REG_XXXX diagnostics here 
    693        !! 
    694        IF( med_diag%FASTN%dgsave ) THEN 
    695           CALL wrk_alloc( jpi, jpj,   ftempn2d    ) 
    696           ftempn2d(:,:)      = 0.0 !! 
    697        ENDIF 
    698        IF( med_diag%FASTSI%dgsave ) THEN 
    699           CALL wrk_alloc( jpi, jpj,   ftempsi2d    ) 
    700           ftempsi2d(:,:)      = 0.0 !! 
    701        ENDIF 
    702        IF( med_diag%FASTFE%dgsave ) THEN 
    703           CALL wrk_alloc( jpi, jpj,  ftempfe2d     ) 
    704           ftempfe2d(:,:)      = 0.0 !! 
    705        ENDIF 
    706        IF( med_diag%FASTC%dgsave ) THEN 
    707           CALL wrk_alloc( jpi, jpj,  ftempc2d     ) 
    708           ftempc2d(:,:)      = 0.0 !! 
    709        ENDIF 
    710        IF( med_diag%FASTCA%dgsave ) THEN 
    711           CALL wrk_alloc( jpi, jpj,   ftempca2d    ) 
    712           ftempca2d(:,:)      = 0.0 !! 
    713        ENDIF 
    714        !! 
    715        !! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here 
    716        !! 
    717        IF( med_diag%REMINN%dgsave ) THEN 
    718           CALL wrk_alloc( jpi, jpj,    freminn2d   ) 
    719           freminn2d(:,:)      = 0.0 !! 
    720        ENDIF 
    721        IF( med_diag%REMINSI%dgsave ) THEN 
    722           CALL wrk_alloc( jpi, jpj,    freminsi2d   ) 
    723           freminsi2d(:,:)      = 0.0 !! 
    724        ENDIF 
    725        IF( med_diag%REMINFE%dgsave ) THEN 
    726           CALL wrk_alloc( jpi, jpj,    freminfe2d   ) 
    727           freminfe2d(:,:)      = 0.0 !! 
    728        ENDIF 
    729        IF( med_diag%REMINC%dgsave ) THEN 
    730           CALL wrk_alloc( jpi, jpj,   freminc2d    ) 
    731           freminc2d(:,:)      = 0.0 !!  
    732        ENDIF 
    733        IF( med_diag%REMINCA%dgsave ) THEN 
    734           CALL wrk_alloc( jpi, jpj,   freminca2d    ) 
    735           freminca2d(:,:)      = 0.0 !! 
    736        ENDIF 
    737 # if defined key_roam 
    738        !! 
    739        !! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here 
    740        !! 
    741        IF( med_diag%RR_0100%dgsave ) THEN 
    742           CALL wrk_alloc( jpi, jpj,    ffastca2d   ) 
    743           ffastca2d(:,:)      = 0.0 !! 
    744        ENDIF 
    745  
    746        IF( med_diag%ATM_PCO2%dgsave ) THEN 
    747           CALL wrk_alloc( jpi, jpj,    f_pco2a2d   ) 
    748           f_pco2a2d(:,:)      = 0.0 !! 
    749        ENDIF 
    750        !! 
    751        !! skip OCN_PH diagnostic here 
    752        !! 
    753        IF( med_diag%OCN_PCO2%dgsave ) THEN 
    754           CALL wrk_alloc( jpi, jpj,    f_pco2w2d   ) 
    755           f_pco2w2d(:,:)      = 0.0 !! 
    756        ENDIF 
    757        !! 
    758        !! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here 
    759        !! 
    760        IF( med_diag%CO2FLUX%dgsave ) THEN 
    761           CALL wrk_alloc( jpi, jpj,   f_co2flux2d    ) 
    762           f_co2flux2d(:,:)      = 0.0 !! 
    763        ENDIF 
    764        !! 
    765        !! skip OM_XXX diagnostics here 
    766        !! 
    767        IF( med_diag%TCO2%dgsave ) THEN 
    768           CALL wrk_alloc( jpi, jpj,   f_TDIC2d    ) 
    769           f_TDIC2d(:,:)      = 0.0 !! 
    770        ENDIF 
    771        IF( med_diag%TALK%dgsave ) THEN 
    772           CALL wrk_alloc( jpi, jpj,    f_TALK2d   ) 
    773           f_TALK2d(:,:)      = 0.0 !! 
    774        ENDIF 
    775        IF( med_diag%KW660%dgsave ) THEN 
    776           CALL wrk_alloc( jpi, jpj,    f_kw6602d   ) 
    777           f_kw6602d(:,:)      = 0.0 !! 
    778        ENDIF 
    779        IF( med_diag%ATM_PP0%dgsave ) THEN 
    780           CALL wrk_alloc( jpi, jpj,    f_pp02d   ) 
    781           f_pp02d(:,:)      = 0.0 !! 
    782        ENDIF 
    783        IF( med_diag%O2FLUX%dgsave ) THEN 
    784           CALL wrk_alloc( jpi, jpj,   f_o2flux2d    ) 
    785           f_o2flux2d(:,:)      = 0.0 !! 
    786        ENDIF 
    787        IF( med_diag%O2SAT%dgsave ) THEN 
    788           CALL wrk_alloc( jpi, jpj,    f_o2sat2d   ) 
    789           f_o2sat2d(:,:)      = 0.0 !! 
    790        ENDIF 
    791        !! 
    792        !! skip XXX_CCD diagnostics here 
    793        !!  
    794        IF( med_diag%SFR_OCAL%dgsave ) THEN 
    795           CALL wrk_alloc( jpi, jpj,    sfr_ocal2d  ) 
    796           sfr_ocal2d(:,:)      = 0.0 !! 
    797        ENDIF 
    798        IF( med_diag%SFR_OARG%dgsave ) THEN 
    799           CALL wrk_alloc( jpi, jpj,    sfr_oarg2d  ) 
    800           sfr_oarg2d(:,:)      = 0.0 !! 
    801        ENDIF 
    802        !! 
    803        !! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here 
    804        !!  
    805        IF( med_diag%IBEN_N%dgsave ) THEN 
    806           CALL wrk_alloc( jpi, jpj,    iben_n2d  ) 
    807           iben_n2d(:,:)      = 0.0 !! 
    808        ENDIF 
    809        IF( med_diag%IBEN_FE%dgsave ) THEN 
    810           CALL wrk_alloc( jpi, jpj,   iben_fe2d   ) 
    811           iben_fe2d(:,:)      = 0.0 !! 
    812        ENDIF 
    813        IF( med_diag%IBEN_C%dgsave ) THEN 
    814           CALL wrk_alloc( jpi, jpj,   iben_c2d   ) 
    815           iben_c2d(:,:)      = 0.0 !! 
    816        ENDIF 
    817        IF( med_diag%IBEN_SI%dgsave ) THEN 
    818           CALL wrk_alloc( jpi, jpj,   iben_si2d   ) 
    819           iben_si2d(:,:)      = 0.0 !! 
    820        ENDIF 
    821        IF( med_diag%IBEN_CA%dgsave ) THEN 
    822           CALL wrk_alloc( jpi, jpj,   iben_ca2d   ) 
    823           iben_ca2d(:,:)      = 0.0 !! 
    824        ENDIF 
    825        IF( med_diag%OBEN_N%dgsave ) THEN 
    826           CALL wrk_alloc( jpi, jpj,    oben_n2d  ) 
    827           oben_n2d(:,:)      = 0.0 !! 
    828        ENDIF 
    829        IF( med_diag%OBEN_FE%dgsave ) THEN 
    830           CALL wrk_alloc( jpi, jpj,    oben_fe2d  ) 
    831           oben_fe2d(:,:)      = 0.0 !! 
    832        ENDIF 
    833        IF( med_diag%OBEN_C%dgsave ) THEN 
    834           CALL wrk_alloc( jpi, jpj,    oben_c2d  ) 
    835           oben_c2d(:,:)      = 0.0 !! 
    836        ENDIF 
    837        IF( med_diag%OBEN_SI%dgsave ) THEN 
    838           CALL wrk_alloc( jpi, jpj,    oben_si2d  ) 
    839           oben_si2d(:,:)      = 0.0 !! 
    840        ENDIF 
    841        IF( med_diag%OBEN_CA%dgsave ) THEN 
    842           CALL wrk_alloc( jpi, jpj,    oben_ca2d  ) 
    843           oben_ca2d(:,:)      = 0.0 !! 
    844        ENDIF 
    845        !! 
    846        !! skip BEN_XX diagnostics here 
    847        !! 
    848        IF( med_diag%RIV_N%dgsave ) THEN 
    849           CALL wrk_alloc( jpi, jpj,    rivn2d   ) 
    850           rivn2d(:,:)      = 0.0 !! 
    851        ENDIF 
    852        IF( med_diag%RIV_SI%dgsave ) THEN 
    853           CALL wrk_alloc( jpi, jpj,    rivsi2d   ) 
    854           rivsi2d(:,:)      = 0.0 !! 
    855        ENDIF 
    856        IF( med_diag%RIV_C%dgsave ) THEN 
    857           CALL wrk_alloc( jpi, jpj,   rivc2d    ) 
    858           rivc2d(:,:)      = 0.0 !! 
    859        ENDIF 
    860        IF( med_diag%RIV_ALK%dgsave ) THEN 
    861           CALL wrk_alloc( jpi, jpj,    rivalk2d   ) 
    862           rivalk2d(:,:)      = 0.0 !! 
    863        ENDIF 
    864        IF( med_diag%DETC%dgsave ) THEN 
    865           CALL wrk_alloc( jpi, jpj,    fslowc2d   ) 
    866           fslowc2d(:,:)      = 0.0 !! 
    867        ENDIF 
    868        !! 
    869        !! skip SDC_XXXX, INVTXXX diagnostics here 
    870        !! 
    871        IF( med_diag%LYSO_CA%dgsave ) THEN 
    872           CALL wrk_alloc( jpi, jpj,    lyso_ca2d  ) 
    873           lyso_ca2d(:,:)      = 0.0 !! 
    874        ENDIF 
    875        !! 
    876        !! skip COM_RESP diagnostic here 
    877        !! 
    878        IF( med_diag%PN_LLOSS%dgsave ) THEN 
    879           CALL wrk_alloc( jpi, jpj,    fdpn22d   ) 
    880           fdpn22d(:,:)      = 0.0 !! 
    881        ENDIF 
    882        IF( med_diag%PD_LLOSS%dgsave ) THEN 
    883           CALL wrk_alloc( jpi, jpj,    fdpd22d   ) 
    884           fdpd22d(:,:)      = 0.0 !! 
    885        ENDIF 
    886        IF( med_diag%ZI_LLOSS%dgsave ) THEN 
    887           CALL wrk_alloc( jpi, jpj,    fdzmi22d   ) 
    888           fdzmi22d(:,:)      = 0.0 !! 
    889        ENDIF 
    890        IF( med_diag%ZE_LLOSS%dgsave ) THEN 
    891           CALL wrk_alloc( jpi, jpj,   fdzme22d    ) 
    892           fdzme22d(:,:)      = 0.0 !! 
    893        ENDIF 
    894        IF( med_diag%ZI_MES_N%dgsave ) THEN    
    895           CALL wrk_alloc( jpi, jpj,   zimesn2d    ) 
    896           zimesn2d(:,:)      = 0.0 !! 
    897        ENDIF 
    898        IF( med_diag%ZI_MES_D%dgsave ) THEN 
    899           CALL wrk_alloc( jpi, jpj,    zimesd2d   ) 
    900           zimesd2d(:,:)      = 0.0 !! 
    901        ENDIF 
    902        IF( med_diag%ZI_MES_C%dgsave ) THEN 
    903           CALL wrk_alloc( jpi, jpj,    zimesc2d   ) 
    904           zimesc2d(:,:)      = 0.0 !! 
    905        ENDIF 
    906        IF( med_diag%ZI_MESDC%dgsave ) THEN 
    907           CALL wrk_alloc( jpi, jpj,    zimesdc2d   ) 
    908           zimesdc2d(:,:)      = 0.0 !! 
    909        ENDIF 
    910        IF( med_diag%ZI_EXCR%dgsave ) THEN 
    911           CALL wrk_alloc( jpi, jpj,     ziexcr2d  ) 
    912           ziexcr2d(:,:)      = 0.0 !! 
    913        ENDIF 
    914        IF( med_diag%ZI_RESP%dgsave ) THEN 
    915           CALL wrk_alloc( jpi, jpj,    ziresp2d   ) 
    916           ziresp2d(:,:)      = 0.0 !! 
    917        ENDIF 
    918        IF( med_diag%ZI_GROW%dgsave ) THEN 
    919           CALL wrk_alloc( jpi, jpj,    zigrow2d   ) 
    920           zigrow2d(:,:)      = 0.0 !! 
    921        ENDIF 
    922        IF( med_diag%ZE_MES_N%dgsave ) THEN 
    923           CALL wrk_alloc( jpi, jpj,   zemesn2d    ) 
    924           zemesn2d(:,:)      = 0.0 !! 
    925        ENDIF 
    926        IF( med_diag%ZE_MES_D%dgsave ) THEN 
    927           CALL wrk_alloc( jpi, jpj,    zemesd2d   ) 
    928           zemesd2d(:,:)      = 0.0 !! 
    929        ENDIF 
    930        IF( med_diag%ZE_MES_C%dgsave ) THEN 
    931           CALL wrk_alloc( jpi, jpj,    zemesc2d   ) 
    932           zemesc2d(:,:)      = 0.0 !! 
    933        ENDIF 
    934        IF( med_diag%ZE_MESDC%dgsave ) THEN 
    935           CALL wrk_alloc( jpi, jpj,    zemesdc2d   ) 
    936           zemesdc2d(:,:)      = 0.0 !! 
    937        ENDIF 
    938        IF( med_diag%ZE_EXCR%dgsave ) THEN 
    939           CALL wrk_alloc( jpi, jpj,    zeexcr2d   ) 
    940           zeexcr2d(:,:)      = 0.0 !! 
    941        ENDIF 
    942        IF( med_diag%ZE_RESP%dgsave ) THEN 
    943           CALL wrk_alloc( jpi, jpj,    zeresp2d   ) 
    944           zeresp2d(:,:)      = 0.0 !! 
    945        ENDIF 
    946        IF( med_diag%ZE_GROW%dgsave ) THEN 
    947           CALL wrk_alloc( jpi, jpj,    zegrow2d   ) 
    948           zegrow2d(:,:)      = 0.0 !! 
    949        ENDIF 
    950        IF( med_diag%MDETC%dgsave ) THEN 
    951           CALL wrk_alloc( jpi, jpj,   mdetc2d    ) 
    952           mdetc2d(:,:)      = 0.0 !! 
    953        ENDIF 
    954        IF( med_diag%GMIDC%dgsave ) THEN 
    955           CALL wrk_alloc( jpi, jpj,    gmidc2d   ) 
    956           gmidc2d(:,:)      = 0.0 !! 
    957        ENDIF 
    958        IF( med_diag%GMEDC%dgsave ) THEN 
    959           CALL wrk_alloc( jpi, jpj,    gmedc2d   ) 
    960           gmedc2d(:,:)      = 0.0 !! 
    961        ENDIF 
    962        !! 
    963        !! skip INT_XXX diagnostics here 
    964        !! 
    965        IF (jdms .eq. 1) THEN 
    966           IF( med_diag%DMS_SURF%dgsave ) THEN 
    967              CALL wrk_alloc( jpi, jpj,   dms_surf2d    ) 
    968              dms_surf2d(:,:)      = 0.0 !! 
    969           ENDIF 
    970           IF( med_diag%DMS_ANDR%dgsave ) THEN 
    971              CALL wrk_alloc( jpi, jpj,   dms_andr2d    ) 
    972              dms_andr2d(:,:)      = 0.0 !! 
    973           ENDIF 
    974           IF( med_diag%DMS_SIMO%dgsave ) THEN 
    975              CALL wrk_alloc( jpi, jpj,  dms_simo2d     ) 
    976              dms_simo2d(:,:)      = 0.0 !! 
    977           ENDIF 
    978           IF( med_diag%DMS_ARAN%dgsave ) THEN 
    979              CALL wrk_alloc( jpi, jpj,   dms_aran2d    ) 
    980              dms_aran2d(:,:)      = 0.0 !! 
    981           ENDIF 
    982           IF( med_diag%DMS_HALL%dgsave ) THEN 
    983              CALL wrk_alloc( jpi, jpj,   dms_hall2d    ) 
    984              dms_hall2d(:,:)      = 0.0 !! 
    985           ENDIF 
    986        ENDIF 
    987        !! 
    988        !! AXY (24/11/16): extra MOCSY diagnostics, 2D 
    989        IF( med_diag%ATM_XCO2%dgsave ) THEN 
    990           CALL wrk_alloc( jpi, jpj, f_xco2a_2d      ) 
    991           f_xco2a_2d(:,:)      = 0.0 !! 
    992        ENDIF 
    993        IF( med_diag%OCN_FCO2%dgsave ) THEN 
    994           CALL wrk_alloc( jpi, jpj, f_fco2w_2d      ) 
    995           f_fco2w_2d(:,:)      = 0.0 !! 
    996        ENDIF 
    997        IF( med_diag%ATM_FCO2%dgsave ) THEN 
    998           CALL wrk_alloc( jpi, jpj, f_fco2a_2d      ) 
    999           f_fco2a_2d(:,:)      = 0.0 !! 
    1000        ENDIF 
    1001        IF( med_diag%OCN_RHOSW%dgsave ) THEN 
    1002           CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d   ) 
    1003           f_ocnrhosw_2d(:,:)      = 0.0 !! 
    1004        ENDIF 
    1005        IF( med_diag%OCN_SCHCO2%dgsave ) THEN 
    1006           CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d  ) 
    1007           f_ocnschco2_2d(:,:)      = 0.0 !! 
    1008        ENDIF 
    1009        IF( med_diag%OCN_KWCO2%dgsave ) THEN 
    1010           CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d   ) 
    1011           f_ocnkwco2_2d(:,:)      = 0.0 !! 
    1012        ENDIF 
    1013        IF( med_diag%OCN_K0%dgsave ) THEN 
    1014           CALL wrk_alloc( jpi, jpj, f_ocnk0_2d      ) 
    1015           f_ocnk0_2d(:,:)      = 0.0 !! 
    1016        ENDIF 
    1017        IF( med_diag%CO2STARAIR%dgsave ) THEN 
    1018           CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) 
    1019           f_co2starair_2d(:,:)      = 0.0 !! 
    1020        ENDIF 
    1021        IF( med_diag%OCN_DPCO2%dgsave ) THEN 
    1022           CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d   ) 
    1023           f_ocndpco2_2d(:,:)      = 0.0 !! 
    1024        ENDIF 
    1025 # endif   
    1026        IF( med_diag%TPP3%dgsave ) THEN 
    1027           CALL wrk_alloc( jpi, jpj, jpk,       tpp3d ) 
    1028           tpp3d(:,:,:)      = 0.0 !!  
    1029        ENDIF 
    1030        IF( med_diag%DETFLUX3%dgsave ) THEN 
    1031           CALL wrk_alloc( jpi, jpj, jpk,        detflux3d ) 
    1032           detflux3d(:,:,:)      = 0.0 !!  
    1033        ENDIF 
    1034        IF( med_diag%REMIN3N%dgsave ) THEN 
    1035           CALL wrk_alloc( jpi, jpj, jpk,        remin3dn ) 
    1036           remin3dn(:,:,:)      = 0.0 !!  
    1037        ENDIF 
    1038        !!  
    1039        !! AXY (10/11/16): CMIP6 diagnostics, 2D 
    1040        !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request 
    1041        !!                   needed for coupling/passed through restart 
    1042        !! IF( med_diag%FGCO2%dgsave ) THEN 
    1043        CALL wrk_alloc( jpi, jpj,   fgco2    ) 
    1044        fgco2(:,:)      = 0.0  !! 
    1045        !! ENDIF 
    1046        IF( med_diag%INTDISSIC%dgsave ) THEN 
    1047           CALL wrk_alloc( jpi, jpj,   intdissic    ) 
    1048           intdissic(:,:)  = 0.0 !! 
    1049        ENDIF 
    1050        IF( med_diag%INTDISSIN%dgsave ) THEN 
    1051           CALL wrk_alloc( jpi, jpj,   intdissin    ) 
    1052           intdissin(:,:)  = 0.0 !! 
    1053        ENDIF 
    1054        IF( med_diag%INTDISSISI%dgsave ) THEN 
    1055           CALL wrk_alloc( jpi, jpj,   intdissisi    ) 
    1056           intdissisi(:,:)  = 0.0 !! 
    1057        ENDIF 
    1058        IF( med_diag%INTTALK%dgsave ) THEN 
    1059           CALL wrk_alloc( jpi, jpj,   inttalk    ) 
    1060           inttalk(:,:)  = 0.0 !! 
    1061        ENDIF 
    1062        IF( med_diag%O2min%dgsave ) THEN 
    1063           CALL wrk_alloc( jpi, jpj,   o2min    ) 
    1064           o2min(:,:)  = 1.e3  !! set to high value as we're looking for min(o2) 
    1065        ENDIF 
    1066        IF( med_diag%ZO2min%dgsave ) THEN 
    1067           CALL wrk_alloc( jpi, jpj,   zo2min    ) 
    1068           zo2min(:,:)  = 0.0  !! 
    1069        ENDIF 
    1070        IF( med_diag%FBDDTALK%dgsave  ) THEN 
    1071           CALL wrk_alloc( jpi, jpj, fbddtalk  ) 
    1072           fbddtalk(:,:)  = 0.0 !!  
    1073        ENDIF 
    1074        IF( med_diag%FBDDTDIC%dgsave  ) THEN 
    1075           CALL wrk_alloc( jpi, jpj, fbddtdic  ) 
    1076           fbddtdic(:,:)  = 0.0 !!  
    1077        ENDIF 
    1078        IF( med_diag%FBDDTDIFE%dgsave ) THEN 
    1079           CALL wrk_alloc( jpi, jpj, fbddtdife ) 
    1080           fbddtdife(:,:) = 0.0 !!  
    1081        ENDIF 
    1082        IF( med_diag%FBDDTDIN%dgsave  ) THEN 
    1083           CALL wrk_alloc( jpi, jpj, fbddtdin  ) 
    1084           fbddtdin(:,:)  = 0.0 !!  
    1085        ENDIF 
    1086        IF( med_diag%FBDDTDISI%dgsave ) THEN 
    1087           CALL wrk_alloc( jpi, jpj, fbddtdisi ) 
    1088           fbddtdisi(:,:) = 0.0 !!  
    1089        ENDIF 
    1090        !!  
    1091        !! AXY (10/11/16): CMIP6 diagnostics, 3D 
    1092        IF( med_diag%TPPD3%dgsave     ) THEN 
    1093           CALL wrk_alloc( jpi, jpj, jpk, tppd3     ) 
    1094           tppd3(:,:,:)     = 0.0 !!  
    1095        ENDIF 
    1096        IF( med_diag%BDDTALK3%dgsave  ) THEN 
    1097           CALL wrk_alloc( jpi, jpj, jpk, bddtalk3  ) 
    1098           bddtalk3(:,:,:)  = 0.0 !!  
    1099        ENDIF 
    1100        IF( med_diag%BDDTDIC3%dgsave  ) THEN 
    1101           CALL wrk_alloc( jpi, jpj, jpk, bddtdic3  ) 
    1102           bddtdic3(:,:,:)  = 0.0 !!  
    1103        ENDIF 
    1104        IF( med_diag%BDDTDIFE3%dgsave ) THEN 
    1105           CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) 
    1106           bddtdife3(:,:,:) = 0.0 !!  
    1107        ENDIF 
    1108        IF( med_diag%BDDTDIN3%dgsave  ) THEN 
    1109           CALL wrk_alloc( jpi, jpj, jpk, bddtdin3  ) 
    1110           bddtdin3(:,:,:)  = 0.0 !!  
    1111        ENDIF 
    1112        IF( med_diag%BDDTDISI3%dgsave ) THEN 
    1113           CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) 
    1114           bddtdisi3(:,:,:) = 0.0 !!  
    1115        ENDIF 
    1116        IF( med_diag%FD_NIT3%dgsave   ) THEN 
    1117           CALL wrk_alloc( jpi, jpj, jpk, fd_nit3   ) 
    1118           fd_nit3(:,:,:)   = 0.0 !!  
    1119        ENDIF 
    1120        IF( med_diag%FD_SIL3%dgsave   ) THEN 
    1121           CALL wrk_alloc( jpi, jpj, jpk, fd_sil3   ) 
    1122           fd_sil3(:,:,:)   = 0.0 !!  
    1123        ENDIF 
    1124        IF( med_diag%FD_CAR3%dgsave   ) THEN 
    1125           CALL wrk_alloc( jpi, jpj, jpk, fd_car3   ) 
    1126           fd_car3(:,:,:)   = 0.0 !!  
    1127        ENDIF 
    1128        IF( med_diag%FD_CAL3%dgsave   ) THEN 
    1129           CALL wrk_alloc( jpi, jpj, jpk, fd_cal3   ) 
    1130           fd_cal3(:,:,:)   = 0.0 !!  
    1131        ENDIF 
    1132        IF( med_diag%DCALC3%dgsave    ) THEN 
    1133           CALL wrk_alloc( jpi, jpj, jpk, dcalc3    ) 
    1134           dcalc3(:,:,: )   = 0.0 !!  
    1135        ENDIF 
    1136        IF( med_diag%EXPC3%dgsave     ) THEN 
    1137           CALL wrk_alloc( jpi, jpj, jpk, expc3   ) 
    1138           expc3(:,:,: )    = 0.0 !!  
    1139        ENDIF 
    1140        IF( med_diag%EXPN3%dgsave     ) THEN 
    1141           CALL wrk_alloc( jpi, jpj, jpk, expn3   ) 
    1142           expn3(:,:,: )    = 0.0 !!  
    1143        ENDIF 
    1144        IF( med_diag%FEDISS3%dgsave   ) THEN 
    1145           CALL wrk_alloc( jpi, jpj, jpk, fediss3   ) 
    1146           fediss3(:,:,: )  = 0.0 !!  
    1147        ENDIF 
    1148        IF( med_diag%FESCAV3%dgsave   ) THEN 
    1149           CALL wrk_alloc( jpi, jpj, jpk, fescav3   ) 
    1150           fescav3(:,:,: )  = 0.0 !!  
    1151        ENDIF 
    1152        IF( med_diag%MIGRAZP3%dgsave   ) THEN 
    1153           CALL wrk_alloc( jpi, jpj, jpk, migrazp3  ) 
    1154           migrazp3(:,:,: )  = 0.0 !!  
    1155        ENDIF 
    1156        IF( med_diag%MIGRAZD3%dgsave   ) THEN 
    1157           CALL wrk_alloc( jpi, jpj, jpk, migrazd3  ) 
    1158           migrazd3(:,:,: )  = 0.0 !!  
    1159        ENDIF 
    1160        IF( med_diag%MEGRAZP3%dgsave   ) THEN 
    1161           CALL wrk_alloc( jpi, jpj, jpk, megrazp3  ) 
    1162           megrazp3(:,:,: )  = 0.0 !!  
    1163        ENDIF 
    1164        IF( med_diag%MEGRAZD3%dgsave   ) THEN 
    1165           CALL wrk_alloc( jpi, jpj, jpk, megrazd3  ) 
    1166           megrazd3(:,:,: )  = 0.0 !!  
    1167        ENDIF 
    1168        IF( med_diag%MEGRAZZ3%dgsave   ) THEN 
    1169           CALL wrk_alloc( jpi, jpj, jpk, megrazz3  ) 
    1170           megrazz3(:,:,: )  = 0.0 !!  
    1171        ENDIF 
    1172        IF( med_diag%O2SAT3%dgsave     ) THEN 
    1173           CALL wrk_alloc( jpi, jpj, jpk, o2sat3    ) 
    1174           o2sat3(:,:,: )    = 0.0 !!  
    1175        ENDIF 
    1176        IF( med_diag%PBSI3%dgsave      ) THEN 
    1177           CALL wrk_alloc( jpi, jpj, jpk, pbsi3     ) 
    1178           pbsi3(:,:,: )     = 0.0 !!  
    1179        ENDIF 
    1180        IF( med_diag%PCAL3%dgsave      ) THEN 
    1181           CALL wrk_alloc( jpi, jpj, jpk, pcal3     ) 
    1182           pcal3(:,:,: )     = 0.0 !!  
    1183        ENDIF 
    1184        IF( med_diag%REMOC3%dgsave     ) THEN 
    1185           CALL wrk_alloc( jpi, jpj, jpk, remoc3    ) 
    1186           remoc3(:,:,: )    = 0.0 !!  
    1187        ENDIF 
    1188        IF( med_diag%PNLIMJ3%dgsave    ) THEN 
    1189           CALL wrk_alloc( jpi, jpj, jpk, pnlimj3   ) 
    1190           pnlimj3(:,:,: )   = 0.0 !!  
    1191        ENDIF 
    1192        IF( med_diag%PNLIMN3%dgsave    ) THEN 
    1193           CALL wrk_alloc( jpi, jpj, jpk, pnlimn3   ) 
    1194           pnlimn3(:,:,: )   = 0.0 !!  
    1195        ENDIF 
    1196        IF( med_diag%PNLIMFE3%dgsave   ) THEN 
    1197           CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3  ) 
    1198           pnlimfe3(:,:,: )  = 0.0 !!  
    1199        ENDIF 
    1200        IF( med_diag%PDLIMJ3%dgsave    ) THEN 
    1201           CALL wrk_alloc( jpi, jpj, jpk, pdlimj3   ) 
    1202           pdlimj3(:,:,: )   = 0.0 !!  
    1203        ENDIF 
    1204        IF( med_diag%PDLIMN3%dgsave    ) THEN 
    1205           CALL wrk_alloc( jpi, jpj, jpk, pdlimn3   ) 
    1206           pdlimn3(:,:,: )   = 0.0 !!  
    1207        ENDIF 
    1208        IF( med_diag%PDLIMFE3%dgsave   ) THEN 
    1209           CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3  ) 
    1210           pdlimfe3(:,:,: )  = 0.0 !!  
    1211        ENDIF 
    1212        IF( med_diag%PDLIMSI3%dgsave   ) THEN 
    1213           CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3  ) 
    1214           pdlimsi3(:,:,: )  = 0.0 !!  
    1215        ENDIF 
    1216     ENDIF                     !! lk_iomput                                    
    1217     !! 
    12181238# if defined key_axy_nancheck 
    1219     DO jn = 1,jptra 
    1220        fq2 = SUM(trn(:,:,:,jn)) 
    1221        if ( ieee_is_nan( fq2 ) ) then 
    1222           !! there's a NaN here 
    1223           if (lwp) write(numout,*) 'NAN detected in field', jn, 'at time', kt, 'at position:' 
    1224           DO jk = 1,jpk 
    1225              DO jj = 1,jpj 
    1226                 DO ji = 1,jpi 
    1227                    if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then 
    1228                       if (lwp) write (numout,'(a,1pe12.2,4i6)') 'NAN-CHECK', & 
    1229                            &        tmask(ji,jj,jk), ji, jj, jk, jn 
    1230                    endif 
     1239       DO jn = 1,jptra 
     1240          !! fq0 = MINVAL(trn(:,:,:,jn)) 
     1241          !! fq1 = MAXVAL(trn(:,:,:,jn)) 
     1242          fq2 = SUM(trn(:,:,:,jn)) 
     1243          !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK', & 
     1244          !! &        kt, jn, fq0, fq1, fq2 
     1245          !! AXY (30/01/14): much to our surprise, the next line doesn't work on HECTOR 
     1246          !!                 and has been replaced here with a specialist routine 
     1247          !! if (fq2 /= fq2 ) then 
     1248          if ( ieee_is_nan( fq2 ) ) then 
     1249             !! there's a NaN here 
     1250             if (lwp) write(numout,*) 'NAN detected in field', jn, 'at time', kt, 'at position:' 
     1251             DO jk = 1,jpk 
     1252                DO jj = 1,jpj 
     1253                   DO ji = 1,jpi 
     1254                      !! AXY (30/01/14): "isnan" problem on HECTOR 
     1255                      !! if (trn(ji,jj,jk,jn) /= trn(ji,jj,jk,jn)) then 
     1256                      if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then 
     1257                         if (lwp) write (numout,'(a,1pe12.2,4i6)') 'NAN-CHECK', & 
     1258                         &        tmask(ji,jj,jk), ji, jj, jk, jn 
     1259                      endif 
     1260                   enddo 
    12311261                enddo 
    12321262             enddo 
    1233           enddo 
    1234           CALL ctl_stop( 'trcbio_medusa, NAN in incoming tracer field' ) 
    1235        endif 
    1236     ENDDO 
    1237     CALL flush(numout) 
     1263             CALL ctl_stop( 'trcbio_medusa, NAN in incoming tracer field' ) 
     1264          endif 
     1265       ENDDO 
     1266       CALL flush(numout) 
    12381267# endif 
    12391268 
    12401269# if defined key_debug_medusa 
    1241     IF ( lwp ) write (numout,*) 'trc_bio_medusa: variables initialised and checked' 
    1242     CALL flush(numout) 
     1270      IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked' 
     1271      CALL flush(numout) 
    12431272# endif  
    12441273 
    12451274# if defined key_roam 
    1246     !!---------------------------------------------------------------------- 
    1247     !! calculate atmospheric pCO2 
    1248     !!---------------------------------------------------------------------- 
    1249     !! 
     1275      !!---------------------------------------------------------------------- 
     1276      !! calculate atmospheric pCO2 
     1277      !!---------------------------------------------------------------------- 
     1278      !! 
     1279      !! what's atmospheric pCO2 doing? (data start in 1859) 
     1280      iyr1  = nyear - 1859 + 1 
     1281      iyr2  = iyr1 + 1 
     1282      if (iyr1 .le. 1) then 
     1283         !! before 1860 
     1284         f_xco2a = hist_pco2(1) 
     1285      elseif (iyr2 .ge. 242) then 
     1286         !! after 2099 
     1287         f_xco2a = hist_pco2(242) 
     1288      else 
     1289         !! just right 
     1290         fq0 = hist_pco2(iyr1) 
     1291         fq1 = hist_pco2(iyr2) 
     1292         fq2 = real(nsec_day) / (60.0 * 60.0 * 24.0) 
     1293         !! AXY (14/06/12): tweaked to make more sense (and be correct) 
     1294#  if defined key_bs_axy_yrlen 
     1295         fq3 = (real(nday_year) - 1.0 + fq2) / 360.0  !! bugfix: for 360d year with HadGEM2-ES forcing 
     1296#  else 
     1297         fq3 = (real(nday_year) - 1.0 + fq2) / 365.0  !! original use of 365 days (not accounting for leap year or 360d year) 
     1298#  endif 
     1299         fq4 = (fq0 * (1.0 - fq3)) + (fq1 * fq3) 
     1300         f_xco2a = fq4 
     1301      endif 
    12501302#  if defined key_axy_pi_co2 
    1251     f_xco2a = 284.725         !! OCMIP pre-industrial pCO2 
    1252 #  else 
    1253     f_xco2a = 284.725         !! OCMIP pre-industrial pCO2 
     1303      f_xco2a = 284.725          !! OCMIP pre-industrial pCO2 
    12541304#  endif 
    1255     IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  =', f_xco2a 
     1305      !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear     =', nyear 
     1306      !! IF(lwp) WRITE(numout,*) ' MEDUSA nsec_day  =', real(nsec_day) 
     1307      !! IF(lwp) WRITE(numout,*) ' MEDUSA nday_year =', real(nday_year) 
     1308      !! AXY (29/01/14): remove surplus diagnostics 
     1309      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq0       =', fq0 
     1310      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq1       =', fq1 
     1311      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq2       =', fq2 
     1312      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq3       =', fq3 
     1313      IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  =', f_xco2a 
    12561314# endif 
    12571315 
    12581316# if defined key_debug_medusa 
    1259     IF ( lwp ) write (numout,*) 'trc_bio_medusa: ready for carbonate chemistry' 
    1260     IF ( lwp ) write (numout,*) 'trc_bio_medusa: kt = ', kt 
    1261     IF ( lwp ) write (numout,*) 'trc_bio_medusa: nittrc000 = ', nittrc000 
    1262     CALL flush(numout) 
     1317      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for carbonate chemistry' 
     1318      IF (lwp) write (numout,*) 'trc_bio_medusa: kt = ', kt 
     1319      IF (lwp) write (numout,*) 'trc_bio_medusa: nittrc000 = ', nittrc000 
     1320      CALL flush(numout) 
    12631321# endif  
    12641322 
    1265     !!====================================================================== 
    1266     !! AXY (07/04/17): possible subroutine block; ocean interior carbonate chemistry 
    1267     !!====================================================================== 
    12681323# if defined key_roam 
    1269     !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every 
    1270     !!                 month (this is hardwired as 960 timesteps but should 
    1271     !!                 be calculated and done properly 
    1272     !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN 
    1273     !! IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN  
    1274     !!============================= 
    1275     !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : 
    1276     !!          we don't want to call on the first time-step of all run submission,  
    1277     !!          but only on the very first time-step, and then every month 
    1278     !!          So we call on nittrc000 if not restarted run,  
    1279     !!          else if one month after last call. 
    1280     !!          assume one month is 30d --> 3600*24*30 : 2592000s 
    1281     !!          try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt)    
    1282     !!          ++ need to pass carb-chem output var through restarts 
    1283     IF ( ( kt == nittrc000 .AND. .NOT.ln_rsttr ) .OR. mod(kt*rdt,2592000.) == rdt ) THEN 
    1284        !!---------------------------------------------------------------------- 
    1285        !! Calculate the carbonate chemistry for the whole ocean on the first 
    1286        !! simulation timestep and every month subsequently; the resulting 3D 
    1287        !! field of omega calcite is used to determine the depth of the CCD 
    1288        !!---------------------------------------------------------------------- 
    1289        !! 
    1290        IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt 
    1291        CALL flush(numout) 
    1292        !! blank flags 
    1293        i2_omcal(:,:) = 0 
    1294        i2_omarg(:,:) = 0 
    1295        !! loop over 3D space 
    1296        DO jk = 1,jpk 
    1297           DO jj = 2,jpjm1 
    1298              DO ji = 2,jpim1 
    1299                 !! OPEN wet point IF..THEN loop 
    1300                 if (tmask(ji,jj,jk).eq.1) then 
    1301                    IF ( lk_oasis ) THEN 
    1302                       f_xco2a = PCO2a_in_cpl(ji,jj)   !! use 2D atm xCO2 from atm coupling 
    1303                    ENDIF 
    1304                    !! AXY (06/04/17): where am I? 
    1305                    flatx = gphit(ji,jj) 
    1306                    !! do carbonate chemistry 
    1307                    !! 
    1308                    fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint 
    1309                    !! AXY (28/11/16): seafloor depth; previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
    1310                    jmbathy = mbathy(ji,jj) 
    1311                    !! 
    1312                    !! set up required state variables 
    1313                    zdic = max(0.,trn(ji,jj,jk,jpdic))        !! dissolved inorganic carbon 
    1314                    zalk = max(0.,trn(ji,jj,jk,jpalk))        !! alkalinity 
    1315                    ztmp = tsn(ji,jj,jk,jp_tem)               !! temperature 
    1316                    zsal = tsn(ji,jj,jk,jp_sal)               !! salinity 
    1317                    zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid 
    1318                    zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
    1319                    !! 
    1320                    !! AXY (28/02/14): check input fields 
    1321                    if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
    1322                       IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', & 
    1323                            tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    & 
    1324                            ji, ',', jj, ',', jk, ') at time', kt 
    1325                       IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', & 
    1326                            tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
    1327                       ztmp = tsb(ji,jj,jk,jp_tem)     !! temperature 
    1328                    endif 
    1329                    if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
    1330                       IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', & 
    1331                            tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    & 
    1332                            ji, ',', jj, ',', jk, ') at time', kt 
    1333                    endif 
    1334                    !! 
    1335                    !! blank input variables not used at this stage (they relate to air-sea flux) 
    1336                    f_kw660 = 1.0 
    1337                    f_pp0   = 1.0 
    1338                    !! 
    1339                    !! calculate carbonate chemistry at grid cell midpoint 
    1340                    !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
    1341                    !!                 chemistry package 
    1342                    CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs 
    1343                         f_pp0, fdep2, flatx, f_kw660, f_xco2a, 1,                         &    ! inputs 
    1344                         f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs 
    1345                         f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs 
    1346                         f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs 
    1347                         f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs 
    1348                    !! 
    1349                    f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
    1350                    f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
    1351                    f_dcf  = f_rhosw 
    1352                    !! 
    1353                    !! store 3D outputs 
    1354                    f3_pH(ji,jj,jk)    = f_ph 
    1355                    f3_h2co3(ji,jj,jk) = f_h2co3 
    1356                    f3_hco3(ji,jj,jk)  = f_hco3 
    1357                    f3_co3(ji,jj,jk)   = f_co3 
    1358                    f3_omcal(ji,jj,jk) = f_omcal(ji,jj) 
    1359                    f3_omarg(ji,jj,jk) = f_omarg(ji,jj) 
    1360                    !! 
    1361                    !! CCD calculation: calcite 
    1362                    if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then 
    1363                       if (jk .eq. 1) then 
    1364                          f2_ccd_cal(ji,jj) = fdep2 
    1365                       else 
    1366                          fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) 
    1367                          fq1 = f3_omcal(ji,jj,jk-1) - 1.0 
    1368                          fq2 = fq1 / (fq0 + tiny(fq0)) 
    1369                          fq3 = fdep2 - fsdept(ji,jj,jk-1) 
    1370                          fq4 = fq2 * fq3 
    1371                          f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
    1372                       endif 
    1373                       i2_omcal(ji,jj)   = 1 
    1374                    endif 
    1375                    if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
    1376                       !! reached seafloor and still no dissolution; set to seafloor (W-point) 
    1377                       f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) 
    1378                       i2_omcal(ji,jj)   = 1 
    1379                    endif 
    1380                    !! 
    1381                    !! CCD calculation: aragonite 
    1382                    if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then 
    1383                       if (jk .eq. 1) then 
    1384                          f2_ccd_arg(ji,jj) = fdep2 
    1385                       else 
    1386                          fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) 
    1387                          fq1 = f3_omarg(ji,jj,jk-1) - 1.0 
    1388                          fq2 = fq1 / (fq0 + tiny(fq0)) 
    1389                          fq3 = fdep2 - fsdept(ji,jj,jk-1) 
    1390                          fq4 = fq2 * fq3 
    1391                          f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
    1392                       endif 
    1393                       i2_omarg(ji,jj)   = 1 
    1394                    endif 
    1395                    if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
    1396                       !! reached seafloor and still no dissolution; set to seafloor (W-point) 
    1397                       f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) 
    1398                       i2_omarg(ji,jj)   = 1 
    1399                    endif 
    1400                 endif 
    1401              ENDDO 
    1402           ENDDO 
    1403        ENDDO 
    1404     ENDIF 
    1405 # endif 
    1406  
    1407 # if defined key_debug_medusa 
    1408     IF ( lwp ) write (numout,*) 'trc_bio_medusa: ready for full domain calculations' 
    1409     CALL flush(numout) 
    1410 # endif  
    1411  
    1412     !!---------------------------------------------------------------------- 
    1413     !! MEDUSA has unified equation through the water column 
    1414     !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers)  
    1415     !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1           
    1416     !!---------------------------------------------------------------------- 
    1417     !! 
    1418     !! NOTE: the ordering of the loops below differs from that of some other 
    1419     !! models; looping over the vertical dimension is the outermost loop and 
    1420     !! this complicates some calculations (e.g. storage of vertical fluxes 
    1421     !! that can otherwise be done via a singular variable require 2D fields 
    1422     !! here); however, these issues are relatively easily resolved, but the 
    1423     !! loops CANNOT be reordered without potentially causing code efficiency 
    1424     !! problems (e.g. array indexing means that reordering the loops would 
    1425     !! require skipping between widely-spaced memory location; potentially 
    1426     !! outside those immediately cached) 
    1427     !! 
    1428     !! OPEN vertical loop 
    1429     DO jk = 1,jpk 
    1430        !! OPEN horizontal loops 
    1431        DO jj = 2,jpjm1 
    1432           DO ji = 2,jpim1 
    1433              !! OPEN wet point IF..THEN loop 
    1434              if (tmask(ji,jj,jk).eq.1) then                
    1435                 !!====================================================================== 
    1436                 !! SETUP LOCAL GRID CELL 
    1437                 !!====================================================================== 
    1438                 !! 
    1439                 !!--------------------------------------------------------------------- 
    1440                 !! Some notes on grid vertical structure 
    1441                 !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk 
    1442                 !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk 
    1443                 !! - fse3t(ji,jj,jk)  is the thickness of level jk 
    1444                 !!--------------------------------------------------------------------- 
    1445                 !! 
    1446                 !! AXY (11/12/08): set up level thickness 
    1447                 fthk  = fse3t(ji,jj,jk) 
    1448                 !! AXY (25/02/10): set up level depth (top of level) 
    1449                 fdep  = fsdepw(ji,jj,jk) 
    1450                 !! AXY (01/03/10): set up level depth (bottom of level) 
    1451                 fdep1 = fdep + fthk 
    1452                 !! AXY (17/05/13): where am I? 
    1453                 flatx = gphit(ji,jj) 
    1454                 flonx = glamt(ji,jj) 
    1455                 !! AXY (28/11/16): local seafloor depth 
    1456                 !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
    1457                 jmbathy = mbathy(ji,jj) 
    1458                 !! 
    1459                 !! set up model tracers 
    1460                 !! negative values of state variables are not allowed to 
    1461                 !! contribute to the calculated fluxes 
    1462                 zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll 
    1463                 zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll 
    1464                 zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms 
    1465                 zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms 
    1466                 zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon 
    1467                 !! AXY (28/01/10): probably need to take account of chl/biomass connection 
    1468                 if (zchn.eq.0.) zphn = 0. 
    1469                 if (zchd.eq.0.) zphd = 0. 
    1470                 if (zphn.eq.0.) zchn = 0. 
    1471                 if (zphd.eq.0.) zchd = 0. 
    1472                 !! AXY (23/01/14): duh - why did I forget diatom silicon? 
    1473                 if (zpds.eq.0.) zphd = 0. 
    1474                 if (zphd.eq.0.) zpds = 0. 
    1475                 zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton 
    1476                 zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton 
    1477                 zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen 
    1478                 zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen 
    1479                 zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid 
    1480                 zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" 
    1481 # if defined key_roam 
    1482                 zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon 
    1483                 zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
    1484                 zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 
    1485                 zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen 
    1486 #  if defined key_axy_carbchem 
    1487                 zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
     1324      !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every 
     1325      !!                 month (this is hardwired as 960 timesteps but should 
     1326      !!                 be calculated and done properly 
     1327      !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN 
     1328      !! IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN  
     1329      !!============================= 
     1330      !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : 
     1331      !!          we don't want to call on the first time-step of all run submission,  
     1332      !!          but only on the very first time-step, and then every month 
     1333      !!          So we call on nittrc000 if not restarted run,  
     1334      !!          else if one month after last call. 
     1335      !!          assume one month is 30d --> 3600*24*30 : 2592000s 
     1336      !!          try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt)    
     1337      !!          ++ need to pass carb-chem output var through restarts 
     1338      If ( ( kt == nittrc000 .AND. .NOT.ln_rsttr ) .OR. mod(kt*rdt,2592000.) == rdt ) THEN 
     1339         !!---------------------------------------------------------------------- 
     1340         !! Calculate the carbonate chemistry for the whole ocean on the first 
     1341         !! simulation timestep and every month subsequently; the resulting 3D 
     1342         !! field of omega calcite is used to determine the depth of the CCD 
     1343         !!---------------------------------------------------------------------- 
     1344         !! 
     1345         IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt 
     1346         CALL flush(numout) 
     1347         !! blank flags 
     1348         i2_omcal(:,:) = 0 
     1349         i2_omarg(:,:) = 0 
     1350         !! loop over 3D space 
     1351         DO jk = 1,jpk 
     1352            DO jj = 2,jpjm1 
     1353               DO ji = 2,jpim1 
     1354                  !! OPEN wet point IF..THEN loop 
     1355                  if (tmask(ji,jj,jk).eq.1) then 
     1356                     IF (lk_oasis) THEN 
     1357                        f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling 
     1358                     ENDIF 
     1359                     !! do carbonate chemistry 
     1360                     !! 
     1361                     fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint 
     1362                     !! AXY (28/11/16): local seafloor depth 
     1363                     !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
     1364                     jmbathy = mbathy(ji,jj) 
     1365                     !! 
     1366                     !! set up required state variables 
     1367                     zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
     1368                     zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 
     1369                     ztmp = tsn(ji,jj,jk,jp_tem)        !! temperature 
     1370                     zsal = tsn(ji,jj,jk,jp_sal)        !! salinity 
     1371#  if defined key_mocsy 
     1372                     zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid 
     1373                     zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
    14881374#  endif 
    1489                 !! 
    1490                 !! also need physical parameters for gas exchange calculations 
    1491                 ztmp = tsn(ji,jj,jk,jp_tem) 
    1492                 zsal = tsn(ji,jj,jk,jp_sal) 
    1493                 !! 
    1494                 !! AXY (28/02/14): check input fields 
    1495                 if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
    1496                    IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', & 
     1375           !! 
     1376           !! AXY (28/02/14): check input fields 
     1377           if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
     1378                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', & 
    14971379                        tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    & 
    14981380                        ji, ',', jj, ',', jk, ') at time', kt 
    1499                    IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', & 
    1500                         tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
    1501                    ztmp = tsb(ji,jj,jk,jp_tem) !! temperature 
    1502                 endif 
    1503                 if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
    1504                    IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', & 
     1381         IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', & 
     1382         tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
     1383                        ztmp = tsb(ji,jj,jk,jp_tem)    !! temperature 
     1384                     endif 
     1385           if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
     1386                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', & 
    15051387                        tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    & 
    15061388                        ji, ',', jj, ',', jk, ') at time', kt 
    1507                 endif 
     1389                     endif 
     1390                     !! 
     1391                     !! blank input variables not used at this stage (they relate to air-sea flux) 
     1392                     f_kw660 = 1.0 
     1393                     f_pp0   = 1.0 
     1394                     !! 
     1395                     !! calculate carbonate chemistry at grid cell midpoint 
     1396#  if defined key_mocsy 
     1397                     !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
     1398                     !!                 chemistry package 
     1399                     CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs 
     1400                     f_pp0, fdep2, gphit(ji,jj), f_kw660, f_xco2a, 1,                  &    ! inputs 
     1401                     f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs 
     1402                     f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs 
     1403                     f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs 
     1404                     f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs 
     1405                     !! 
     1406                     f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
     1407                     f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
     1408                     f_dcf  = f_rhosw 
     1409#  else 
     1410                     !! AXY (22/06/15): use old PML carbonate chemistry package (the 
     1411                     !!                 MEDUSA-2 default) 
     1412                     CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660,      &    ! inputs 
     1413                     f_xco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),   &    ! outputs 
     1414                     f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters)      ! outputs 
     1415                     !!  
     1416                     !! AXY (28/02/14): check output fields 
     1417                     if (iters .eq. 25) then 
     1418                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: 3D ITERS WARNING, ', & 
     1419                        iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
     1420                     endif 
     1421#  endif 
     1422                     !! 
     1423                     !! store 3D outputs 
     1424                     f3_pH(ji,jj,jk)    = f_ph 
     1425                     f3_h2co3(ji,jj,jk) = f_h2co3 
     1426                     f3_hco3(ji,jj,jk)  = f_hco3 
     1427                     f3_co3(ji,jj,jk)   = f_co3 
     1428                     f3_omcal(ji,jj,jk) = f_omcal(ji,jj) 
     1429                     f3_omarg(ji,jj,jk) = f_omarg(ji,jj) 
     1430                     !! 
     1431                     !! CCD calculation: calcite 
     1432                     if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then 
     1433                        if (jk .eq. 1) then 
     1434                           f2_ccd_cal(ji,jj) = fdep2 
     1435                        else 
     1436                           fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) 
     1437                           fq1 = f3_omcal(ji,jj,jk-1) - 1.0 
     1438                           fq2 = fq1 / (fq0 + tiny(fq0)) 
     1439                           fq3 = fdep2 - fsdept(ji,jj,jk-1) 
     1440                           fq4 = fq2 * fq3 
     1441                           f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
     1442                        endif 
     1443                        i2_omcal(ji,jj)   = 1 
     1444                     endif 
     1445                     if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
     1446                        !! reached seafloor and still no dissolution; set to seafloor (W-point) 
     1447                        f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) 
     1448                        i2_omcal(ji,jj)   = 1 
     1449                     endif 
     1450                     !! 
     1451                     !! CCD calculation: aragonite 
     1452                     if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then 
     1453                        if (jk .eq. 1) then 
     1454                           f2_ccd_arg(ji,jj) = fdep2 
     1455                        else 
     1456                           fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) 
     1457                           fq1 = f3_omarg(ji,jj,jk-1) - 1.0 
     1458                           fq2 = fq1 / (fq0 + tiny(fq0)) 
     1459                           fq3 = fdep2 - fsdept(ji,jj,jk-1) 
     1460                           fq4 = fq2 * fq3 
     1461                           f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
     1462                        endif 
     1463                        i2_omarg(ji,jj)   = 1 
     1464                     endif 
     1465                     if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
     1466                        !! reached seafloor and still no dissolution; set to seafloor (W-point) 
     1467                        f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) 
     1468                        i2_omarg(ji,jj)   = 1 
     1469                     endif 
     1470                  endif 
     1471               ENDDO 
     1472            ENDDO 
     1473         ENDDO 
     1474      ENDIF 
     1475# endif 
     1476 
     1477# if defined key_debug_medusa 
     1478      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for full domain calculations' 
     1479      CALL flush(numout) 
     1480# endif  
     1481 
     1482      !!---------------------------------------------------------------------- 
     1483      !! MEDUSA has unified equation through the water column 
     1484      !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers)  
     1485      !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1           
     1486      !!---------------------------------------------------------------------- 
     1487      !! 
     1488      !! NOTE: the ordering of the loops below differs from that of some other 
     1489      !! models; looping over the vertical dimension is the outermost loop and 
     1490      !! this complicates some calculations (e.g. storage of vertical fluxes 
     1491      !! that can otherwise be done via a singular variable require 2D fields 
     1492      !! here); however, these issues are relatively easily resolved, but the 
     1493      !! loops CANNOT be reordered without potentially causing code efficiency 
     1494      !! problems (e.g. array indexing means that reordering the loops would 
     1495      !! require skipping between widely-spaced memory location; potentially 
     1496      !! outside those immediately cached) 
     1497      !! 
     1498      !! OPEN vertical loop 
     1499      DO jk = 1,jpk 
     1500         !! OPEN horizontal loops 
     1501         DO jj = 2,jpjm1 
     1502         DO ji = 2,jpim1 
     1503            !! OPEN wet point IF..THEN loop 
     1504            if (tmask(ji,jj,jk).eq.1) then                
     1505               !!====================================================================== 
     1506               !! SETUP LOCAL GRID CELL 
     1507               !!====================================================================== 
     1508               !! 
     1509               !!--------------------------------------------------------------------- 
     1510               !! Some notes on grid vertical structure 
     1511               !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk 
     1512               !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk 
     1513               !! - fse3t(ji,jj,jk)  is the thickness of level jk 
     1514               !!--------------------------------------------------------------------- 
     1515               !! 
     1516               !! AXY (11/12/08): set up level thickness 
     1517               fthk  = fse3t(ji,jj,jk) 
     1518               !! AXY (25/02/10): set up level depth (top of level) 
     1519               fdep  = fsdepw(ji,jj,jk) 
     1520               !! AXY (01/03/10): set up level depth (bottom of level) 
     1521               fdep1 = fdep + fthk 
     1522               !! AXY (28/11/16): local seafloor depth 
     1523               !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
     1524               jmbathy = mbathy(ji,jj) 
     1525               !! 
     1526               !! set up model tracers 
     1527               !! negative values of state variables are not allowed to 
     1528               !! contribute to the calculated fluxes 
     1529               zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll 
     1530               zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll 
     1531               zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms 
     1532               zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms 
     1533               zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon 
     1534               !! AXY (28/01/10): probably need to take account of chl/biomass connection 
     1535               if (zchn.eq.0.) zphn = 0. 
     1536               if (zchd.eq.0.) zphd = 0. 
     1537               if (zphn.eq.0.) zchn = 0. 
     1538               if (zphd.eq.0.) zchd = 0. 
     1539          !! AXY (23/01/14): duh - why did I forget diatom silicon? 
     1540          if (zpds.eq.0.) zphd = 0. 
     1541          if (zphd.eq.0.) zpds = 0. 
     1542               zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton 
     1543               zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton 
     1544               zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen 
     1545               zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen 
     1546               zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid 
     1547               zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" 
     1548# if defined key_roam 
     1549               zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon 
     1550               zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
     1551               zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 
     1552               zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen 
     1553#  if defined key_axy_carbchem && defined key_mocsy 
     1554               zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
     1555#  endif 
     1556               !! 
     1557               !! also need physical parameters for gas exchange calculations 
     1558               ztmp = tsn(ji,jj,jk,jp_tem) 
     1559               zsal = tsn(ji,jj,jk,jp_sal) 
     1560               !! 
     1561          !! AXY (28/02/14): check input fields 
     1562               if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
     1563                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', & 
     1564                  tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    & 
     1565                  ji, ',', jj, ',', jk, ') at time', kt 
     1566        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', & 
     1567                  tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
     1568                  ztmp = tsb(ji,jj,jk,jp_tem) !! temperature 
     1569               endif 
     1570               if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
     1571                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', & 
     1572                  tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    & 
     1573                  ji, ',', jj, ',', jk, ') at time', kt 
     1574               endif 
    15081575# else 
    1509                 zdtc = zdet * xthetad              !! implicit detrital carbon 
     1576               zdtc = zdet * xthetad              !! implicit detrital carbon 
    15101577# endif 
    15111578# if defined key_debug_medusa 
    1512                 if (idf.eq.1) then 
    1513                    !! AXY (15/01/10) 
    1514                    if (trn(ji,jj,jk,jpdin).lt.0.) then 
    1515                       IF ( lwp ) write (numout,*) '------------------------------' 
    1516                       IF ( lwp ) write (numout,*) 'NEGATIVE DIN ERROR =', trn(ji,jj,jk,jpdin) 
    1517                       IF ( lwp ) write (numout,*) 'NEGATIVE DIN ERROR @', ji, jj, jk, kt 
    1518                    endif 
    1519                    if (trn(ji,jj,jk,jpsil).lt.0.) then 
    1520                       IF ( lwp ) write (numout,*) '------------------------------' 
    1521                       IF ( lwp ) write (numout,*) 'NEGATIVE SIL ERROR =', trn(ji,jj,jk,jpsil) 
    1522                       IF ( lwp ) write (numout,*) 'NEGATIVE SIL ERROR @', ji, jj, jk, kt 
    1523                    endif 
     1579               if (idf.eq.1) then 
     1580               !! AXY (15/01/10) 
     1581                  if (trn(ji,jj,jk,jpdin).lt.0.) then 
     1582                     IF (lwp) write (numout,*) '------------------------------' 
     1583                     IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =', trn(ji,jj,jk,jpdin) 
     1584                     IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @', ji, jj, jk, kt 
     1585                  endif 
     1586                  if (trn(ji,jj,jk,jpsil).lt.0.) then 
     1587                     IF (lwp) write (numout,*) '------------------------------' 
     1588                     IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =', trn(ji,jj,jk,jpsil) 
     1589                     IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @', ji, jj, jk, kt 
     1590                  endif 
    15241591#  if defined key_roam 
    1525                    if (trn(ji,jj,jk,jpdic).lt.0.) then 
    1526                       IF ( lwp ) write (numout,*) '------------------------------' 
    1527                       IF ( lwp ) write (numout,*) 'NEGATIVE DIC ERROR =', trn(ji,jj,jk,jpdic) 
    1528                       IF ( lwp ) write (numout,*) 'NEGATIVE DIC ERROR @', ji, jj, jk, kt 
    1529                    endif 
    1530                    if (trn(ji,jj,jk,jpalk).lt.0.) then 
    1531                       IF ( lwp ) write (numout,*) '------------------------------' 
    1532                       IF ( lwp ) write (numout,*) 'NEGATIVE ALK ERROR =', trn(ji,jj,jk,jpalk) 
    1533                       IF ( lwp ) write (numout,*) 'NEGATIVE ALK ERROR @', ji, jj, jk, kt 
    1534                    endif 
    1535                    if (trn(ji,jj,jk,jpoxy).lt.0.) then 
    1536                       IF ( lwp ) write (numout,*) '------------------------------' 
    1537                       IF ( lwp ) write (numout,*) 'NEGATIVE OXY ERROR =', trn(ji,jj,jk,jpoxy) 
    1538                       IF ( lwp ) write (numout,*) 'NEGATIVE OXY ERROR @', ji, jj, jk, kt 
    1539                    endif 
     1592                  if (trn(ji,jj,jk,jpdic).lt.0.) then 
     1593                     IF (lwp) write (numout,*) '------------------------------' 
     1594                     IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =', trn(ji,jj,jk,jpdic) 
     1595                     IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @', ji, jj, jk, kt 
     1596                  endif 
     1597                  if (trn(ji,jj,jk,jpalk).lt.0.) then 
     1598                     IF (lwp) write (numout,*) '------------------------------' 
     1599                     IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =', trn(ji,jj,jk,jpalk) 
     1600                     IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @', ji, jj, jk, kt 
     1601                  endif 
     1602                  if (trn(ji,jj,jk,jpoxy).lt.0.) then 
     1603                     IF (lwp) write (numout,*) '------------------------------' 
     1604                     IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =', trn(ji,jj,jk,jpoxy) 
     1605                     IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @', ji, jj, jk, kt 
     1606                  endif 
    15401607#  endif 
    1541                 endif 
    1542 # endif 
    1543                 !! sum tracers for inventory checks 
    1544                 IF( lk_iomput ) THEN 
    1545                    IF ( med_diag%INVTN%dgsave )   THEN 
    1546                       ftot_n(ji,jj)  = ftot_n(ji,jj) + & 
    1547                            (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) ) 
    1548                    ENDIF 
    1549                    IF ( med_diag%INVTSI%dgsave )  THEN 
    1550                       ftot_si(ji,jj) = ftot_si(ji,jj) + &  
    1551                            (fthk * ( zpds + zsil ) ) 
    1552                    ENDIF 
    1553                    IF ( med_diag%INVTFE%dgsave )  THEN 
    1554                       ftot_fe(ji,jj) = ftot_fe(ji,jj) + &  
    1555                            (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) ) 
    1556                    ENDIF 
     1608               endif 
     1609# endif 
     1610# if defined key_debug_medusa 
     1611               !! report state variable values 
     1612               if (idf.eq.1.AND.idfval.eq.1) then 
     1613                  IF (lwp) write (numout,*) '------------------------------' 
     1614                  IF (lwp) write (numout,*) 'fthk(',jk,') = ', fthk 
     1615                  IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn 
     1616                  IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd 
     1617                  IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds 
     1618                  IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi 
     1619                  IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme 
     1620                  IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet 
     1621                  IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin 
     1622                  IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil 
     1623                  IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer 
     1624#  if defined key_roam 
     1625                  IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc 
     1626                  IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic 
     1627                  IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk 
     1628                  IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy                   
     1629#  endif 
     1630               endif 
     1631# endif 
     1632 
     1633# if defined key_debug_medusa 
     1634               if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 
     1635                  IF (lwp) write (numout,*) '------------------------------' 
     1636                  IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj) 
     1637               endif 
     1638# endif 
     1639 
     1640               !! sum tracers for inventory checks 
     1641               IF( lk_iomput ) THEN 
     1642                  IF ( med_diag%INVTN%dgsave )   THEN 
     1643                     ftot_n(ji,jj)  = ftot_n(ji,jj) + & 
     1644                             (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) ) 
     1645                  ENDIF 
     1646                  IF ( med_diag%INVTSI%dgsave )  THEN 
     1647                     ftot_si(ji,jj) = ftot_si(ji,jj) + &  
     1648                             (fthk * ( zpds + zsil ) ) 
     1649                  ENDIF 
     1650                  IF ( med_diag%INVTFE%dgsave )  THEN 
     1651                     ftot_fe(ji,jj) = ftot_fe(ji,jj) + &  
     1652                             (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) ) 
     1653                  ENDIF 
    15571654# if defined key_roam 
    1558                    IF ( med_diag%INVTC%dgsave )  THEN 
    1559                       ftot_c(ji,jj)  = ftot_c(ji,jj) + &  
    1560                            (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 
    1561                            (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc +   & 
    1562                            zdic ) ) 
    1563                    ENDIF 
    1564                    IF ( med_diag%INVTALK%dgsave ) THEN 
    1565                       ftot_a(ji,jj)  = ftot_a(ji,jj) + (fthk * ( zalk ) ) 
    1566                    ENDIF 
    1567                    IF ( med_diag%INVTO2%dgsave )  THEN 
    1568                       ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) ) 
    1569                    ENDIF 
    1570                    !! 
    1571                    !! AXY (10/11/16): CMIP6 diagnostics 
    1572                    IF ( med_diag%INTDISSIC%dgsave ) THEN 
    1573                       intdissic(ji,jj) = intdissic(ji,jj) + (fthk * zdic) 
    1574                    ENDIF 
    1575                    IF ( med_diag%INTDISSIN%dgsave ) THEN 
    1576                       intdissin(ji,jj) = intdissin(ji,jj) + (fthk * zdin) 
    1577                    ENDIF 
    1578                    IF ( med_diag%INTDISSISI%dgsave ) THEN 
    1579                       intdissisi(ji,jj) = intdissisi(ji,jj) + (fthk * zsil) 
    1580                    ENDIF 
    1581                    IF ( med_diag%INTTALK%dgsave ) THEN 
    1582                       inttalk(ji,jj) = inttalk(ji,jj) + (fthk * zalk) 
    1583                    ENDIF 
    1584                    IF ( med_diag%O2min%dgsave ) THEN 
    1585                       if ( zoxy < o2min(ji,jj) ) then 
    1586                          o2min(ji,jj)  = zoxy 
    1587                          IF ( med_diag%ZO2min%dgsave ) THEN 
    1588                             zo2min(ji,jj) = (fdep + fdep1) / 2. !! layer midpoint 
    1589                          ENDIF 
    1590                       endif 
    1591                    ENDIF 
    1592 # endif 
    1593                 ENDIF 
    1594  
    1595                 CALL flush(numout) 
    1596  
    1597                 !!====================================================================== 
    1598                 !! LOCAL GRID CELL CALCULATIONS 
    1599                 !!====================================================================== 
    1600                 !! 
    1601                 !!====================================================================== 
    1602                 !! AXY (07/04/17): possible subroutine block; air-sea gas exchange 
    1603                 !!====================================================================== 
     1655                  IF ( med_diag%INVTC%dgsave )  THEN 
     1656                     ftot_c(ji,jj)  = ftot_c(ji,jj) + &  
     1657                             (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 
     1658                             (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc +   & 
     1659                             zdic ) ) 
     1660                  ENDIF 
     1661                  IF ( med_diag%INVTALK%dgsave ) THEN 
     1662                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fthk * ( zalk ) ) 
     1663                  ENDIF 
     1664                  IF ( med_diag%INVTO2%dgsave )  THEN 
     1665                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) ) 
     1666                  ENDIF 
     1667                  !! 
     1668                  !! AXY (10/11/16): CMIP6 diagnostics 
     1669                  IF ( med_diag%INTDISSIC%dgsave ) THEN 
     1670                     intdissic(ji,jj) = intdissic(ji,jj) + (fthk * zdic) 
     1671                  ENDIF 
     1672                  IF ( med_diag%INTDISSIN%dgsave ) THEN 
     1673                     intdissin(ji,jj) = intdissin(ji,jj) + (fthk * zdin) 
     1674                  ENDIF 
     1675                  IF ( med_diag%INTDISSISI%dgsave ) THEN 
     1676                     intdissisi(ji,jj) = intdissisi(ji,jj) + (fthk * zsil) 
     1677                  ENDIF 
     1678                  IF ( med_diag%INTTALK%dgsave ) THEN 
     1679                     inttalk(ji,jj) = inttalk(ji,jj) + (fthk * zalk) 
     1680                  ENDIF 
     1681                  IF ( med_diag%O2min%dgsave ) THEN 
     1682                     if ( zoxy < o2min(ji,jj) ) then 
     1683                        o2min(ji,jj)  = zoxy 
     1684                        IF ( med_diag%ZO2min%dgsave ) THEN 
     1685                           zo2min(ji,jj) = (fdep + fdep1) / 2. !! layer midpoint 
     1686                        ENDIF 
     1687                     endif 
     1688                  ENDIF 
     1689# endif 
     1690               ENDIF 
     1691 
     1692               CALL flush(numout) 
     1693 
     1694               !!====================================================================== 
     1695               !! LOCAL GRID CELL CALCULATIONS 
     1696               !!====================================================================== 
     1697               !! 
    16041698# if defined key_roam 
    1605                 if ( jk .eq. 1 ) then 
    1606                    !!---------------------------------------------------------------------- 
    1607                    !! Air-sea gas exchange 
    1608                    !!---------------------------------------------------------------------- 
    1609                    !! 
    1610                    !! AXY (17/07/14): zwind_i and zwind_j do not exist in this 
    1611                    !!                 version of NEMO because it does not include 
    1612                    !!                 the SBC changes that our local version has 
    1613                    !!                 for accessing the HadGEM2 forcing; they  
    1614                    !!                 could be added, but an alternative approach 
    1615                    !!                 is to make use of wndm from oce_trc.F90 
    1616                    !!                 which is wind speed at 10m (which is what 
    1617                    !!                 is required here; this may need to be 
    1618                    !!                 revisited when MEDUSA properly interacts 
    1619                    !!                 with UKESM1 physics 
    1620                    !! 
    1621                    f_wind  = wndm(ji,jj) 
    1622                    IF ( lk_oasis ) THEN 
    1623                       f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling 
    1624                    ENDIF 
    1625                    !! 
    1626                    !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 
    1627                    !!                 in MEDUSA, the gas transfer velocity used in the carbon 
    1628                    !!                 and oxygen cycles has been harmonised and is calculated 
    1629                    !!                 by the same function here; this harmonisation includes 
    1630                    !!                 changes to the PML carbonate chemistry scheme so that 
    1631                    !!                 it too makes use of the same gas transfer velocity; the 
    1632                    !!                 preferred parameterisation of this is Wanninkhof (2014), 
    1633                    !!                 option 7 
    1634                    !! 
     1699               if ( jk .eq. 1 ) then 
     1700                  !!---------------------------------------------------------------------- 
     1701                  !! Air-sea gas exchange 
     1702                  !!---------------------------------------------------------------------- 
     1703                  !! 
     1704                  !! AXY (17/07/14): zwind_i and zwind_j do not exist in this 
     1705                  !!                 version of NEMO because it does not include 
     1706                  !!                 the SBC changes that our local version has 
     1707                  !!                 for accessing the HadGEM2 forcing; they  
     1708                  !!                 could be added, but an alternative approach 
     1709                  !!                 is to make use of wndm from oce_trc.F90 
     1710                  !!                 which is wind speed at 10m (which is what 
     1711                  !!                 is required here; this may need to be 
     1712                  !!                 revisited when MEDUSA properly interacts 
     1713                  !!                 with UKESM1 physics 
     1714                  !! 
     1715                  f_wind  = wndm(ji,jj) 
     1716                  IF (lk_oasis) THEN 
     1717                     f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling 
     1718                  ENDIF 
     1719                  !! 
     1720                  !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 
     1721                  !!                 in MEDUSA, the gas transfer velocity used in the carbon 
     1722                  !!                 and oxygen cycles has been harmonised and is calculated 
     1723                  !!                 by the same function here; this harmonisation includes 
     1724                  !!                 changes to the PML carbonate chemistry scheme so that 
     1725                  !!                 it too makes use of the same gas transfer velocity; the 
     1726                  !!                 preferred parameterisation of this is Wanninkhof (2014), 
     1727                  !!                 option 7 
     1728                  !! 
    16351729#   if defined key_debug_medusa 
    1636                    IF ( lwp ) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 
    1637                    CALL flush(numout) 
     1730                     IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 
     1731                     CALL flush(numout) 
    16381732#   endif 
    1639                    CALL gas_transfer( f_wind, 1, 7, &  ! inputs 
    1640                         f_kw660 )        ! outputs 
     1733                  CALL gas_transfer( f_wind, 1, 7, &  ! inputs 
     1734                                     f_kw660 )        ! outputs 
    16411735#   if defined key_debug_medusa 
    1642                    IF ( lwp ) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 
    1643                    CALL flush(numout) 
     1736                     IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 
     1737                     CALL flush(numout) 
    16441738#   endif 
    1645                    !! 
    1646                    !! air pressure (atm); ultimately this will use air pressure at the base 
    1647                    !! of the UKESM1 atmosphere  
    1648                    !!                                      
    1649                    f_pp0   = 1.0 
    1650                    !! 
    1651                    !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp 
    1652                    !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj) 
    1653                    !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_j =', zwind_j(ji,jj) 
    1654                    !! IF(lwp) WRITE(numout,*) ' MEDUSA f_wind  =', f_wind 
    1655                    !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i    =', fr_i(ji,jj) 
    1656                    !! 
     1739                  !! 
     1740                  !! air pressure (atm); ultimately this will use air pressure at the base 
     1741                  !! of the UKESM1 atmosphere  
     1742                  !!                                      
     1743                  f_pp0   = 1.0 
     1744                  !! 
     1745                  !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp 
     1746                  !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj) 
     1747                  !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_j =', zwind_j(ji,jj) 
     1748                  !! IF(lwp) WRITE(numout,*) ' MEDUSA f_wind  =', f_wind 
     1749                  !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i    =', fr_i(ji,jj) 
     1750                  !! 
    16571751#  if defined key_axy_carbchem 
    1658                    !! 
    1659                    !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
    1660                    !!                 chemistry package; note that depth is set to 
    1661                    !!                 zero in this call 
    1662                    CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs 
    1663                         f_pp0, 0.0, flatx, f_kw660, f_xco2a, 1,                          &  ! inputs 
    1664                         f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs 
    1665                         f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs 
    1666                         f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs 
    1667                         f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs 
    1668                    !! 
    1669                    f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
    1670                    f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
    1671                    f_dcf  = f_rhosw 
     1752#   if defined key_mocsy 
     1753                  !! 
     1754                  !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
     1755                  !!                 chemistry package; note that depth is set to 
     1756                  !!                 zero in this call 
     1757                  CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs 
     1758                  f_pp0, 0.0, gphit(ji,jj), f_kw660, f_xco2a, 1,                   &  ! inputs 
     1759                  f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs 
     1760                  f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs 
     1761                  f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs 
     1762                  f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs 
     1763                  !! 
     1764                  f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
     1765                  f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
     1766                  f_dcf  = f_rhosw 
     1767#   else                   
     1768                  iters = 0 
     1769                  !! 
     1770                  !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not) 
     1771                  CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_xco2a,  &  ! inputs 
     1772                  f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),               &  ! outputs 
     1773                  f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )      ! outputs 
     1774                  !! 
     1775                  !! AXY (09/01/14): removed iteration and NaN checks; these have 
     1776                  !!                 been moved to trc_co2_medusa together with a 
     1777                  !!                 fudge that amends erroneous values (this is 
     1778                  !!                 intended to be a temporary fudge!); the 
     1779                  !!                 output warnings are retained here so that 
     1780                  !!                 failure position can be determined 
     1781                  if (iters .eq. 25) then 
     1782                     IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 
     1783                     iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
     1784                  endif 
     1785#   endif 
    16721786#  else 
    1673                    !! AXY (18/04/13): switch off carbonate chemistry calculations; provide 
    1674                    !!                 quasi-sensible alternatives 
    1675                    f_ph           = 8.1 
    1676                    f_pco2w        = f_xco2a 
    1677                    f_h2co3        = 0.005 * zdic 
    1678                    f_hco3         = 0.865 * zdic 
    1679                    f_co3          = 0.130 * zdic 
    1680                    f_omcal(ji,jj) = 4. 
    1681                    f_omarg(ji,jj) = 2. 
    1682                    f_co2flux      = 0. 
    1683                    f_TDIC         = zdic 
    1684                    f_TALK         = zalk 
    1685                    f_dcf          = 1.026 
    1686                    f_henry        = 1. 
    1687                    !! AXY (23/06/15): add in some extra MOCSY diagnostics 
    1688                    f_fco2w        = f_xco2a 
    1689                    f_BetaD        = 1. 
    1690                    f_rhosw        = 1.026 
    1691                    f_opres        = 0. 
    1692                    f_insitut      = ztmp 
    1693                    f_pco2atm      = f_xco2a 
    1694                    f_fco2atm      = f_xco2a 
    1695                    f_schmidtco2   = 660. 
    1696                    f_kwco2        = 0. 
    1697                    f_K0           = 0. 
    1698                    f_co2starair   = f_xco2a 
    1699                    f_dpco2        = 0. 
     1787                  !! AXY (18/04/13): switch off carbonate chemistry calculations; provide 
     1788                  !!                 quasi-sensible alternatives 
     1789                  f_ph           = 8.1 
     1790                  f_pco2w        = f_xco2a 
     1791                  f_h2co3        = 0.005 * zdic 
     1792                  f_hco3         = 0.865 * zdic 
     1793                  f_co3          = 0.130 * zdic 
     1794                  f_omcal(ji,jj) = 4. 
     1795                  f_omarg(ji,jj) = 2. 
     1796                  f_co2flux      = 0. 
     1797                  f_TDIC         = zdic 
     1798                  f_TALK         = zalk 
     1799                  f_dcf          = 1.026 
     1800                  f_henry        = 1. 
     1801                  !! AXY (23/06/15): add in some extra MOCSY diagnostics 
     1802                  f_fco2w        = f_xco2a 
     1803                  f_BetaD        = 1. 
     1804                  f_rhosw        = 1.026 
     1805                  f_opres        = 0. 
     1806                  f_insitut      = ztmp 
     1807                  f_pco2atm      = f_xco2a 
     1808                  f_fco2atm      = f_xco2a 
     1809                  f_schmidtco2   = 660. 
     1810                  f_kwco2        = 0. 
     1811                  f_K0           = 0. 
     1812                  f_co2starair   = f_xco2a 
     1813                  f_dpco2        = 0. 
    17001814#  endif 
    1701                    !! 
    1702                    !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness 
    1703                    f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk 
    1704                    !! 
    1705                    !! oxygen (O2); OCMIP-2 code 
    1706                    !! AXY (23/06/15): amend input list for oxygen to account for common gas 
    1707                    !!                 transfer velocity 
    1708                    !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs 
    1709                    !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs 
    1710                    CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs 
    1711                         f_kwo2, f_o2flux, f_o2sat )                                ! outputs 
    1712                    !! 
    1713                    !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness 
    1714                    f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk 
    1715                    !! 
    1716                    !! Jpalm (08-2014) 
    1717                    !! DMS surface concentration calculation; initialy added using MET-OFFICE subroutine 
    1718                    !! air-sea flux calculated in atmospheric chemistry from atm and ocn concentrations 
    1719                    !! 
    1720                    !! AXY (13/03/15): this is amended to calculate all of the DMS 
    1721                    !!                 estimates examined during UKESM1 (see comments 
    1722                    !!                 in trcdms_medusa.F90) 
    1723                    !! 
    1724                    !! AXY (28/03/17): amended to pass DIN limitation instead of DIN concentration; 
    1725                    !!                 accounts for differences in nutrient half-saturations; changes  
    1726                    !!                 also made in trc_dms_medusa 
    1727                    !! 
    1728                    IF (jdms .eq. 1) THEN 
    1729                       !! 
    1730                       !! calculate weighted half-saturation for DIN uptake 
    1731                       dms_wtkn = ((zphn * xnln) + (zphd * xnld)) / (zphn + zphd) 
    1732                       !! 
    1733                       !! feed in correct inputs 
    1734                       if (jdms_input .eq. 0) then 
    1735                          !! use instantaneous inputs 
    1736                          dms_nlim = zdin / (zdin + dms_wtkn) 
    1737                          !! 
    1738                          CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), dms_nlim, &  ! inputs 
    1739                               dms_andr, dms_simo, dms_aran, dms_hall )                               ! outputs 
    1740                       else 
    1741                          !! use diel-average inputs 
    1742                          dms_nlim = zn_dms_din(ji,jj) / (zn_dms_din(ji,jj) + dms_wtkn)  
    1743                          !! 
    1744                          CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs 
    1745                               zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj), dms_nlim,            &  ! inputs 
    1746                               dms_andr, dms_simo, dms_aran, dms_hall )                      ! outputs 
    1747                       endif 
    1748                       !! 
    1749                       !! assign correct output to variable passed to atmosphere 
    1750                       if     (jdms_model .eq. 1) then 
    1751                          dms_surf = dms_andr 
    1752                       elseif (jdms_model .eq. 2) then 
    1753                          dms_surf = dms_simo 
    1754                       elseif (jdms_model .eq. 3) then 
    1755                          dms_surf = dms_aran 
    1756                       elseif (jdms_model .eq. 4) then 
    1757                          dms_surf = dms_hall 
    1758                       endif 
    1759                       !! 
    1760                       !! 2D diag through iom_use 
    1761                       IF( lk_iomput ) THEN 
    1762                          IF( med_diag%DMS_SURF%dgsave ) THEN 
    1763                             dms_surf2d(ji,jj) = dms_surf 
    1764                          ENDIF 
    1765                          IF( med_diag%DMS_ANDR%dgsave ) THEN 
    1766                             dms_andr2d(ji,jj) = dms_andr 
    1767                          ENDIF 
    1768                          IF( med_diag%DMS_SIMO%dgsave ) THEN 
    1769                             dms_simo2d(ji,jj) = dms_simo 
    1770                          ENDIF 
    1771                          IF( med_diag%DMS_ARAN%dgsave ) THEN 
    1772                             dms_aran2d(ji,jj) = dms_aran 
    1773                          ENDIF 
    1774                          IF( med_diag%DMS_HALL%dgsave ) THEN 
    1775                             dms_hall2d(ji,jj) = dms_hall 
    1776                          ENDIF 
     1815                  !! 
     1816                  !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness 
     1817                  f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk 
     1818                  !! 
     1819                  !! oxygen (O2); OCMIP-2 code 
     1820                  !! AXY (23/06/15): amend input list for oxygen to account for common gas 
     1821                  !!                 transfer velocity 
     1822                  !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs 
     1823                  !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs 
     1824                  CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs 
     1825                  f_kwo2, f_o2flux, f_o2sat )                                ! outputs 
     1826                  !! 
     1827                  !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness 
     1828                  f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk 
     1829                  !! 
     1830                  !! Jpalm (08-2014) 
     1831                  !! DMS surface concentration calculation 
     1832                  !! initialy added for UKESM1 model. 
     1833                  !! using MET-OFFICE subroutine. 
     1834                  !! DMS module only needs Chl concentration and MLD 
     1835                  !! to get an aproximate value of DMS concentration. 
     1836                  !! air-sea fluxes are calculated by atmospheric chemitry model 
     1837                  !! from atm and oc-surface concentrations. 
     1838                  !! 
     1839                  !! AXY (13/03/15): this is amended to calculate all of the DMS 
     1840                  !!                 estimates examined during UKESM1 (see comments 
     1841                  !!                 in trcdms_medusa.F90) 
     1842                  !! 
     1843                  IF (jdms .eq. 1) THEN 
     1844                     !! 
     1845                     !! feed in correct inputs 
     1846                     if (jdms_input .eq. 0) then 
     1847                        !! use instantaneous inputs 
     1848                        CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), zdin, &  ! inputs 
     1849                        dms_andr, dms_simo, dms_aran, dms_hall )                           ! outputs 
     1850                     else 
     1851                        !! use diel-average inputs 
     1852                        CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs 
     1853                        zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj), zn_dms_din(ji,jj),   &  ! inputs 
     1854                        dms_andr, dms_simo, dms_aran, dms_hall )                      ! outputs 
     1855                     endif 
     1856                     !! 
     1857                     !! assign correct output to variable passed to atmosphere 
     1858                     if     (jdms_model .eq. 1) then 
     1859                        dms_surf = dms_andr 
     1860                     elseif (jdms_model .eq. 2) then 
     1861                        dms_surf = dms_simo 
     1862                     elseif (jdms_model .eq. 3) then 
     1863                        dms_surf = dms_aran 
     1864                     elseif (jdms_model .eq. 4) then 
     1865                        dms_surf = dms_hall 
     1866                     endif 
     1867                     !! 
     1868                     !! 2D diag through iom_use 
     1869                     IF( lk_iomput ) THEN 
     1870                       IF( med_diag%DMS_SURF%dgsave ) THEN 
     1871                         dms_surf2d(ji,jj) = dms_surf 
     1872                       ENDIF 
     1873                       IF( med_diag%DMS_ANDR%dgsave ) THEN 
     1874                         dms_andr2d(ji,jj) = dms_andr 
     1875                       ENDIF 
     1876                       IF( med_diag%DMS_SIMO%dgsave ) THEN 
     1877                         dms_simo2d(ji,jj) = dms_simo 
     1878                       ENDIF 
     1879                       IF( med_diag%DMS_ARAN%dgsave ) THEN 
     1880                         dms_aran2d(ji,jj) = dms_aran 
     1881                       ENDIF 
     1882                       IF( med_diag%DMS_HALL%dgsave ) THEN 
     1883                         dms_hall2d(ji,jj) = dms_hall 
     1884                       ENDIF 
    17771885#   if defined key_debug_medusa 
    1778                          IF ( lwp ) write (numout,*) 'trc_bio_medusa: finish calculating dms' 
    1779                          CALL flush(numout) 
     1886                       IF (lwp) write (numout,*) 'trc_bio_medusa: finish calculating dms' 
     1887                     CALL flush(numout) 
    17801888#   endif  
    1781                       ENDIF 
    1782                       !! End iom 
    1783                    ENDIF 
    1784                    !! End DMS Loop 
    1785                    !! 
    1786                    !! store 2D outputs 
    1787                    !! 
    1788                    !! JPALM -- 17-11-16 -- put fgco2 out of diag request 
    1789                    !!                    is needed for coupling; pass through restart 
    1790                    !! IF( med_diag%FGCO2%dgsave ) THEN 
    1791                    !! convert from  mol/m2/day to kg/m2/s 
    1792                    fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv  !! mmol-C/m3/d -> kg-CO2/m2/s 
    1793                    !! ENDIF 
    1794                    IF ( lk_iomput ) THEN 
     1889                     ENDIF 
     1890                     !! End iom 
     1891                  ENDIF 
     1892                  !! End DMS Loop 
     1893                  !! 
     1894                  !! store 2D outputs 
     1895                  !! 
     1896                  !! JPALM -- 17-11-16 -- put fgco2 out of diag request 
     1897                  !!                    is needed for coupling; pass through restart 
     1898                  !! IF( med_diag%FGCO2%dgsave ) THEN 
     1899                     !! convert from  mol/m2/day to kg/m2/s 
     1900                     fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv  !! mmol-C/m3/d -> kg-CO2/m2/s 
     1901                  !! ENDIF 
     1902                  IF ( lk_iomput ) THEN 
    17951903                      IF( med_diag%ATM_PCO2%dgsave ) THEN 
    17961904                         f_pco2a2d(ji,jj) = f_pco2atm 
     
    18481956                         f_ocndpco2_2d(ji,jj) = f_dpco2 
    18491957                      ENDIF 
    1850                    ENDIF 
    1851                    !!  
    1852                 endif 
    1853                 !! End jk = 1 loop within ROAM key  
    1854  
    1855                 !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic 
    1856                 IF ( med_diag%O2SAT3%dgsave ) THEN 
    1857                    call oxy_sato( ztmp, zsal, f_o2sat3 ) 
    1858                    o2sat3(ji, jj, jk) = f_o2sat3 
    1859                 ENDIF 
    1860  
    1861 # endif 
    1862  
    1863                 !!====================================================================== 
    1864                 !! AXY (07/04/17): possible subroutine block; riverine inputs (or delete; it's unused presently) 
    1865                 !!====================================================================== 
    1866                 if ( jk .eq. 1 ) then 
    1867                    !!---------------------------------------------------------------------- 
    1868                    !! River inputs 
    1869                    !!---------------------------------------------------------------------- 
    1870                    !! 
    1871                    !! runoff comes in as        kg / m2 / s 
    1872                    !! used and written out as   m3 / m2 / d (= m / d) 
    1873                    !! where                     1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d 
    1874                    !! 
    1875                    !! AXY (17/07/14): the compiler doesn't like this line for some reason; 
    1876                    !!                 as MEDUSA doesn't even use runoff for riverine inputs, 
    1877                    !!                 a temporary solution is to switch off runoff entirely 
    1878                    !!                 here; again, this change is one of several that will  
    1879                    !!                 need revisiting once MEDUSA has bedded down in UKESM1; 
    1880                    !!                 particularly so if the land scheme provides information 
    1881                    !!                 concerning nutrient fluxes 
    1882                    !! 
    1883                    !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. 
    1884                    f_runoff(ji,jj) = 0.0 
    1885                    !! 
    1886                    !! nutrients are added via rivers to the model in one of two ways: 
    1887                    !!   1. via river concentration; i.e. the average nutrient concentration 
    1888                    !!      of a river water is described by a spatial file, and this is 
    1889                    !!      multiplied by runoff to give a nutrient flux 
    1890                    !!   2. via direct river flux; i.e. the average nutrient flux due to 
    1891                    !!      rivers is described by a spatial file, and this is simply applied 
    1892                    !!      as a direct nutrient flux (i.e. it does not relate or respond to 
    1893                    !!      model runoff) 
    1894                    !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and 
    1895                    !! alkalinity are derived from continent-scale DIC estimates (Huang et al.,  
    1896                    !! 2012) and some Arctic river alkalinity estimates (Katya?) 
    1897                    !!  
    1898                    !! as of 19/07/12, riverine nutrients can now be spread vertically across  
    1899                    !! several grid cells rather than just poured into the surface box; this 
    1900                    !! block of code is still executed, however, to set up the total amounts 
    1901                    !! of nutrient entering via rivers 
    1902                    !! 
    1903                    !! nitrogen 
    1904                    if (jriver_n .eq. 1) then 
    1905                       !! river concentration specified; use runoff to calculate input 
    1906                       f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) 
    1907                    elseif (jriver_n .eq. 2) then 
    1908                       !! river flux specified; independent of runoff 
    1909                       f_riv_n(ji,jj) = riv_n(ji,jj) 
    1910                    endif 
    1911                    !! 
    1912                    !! silicon 
    1913                    if (jriver_si .eq. 1) then 
    1914                       !! river concentration specified; use runoff to calculate input 
    1915                       f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) 
    1916                    elseif (jriver_si .eq. 2) then 
    1917                       !! river flux specified; independent of runoff 
    1918                       f_riv_si(ji,jj) = riv_si(ji,jj) 
    1919                    endif 
    1920                    !! 
    1921                    !! carbon 
    1922                    if (jriver_c .eq. 1) then 
    1923                       !! river concentration specified; use runoff to calculate input 
    1924                       f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) 
    1925                    elseif (jriver_c .eq. 2) then 
    1926                       !! river flux specified; independent of runoff 
    1927                       f_riv_c(ji,jj) = riv_c(ji,jj) 
    1928                    endif 
    1929                    !! 
    1930                    !! alkalinity 
    1931                    if (jriver_alk .eq. 1) then 
    1932                       !! river concentration specified; use runoff to calculate input 
    1933                       f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) 
    1934                    elseif (jriver_alk .eq. 2) then 
    1935                       !! river flux specified; independent of runoff 
    1936                       f_riv_alk(ji,jj) = riv_alk(ji,jj) 
    1937                    endif 
    1938  
    1939                 endif 
    1940  
    1941                 !!====================================================================== 
    1942                 !! AXY (07/04/17): possible subroutine block; phytoplankton growth 
    1943                 !!====================================================================== 
    1944  
    1945                 !!---------------------------------------------------------------------- 
    1946                 !! Chlorophyll calculations 
    1947                 !!---------------------------------------------------------------------- 
    1948                 !! 
    1949                 !! non-diatoms 
    1950                 if (zphn.GT.rsmall) then 
    1951                    fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) 
    1952                    faln    = xaln * fthetan 
    1953                 else 
    1954                    fthetan = 0. 
    1955                    faln    = 0. 
    1956                 endif 
    1957                 !! 
    1958                 !! diatoms 
    1959                 if (zphd.GT.rsmall) then 
    1960                    fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) 
    1961                    fald    = xald * fthetad 
    1962                 else 
    1963                    fthetad = 0. 
    1964                    fald    = 0. 
    1965                 endif 
    1966  
    1967                 !!---------------------------------------------------------------------- 
    1968                 !! Phytoplankton light limitation 
    1969                 !!---------------------------------------------------------------------- 
    1970                 !! 
    1971                 !! It is assumed xpar is the depth-averaged (vertical layer) PAR  
    1972                 !! Light limitation (check self-shading) in W/m2 
    1973                 !! 
    1974                 !! Note that there is no temperature dependence in phytoplankton 
    1975                 !! growth rate or any other function.  
    1976                 !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid 
    1977                 !! NaNs in case of Phy==0.   
    1978                 !! 
    1979                 !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat:  
    1980                 !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 
    1981                 !! 
    1982                 !! AXY (16/07/09) 
    1983                 !! temperature for new Eppley style phytoplankton growth 
    1984                 loc_T   = tsn(ji,jj,jk,jp_tem) 
    1985                 fun_T   = 1.066**(1.0 * loc_T) 
    1986                 !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for 
    1987                 !phytoplankton 
    1988                 !!                 growth; remin. unaffected 
    1989                 fun_Q10 = xq10**((loc_T - 0.0) / 10.0) 
    1990                 if (jphy.eq.1) then 
    1991                    xvpnT = xvpn * fun_T 
    1992                    xvpdT = xvpd * fun_T 
    1993                 elseif (jphy.eq.2) then 
    1994                    xvpnT = xvpn * fun_Q10 
    1995                    xvpdT = xvpd * fun_Q10 
    1996                 else 
    1997                    xvpnT = xvpn 
    1998                    xvpdT = xvpd 
    1999                 endif 
    2000                 !! 
    2001                 !! non-diatoms 
    2002                 fchn1   = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    2003                 if (fchn1.GT.rsmall) then 
    2004                    fchn    = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 
    2005                 else 
    2006                    fchn    = 0. 
    2007                 endif 
    2008                 fjln    = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term 
    2009                 fjlim_pn = fjln / xvpnT 
    2010                 !! 
    2011                 !! diatoms 
    2012                 fchd1   = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    2013                 if (fchd1.GT.rsmall) then 
    2014                    fchd    = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 
    2015                 else 
    2016                    fchd    = 0. 
    2017                 endif 
    2018                 fjld    = fchd * fald * xpar(ji,jj,jk) !! diatom J term 
    2019                 fjlim_pd = fjld / xvpdT 
    2020  
    2021                 !!---------------------------------------------------------------------- 
    2022                 !! Phytoplankton nutrient limitation 
    2023                 !!---------------------------------------------------------------------- 
    2024                 !! 
    2025                 !! non-diatoms (N, Fe) 
    2026                 fnln = zdin / (zdin + xnln) !! non-diatom Qn term 
    2027                 ffln = zfer / (zfer + xfln) !! non-diatom Qf term 
    2028                 !! 
    2029                 !! diatoms (N, Si, Fe) 
    2030                 fnld = zdin / (zdin + xnld) !! diatom Qn term 
    2031                 fsld = zsil / (zsil + xsld) !! diatom Qs term 
    2032                 ffld = zfer / (zfer + xfld) !! diatom Qf term 
    2033  
    2034                 !!---------------------------------------------------------------------- 
    2035                 !! Primary production (non-diatoms) 
    2036                 !! (note: still needs multiplying by phytoplankton concentration) 
    2037                 !!---------------------------------------------------------------------- 
    2038                 !! 
    2039                 if (jliebig .eq. 0) then 
    2040                    !! multiplicative nutrient limitation 
    2041                    fpnlim = fnln * ffln 
    2042                 elseif (jliebig .eq. 1) then 
    2043                    !! Liebig Law (= most limiting) nutrient limitation 
    2044                    fpnlim = min(fnln, ffln) 
    2045                 endif 
    2046                 fprn = fjln * fpnlim 
    2047  
    2048                 !!---------------------------------------------------------------------- 
    2049                 !! Primary production (diatoms) 
    2050                 !! (note: still needs multiplying by phytoplankton concentration) 
    2051                 !! 
    2052                 !! production here is split between nitrogen production and that of 
    2053                 !! silicon; depending upon the "intracellular" ratio of Si:N, model 
    2054                 !! diatoms will uptake nitrogen/silicon differentially; this borrows 
    2055                 !! from the diatom model of Mongin et al. (2006) 
    2056                 !!---------------------------------------------------------------------- 
    2057                 !! 
    2058                 if (jliebig .eq. 0) then 
    2059                    !! multiplicative nutrient limitation 
    2060                    fpdlim = fnld * ffld 
    2061                 elseif (jliebig .eq. 1) then 
    2062                    !! Liebig Law (= most limiting) nutrient limitation 
    2063                    fpdlim = min(fnld, ffld) 
    2064                 endif 
    2065                 !! 
    2066                 if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then 
    2067                    !! "intracellular" elemental ratios 
    2068                    ! fsin  = zpds / (zphd + tiny(zphd)) 
    2069                    ! fnsi  = zphd / (zpds + tiny(zpds)) 
    2070                    fsin = 0.0 
    2071                    IF( zphd .GT. rsmall) fsin  = zpds / zphd 
    2072                    fnsi = 0.0 
    2073                    IF( zpds .GT. rsmall) fnsi  = zphd / zpds 
    2074                    !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) 
    2075                    fsin1 = 3.0 * xsin0 !! = 0.6 
    2076                    fnsi1 = 1.0 / fsin1 !! = 1.667 
    2077                    fnsi2 = 1.0 / xsin0 !! = 5.0 
    2078                    !! 
    2079                    !! conditionalities based on ratios 
    2080                    !! nitrogen (and iron and carbon) 
    2081                    if (fsin.le.xsin0) then 
    2082                       fprd  = 0.0 
    2083                       fsld2 = 0.0 
    2084                    elseif (fsin.lt.fsin1) then 
    2085                       fprd  = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) 
    2086                       fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) 
    2087                    elseif (fsin.ge.fsin1) then 
    2088                       fprd  = (fjld * fpdlim) 
    2089                       fsld2 = 1.0 
    2090                    endif 
    2091                    !! 
    2092                    !! silicon 
    2093                    if (fsin.lt.fnsi1) then 
    2094                       fprds = (fjld * fsld) 
    2095                    elseif (fsin.lt.fnsi2) then 
    2096                       fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) 
    2097                    else 
    2098                       fprds = 0.0 
    2099                    endif 
    2100                 else 
    2101                    fsin  = 0.0 
    2102                    fnsi  = 0.0 
    2103                    fprd  = 0.0 
    2104                    fsld2 = 0.0 
    2105                    fprds = 0.0 
    2106                 endif 
    2107  
    2108                 !!---------------------------------------------------------------------- 
    2109                 !! Mixed layer primary production 
    2110                 !! this block calculates the amount of primary production that occurs 
    2111                 !! within the upper mixed layer; this allows the separate diagnosis 
    2112                 !! of "sub-surface" primary production; it does assume that short- 
    2113                 !! term variability in mixed layer depth doesn't mess with things 
    2114                 !! though 
    2115                 !!---------------------------------------------------------------------- 
    2116                 !! 
    2117                 if (fdep1.le.hmld(ji,jj)) then 
    2118                    !! this level is entirely in the mixed layer 
    2119                    fq0 = 1.0 
    2120                 elseif (fdep.ge.hmld(ji,jj)) then 
    2121                    !! this level is entirely below the mixed layer 
    2122                    fq0 = 0.0 
    2123                 else 
    2124                    !! this level straddles the mixed layer 
    2125                    fq0 = (hmld(ji,jj) - fdep) / fthk 
    2126                 endif 
    2127                 !! 
    2128                 fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) 
    2129                 fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) 
    2130  
    2131                 !!---------------------------------------------------------------------- 
    2132                 !! Vertical Integral -- 
    2133                 !!---------------------------------------------------------------------- 
    2134                 ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)   !! vertical integral non-diatom phytoplankton 
    2135                 ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)   !! vertical integral diatom phytoplankton 
    2136                 ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)   !! vertical integral microzooplankton 
    2137                 ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)   !! vertical integral mesozooplankton 
    2138                 ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)   !! vertical integral slow detritus, nitrogen 
    2139                 ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)   !! vertical integral slow detritus, carbon 
    2140  
    2141                 !!---------------------------------------------------------------------- 
    2142                 !! More chlorophyll calculations 
    2143                 !!---------------------------------------------------------------------- 
    2144                 !! 
    2145                 !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) 
    2146                 !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) 
    2147                 frn = (xthetam * fchn * fnln * ffln       ) / (fthetan + tiny(fthetan)) 
    2148                 !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid  
    2149                 !!   limitation, is used in the following line to regulate chlorophyll  
    2150                 !!   growth in a manner that is inconsistent with its use in the regulation  
    2151                 !!   of biomass growth; the Mongin term term used in growth is more complex 
    2152                 !!   than the simple multiplicative function used below 
    2153                 !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) 
    2154                 !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to 
    2155                 !!   regulate chlorophyll growth 
    2156                 frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) 
    2157  
    2158                 !!====================================================================== 
    2159                 !! AXY (07/04/17): possible subroutine block; zooplankton grazing 
    2160                 !!====================================================================== 
    2161  
    2162                 !!---------------------------------------------------------------------- 
    2163                 !! Zooplankton Grazing  
    2164                 !! this code supplements the base grazing model with one that 
    2165                 !! considers the C:N ratio of grazed food and balances this against 
    2166                 !! the requirements of zooplankton growth; this model is derived  
    2167                 !! from that of Anderson & Pondaven (2003) 
    2168                 !! 
    2169                 !! the current version of the code assumes a fixed C:N ratio for 
    2170                 !! detritus (in contrast to Anderson & Pondaven, 2003), though the 
    2171                 !! full equations are retained for future extension 
    2172                 !!---------------------------------------------------------------------- 
    2173                 !! 
    2174                 !!---------------------------------------------------------------------- 
    2175                 !! Microzooplankton first 
    2176                 !!---------------------------------------------------------------------- 
    2177                 !! 
    2178                 fmi1    = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) 
    2179                 fmi     = xgmi * zzmi / fmi1 
    2180                 fgmipn  = fmi * xpmipn * zphn * zphn   !! grazing on non-diatoms 
    2181                 fgmid   = fmi * xpmid  * zdet * zdet   !! grazing on detrital nitrogen 
     1958                  ENDIF 
     1959                  !!  
     1960               endif 
     1961               !! End jk = 1 loop within ROAM key  
     1962 
     1963               !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic 
     1964               IF ( med_diag%O2SAT3%dgsave ) THEN 
     1965                  call oxy_sato( ztmp, zsal, f_o2sat3 ) 
     1966                  o2sat3(ji, jj, jk) = f_o2sat3 
     1967               ENDIF 
     1968 
     1969# endif 
     1970 
     1971               if ( jk .eq. 1 ) then 
     1972                  !!---------------------------------------------------------------------- 
     1973                  !! River inputs 
     1974                  !!---------------------------------------------------------------------- 
     1975                  !! 
     1976                  !! runoff comes in as        kg / m2 / s 
     1977                  !! used and written out as   m3 / m2 / d (= m / d) 
     1978                  !! where                     1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d 
     1979                  !! 
     1980                  !! AXY (17/07/14): the compiler doesn't like this line for some reason; 
     1981                  !!                 as MEDUSA doesn't even use runoff for riverine inputs, 
     1982                  !!                 a temporary solution is to switch off runoff entirely 
     1983                  !!                 here; again, this change is one of several that will  
     1984                  !!                 need revisiting once MEDUSA has bedded down in UKESM1; 
     1985                  !!                 particularly so if the land scheme provides information 
     1986                  !!                 concerning nutrient fluxes 
     1987                  !! 
     1988                  !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. 
     1989                  f_runoff(ji,jj) = 0.0 
     1990                  !! 
     1991                  !! nutrients are added via rivers to the model in one of two ways: 
     1992                  !!   1. via river concentration; i.e. the average nutrient concentration 
     1993                  !!      of a river water is described by a spatial file, and this is 
     1994                  !!      multiplied by runoff to give a nutrient flux 
     1995                  !!   2. via direct river flux; i.e. the average nutrient flux due to 
     1996                  !!      rivers is described by a spatial file, and this is simply applied 
     1997                  !!      as a direct nutrient flux (i.e. it does not relate or respond to 
     1998                  !!      model runoff) 
     1999                  !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and 
     2000                  !! alkalinity are derived from continent-scale DIC estimates (Huang et al.,  
     2001                  !! 2012) and some Arctic river alkalinity estimates (Katya?) 
     2002                  !!  
     2003                  !! as of 19/07/12, riverine nutrients can now be spread vertically across  
     2004                  !! several grid cells rather than just poured into the surface box; this 
     2005                  !! block of code is still executed, however, to set up the total amounts 
     2006                  !! of nutrient entering via rivers 
     2007                  !! 
     2008                  !! nitrogen 
     2009                  if (jriver_n .eq. 1) then 
     2010                     !! river concentration specified; use runoff to calculate input 
     2011                     f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) 
     2012                  elseif (jriver_n .eq. 2) then 
     2013                     !! river flux specified; independent of runoff 
     2014                     f_riv_n(ji,jj) = riv_n(ji,jj) 
     2015                  endif 
     2016                  !! 
     2017                  !! silicon 
     2018                  if (jriver_si .eq. 1) then 
     2019                     !! river concentration specified; use runoff to calculate input 
     2020                     f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) 
     2021                  elseif (jriver_si .eq. 2) then 
     2022                     !! river flux specified; independent of runoff 
     2023                     f_riv_si(ji,jj) = riv_si(ji,jj) 
     2024                  endif 
     2025                  !! 
     2026                  !! carbon 
     2027                  if (jriver_c .eq. 1) then 
     2028                     !! river concentration specified; use runoff to calculate input 
     2029                     f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) 
     2030                  elseif (jriver_c .eq. 2) then 
     2031                     !! river flux specified; independent of runoff 
     2032                     f_riv_c(ji,jj) = riv_c(ji,jj) 
     2033                  endif 
     2034                  !! 
     2035                  !! alkalinity 
     2036                  if (jriver_alk .eq. 1) then 
     2037                     !! river concentration specified; use runoff to calculate input 
     2038                     f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) 
     2039                  elseif (jriver_alk .eq. 2) then 
     2040                     !! river flux specified; independent of runoff 
     2041                     f_riv_alk(ji,jj) = riv_alk(ji,jj) 
     2042                  endif 
     2043 
     2044               endif 
     2045 
     2046               !!---------------------------------------------------------------------- 
     2047               !! Chlorophyll calculations 
     2048               !!---------------------------------------------------------------------- 
     2049               !! 
     2050               !! non-diatoms 
     2051          if (zphn.GT.rsmall) then 
     2052                  fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) 
     2053                  faln    = xaln * fthetan 
     2054               else 
     2055                  fthetan = 0. 
     2056                  faln    = 0. 
     2057               endif 
     2058               !! 
     2059               !! diatoms 
     2060          if (zphd.GT.rsmall) then 
     2061                  fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) 
     2062                  fald    = xald * fthetad 
     2063               else 
     2064                  fthetad = 0. 
     2065                  fald    = 0. 
     2066               endif 
     2067 
     2068# if defined key_debug_medusa 
     2069               !! report biological calculations 
     2070               if (idf.eq.1.AND.idfval.eq.1) then 
     2071                  IF (lwp) write (numout,*) '------------------------------' 
     2072                  IF (lwp) write (numout,*) 'faln(',jk,') = ', faln 
     2073                  IF (lwp) write (numout,*) 'fald(',jk,') = ', fald 
     2074               endif 
     2075# endif 
     2076 
     2077               !!---------------------------------------------------------------------- 
     2078               !! Phytoplankton light limitation 
     2079               !!---------------------------------------------------------------------- 
     2080               !! 
     2081               !! It is assumed xpar is the depth-averaged (vertical layer) PAR  
     2082               !! Light limitation (check self-shading) in W/m2 
     2083               !! 
     2084               !! Note that there is no temperature dependence in phytoplankton 
     2085               !! growth rate or any other function.  
     2086               !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid 
     2087               !! NaNs in case of Phy==0.   
     2088               !! 
     2089               !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat:  
     2090               !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 
     2091               !! 
     2092               !! AXY (16/07/09) 
     2093               !! temperature for new Eppley style phytoplankton growth 
     2094               loc_T   = tsn(ji,jj,jk,jp_tem) 
     2095               fun_T   = 1.066**(1.0 * loc_T) 
     2096               !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for 
     2097               !phytoplankton 
     2098               !!                 growth; remin. unaffected 
     2099               fun_Q10 = jq10**((loc_T - 0.0) / 10.0) 
     2100               if (jphy.eq.1) then 
     2101                  xvpnT = xvpn * fun_T 
     2102                  xvpdT = xvpd * fun_T 
     2103               elseif (jphy.eq.2) then 
     2104                  xvpnT = xvpn * fun_Q10 
     2105                  xvpdT = xvpd * fun_Q10 
     2106               else 
     2107                  xvpnT = xvpn 
     2108                  xvpdT = xvpd 
     2109               endif 
     2110               !! 
     2111               !! non-diatoms 
     2112               fchn1   = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
     2113               if (fchn1.GT.rsmall) then 
     2114                  fchn    = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 
     2115               else 
     2116                  fchn    = 0. 
     2117               endif 
     2118               fjln    = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term 
     2119               fjlim_pn = fjln / xvpnT 
     2120               !! 
     2121               !! diatoms 
     2122               fchd1   = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
     2123               if (fchd1.GT.rsmall) then 
     2124                  fchd    = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 
     2125               else 
     2126                  fchd    = 0. 
     2127               endif 
     2128               fjld    = fchd * fald * xpar(ji,jj,jk) !! diatom J term 
     2129               fjlim_pd = fjld / xvpdT 
     2130       
     2131# if defined key_debug_medusa 
     2132               !! report phytoplankton light limitation 
     2133               if (idf.eq.1.AND.idfval.eq.1) then 
     2134                  IF (lwp) write (numout,*) '------------------------------' 
     2135                  IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn 
     2136                  IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd 
     2137                  IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln 
     2138                  IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld 
     2139               endif 
     2140# endif 
     2141 
     2142               !!---------------------------------------------------------------------- 
     2143               !! Phytoplankton nutrient limitation 
     2144               !!---------------------------------------------------------------------- 
     2145               !! 
     2146               !! non-diatoms (N, Fe) 
     2147               fnln = zdin / (zdin + xnln) !! non-diatom Qn term 
     2148               ffln = zfer / (zfer + xfln) !! non-diatom Qf term 
     2149               !! 
     2150               !! diatoms (N, Si, Fe) 
     2151               fnld = zdin / (zdin + xnld) !! diatom Qn term 
     2152               fsld = zsil / (zsil + xsld) !! diatom Qs term 
     2153               ffld = zfer / (zfer + xfld) !! diatom Qf term 
     2154 
     2155# if defined key_debug_medusa 
     2156               !! report phytoplankton nutrient limitation 
     2157               if (idf.eq.1.AND.idfval.eq.1) then 
     2158                  IF (lwp) write (numout,*) '------------------------------' 
     2159                  IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln 
     2160                  IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld 
     2161                  IF (lwp) write (numout,*) 'ffln(',jk,') = ', ffln 
     2162                  IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld 
     2163                  IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld 
     2164               endif 
     2165# endif 
     2166 
     2167               !!---------------------------------------------------------------------- 
     2168               !! Primary production (non-diatoms) 
     2169               !! (note: still needs multiplying by phytoplankton concentration) 
     2170               !!---------------------------------------------------------------------- 
     2171               !! 
     2172               if (jliebig .eq. 0) then 
     2173                  !! multiplicative nutrient limitation 
     2174                  fpnlim = fnln * ffln 
     2175               elseif (jliebig .eq. 1) then 
     2176                  !! Liebig Law (= most limiting) nutrient limitation 
     2177                  fpnlim = min(fnln, ffln) 
     2178               endif 
     2179               fprn = fjln * fpnlim 
     2180 
     2181               !!---------------------------------------------------------------------- 
     2182               !! Primary production (diatoms) 
     2183               !! (note: still needs multiplying by phytoplankton concentration) 
     2184               !! 
     2185               !! production here is split between nitrogen production and that of 
     2186               !! silicon; depending upon the "intracellular" ratio of Si:N, model 
     2187               !! diatoms will uptake nitrogen/silicon differentially; this borrows 
     2188               !! from the diatom model of Mongin et al. (2006) 
     2189               !!---------------------------------------------------------------------- 
     2190               !! 
     2191               if (jliebig .eq. 0) then 
     2192                  !! multiplicative nutrient limitation 
     2193                  fpdlim = fnld * ffld 
     2194               elseif (jliebig .eq. 1) then 
     2195                  !! Liebig Law (= most limiting) nutrient limitation 
     2196                  fpdlim = min(fnld, ffld) 
     2197               endif 
     2198               !! 
     2199          if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then 
     2200                  !! "intracellular" elemental ratios 
     2201                  ! fsin  = zpds / (zphd + tiny(zphd)) 
     2202                  ! fnsi  = zphd / (zpds + tiny(zpds)) 
     2203                  fsin = 0.0 
     2204                  IF( zphd .GT. rsmall) fsin  = zpds / zphd 
     2205                  fnsi = 0.0 
     2206                  IF( zpds .GT. rsmall) fnsi  = zphd / zpds 
     2207                  !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) 
     2208                  fsin1 = 3.0 * xsin0 !! = 0.6 
     2209                  fnsi1 = 1.0 / fsin1 !! = 1.667 
     2210                  fnsi2 = 1.0 / xsin0 !! = 5.0 
     2211                  !! 
     2212                  !! conditionalities based on ratios 
     2213                  !! nitrogen (and iron and carbon) 
     2214                  if (fsin.le.xsin0) then 
     2215                     fprd  = 0.0 
     2216                     fsld2 = 0.0 
     2217                  elseif (fsin.lt.fsin1) then 
     2218                     fprd  = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) 
     2219                     fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) 
     2220                  elseif (fsin.ge.fsin1) then 
     2221                     fprd  = (fjld * fpdlim) 
     2222                     fsld2 = 1.0 
     2223                  endif 
     2224                  !! 
     2225                  !! silicon 
     2226                  if (fsin.lt.fnsi1) then 
     2227                     fprds = (fjld * fsld) 
     2228                  elseif (fsin.lt.fnsi2) then 
     2229                     fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) 
     2230                  else 
     2231                     fprds = 0.0 
     2232                  endif      
     2233               else 
     2234                  fsin  = 0.0 
     2235                  fnsi  = 0.0 
     2236                  fprd  = 0.0 
     2237                  fsld2 = 0.0 
     2238                  fprds = 0.0 
     2239               endif 
     2240 
     2241# if defined key_debug_medusa 
     2242               !! report phytoplankton growth (including diatom silicon submodel) 
     2243               if (idf.eq.1.AND.idfval.eq.1) then 
     2244                  IF (lwp) write (numout,*) '------------------------------' 
     2245                  IF (lwp) write (numout,*) 'fsin(',jk,')   = ', fsin 
     2246                  IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi 
     2247                  IF (lwp) write (numout,*) 'fsld2(',jk,')  = ', fsld2 
     2248                  IF (lwp) write (numout,*) 'fprn(',jk,')   = ', fprn 
     2249                  IF (lwp) write (numout,*) 'fprd(',jk,')   = ', fprd 
     2250                  IF (lwp) write (numout,*) 'fprds(',jk,')  = ', fprds 
     2251               endif 
     2252# endif 
     2253 
     2254               !!---------------------------------------------------------------------- 
     2255               !! Mixed layer primary production 
     2256               !! this block calculates the amount of primary production that occurs 
     2257               !! within the upper mixed layer; this allows the separate diagnosis 
     2258               !! of "sub-surface" primary production; it does assume that short- 
     2259               !! term variability in mixed layer depth doesn't mess with things 
     2260               !! though 
     2261               !!---------------------------------------------------------------------- 
     2262               !! 
     2263               if (fdep1.le.hmld(ji,jj)) then 
     2264                  !! this level is entirely in the mixed layer 
     2265                  fq0 = 1.0 
     2266               elseif (fdep.ge.hmld(ji,jj)) then 
     2267                  !! this level is entirely below the mixed layer 
     2268                  fq0 = 0.0 
     2269               else 
     2270                  !! this level straddles the mixed layer 
     2271                  fq0 = (hmld(ji,jj) - fdep) / fthk 
     2272               endif 
     2273               !! 
     2274               fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) 
     2275               fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) 
     2276                
     2277               !!---------------------------------------------------------------------- 
     2278               !! Vertical Integral -- 
     2279               !!---------------------------------------------------------------------- 
     2280               ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)   !! vertical integral non-diatom phytoplankton 
     2281               ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)   !! vertical integral diatom phytoplankton 
     2282               ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)   !! vertical integral microzooplankton 
     2283               ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)   !! vertical integral mesozooplankton 
     2284               ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)   !! vertical integral slow detritus, nitrogen 
     2285               ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)   !! vertical integral slow detritus, carbon 
     2286                
     2287               !!---------------------------------------------------------------------- 
     2288               !! More chlorophyll calculations 
     2289               !!---------------------------------------------------------------------- 
     2290               !! 
     2291               !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) 
     2292               !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) 
     2293               frn = (xthetam * fchn * fnln * ffln       ) / (fthetan + tiny(fthetan)) 
     2294               !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid  
     2295               !!   limitation, is used in the following line to regulate chlorophyll  
     2296               !!   growth in a manner that is inconsistent with its use in the regulation  
     2297               !!   of biomass growth; the Mongin term term used in growth is more complex 
     2298               !!   than the simple multiplicative function used below 
     2299               !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) 
     2300               !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to 
     2301               !!   regulate chlorophyll growth 
     2302               frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) 
     2303 
     2304# if defined key_debug_medusa 
     2305               !! report chlorophyll calculations 
     2306               if (idf.eq.1.AND.idfval.eq.1) then 
     2307                  IF (lwp) write (numout,*) '------------------------------' 
     2308                  IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan 
     2309                  IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad 
     2310                  IF (lwp) write (numout,*) 'frn(',jk,')     = ', frn 
     2311                  IF (lwp) write (numout,*) 'frd(',jk,')     = ', frd 
     2312               endif 
     2313# endif 
     2314 
     2315               !!---------------------------------------------------------------------- 
     2316               !! Zooplankton Grazing  
     2317               !! this code supplements the base grazing model with one that 
     2318               !! considers the C:N ratio of grazed food and balances this against 
     2319               !! the requirements of zooplankton growth; this model is derived  
     2320               !! from that of Anderson & Pondaven (2003) 
     2321               !! 
     2322               !! the current version of the code assumes a fixed C:N ratio for 
     2323               !! detritus (in contrast to Anderson & Pondaven, 2003), though the 
     2324               !! full equations are retained for future extension 
     2325               !!---------------------------------------------------------------------- 
     2326               !! 
     2327               !!---------------------------------------------------------------------- 
     2328               !! Microzooplankton first 
     2329               !!---------------------------------------------------------------------- 
     2330               !! 
     2331               fmi1    = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) 
     2332               fmi     = xgmi * zzmi / fmi1 
     2333               fgmipn  = fmi * xpmipn * zphn * zphn   !! grazing on non-diatoms 
     2334               fgmid   = fmi * xpmid  * zdet * zdet   !! grazing on detrital nitrogen 
    21822335# if defined key_roam 
    2183                 fgmidc  = rsmall !acc 
    2184                 IF ( zdet .GT. rsmall ) fgmidc  = (zdtc / (zdet + tiny(zdet))) * fgmid  !! grazing on detrital carbon 
     2336               fgmidc  = rsmall !acc 
     2337               IF ( zdet .GT. rsmall ) fgmidc  = (zdtc / (zdet + tiny(zdet))) * fgmid  !! grazing on detrital carbon 
    21852338# else 
    2186                 !! AXY (26/11/08): implicit detrital carbon change 
    2187                 fgmidc  = xthetad * fgmid              !! grazing on detrital carbon 
    2188 # endif 
    2189                 !! 
    2190                 !! which translates to these incoming N and C fluxes 
    2191                 finmi   = (1.0 - xphi) * (fgmipn + fgmid) 
    2192                 ficmi   = (1.0 - xphi) * ((xthetapn * fgmipn) + fgmidc) 
    2193                 !! 
    2194                 !! the ideal food C:N ratio for microzooplankton 
    2195                 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    2196                 fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 
    2197                 !! 
    2198                 !! process these to determine proportioning of grazed N and C 
    2199                 !! (since there is no explicit consideration of respiration, 
    2200                 !! only growth and excretion are calculated here) 
    2201                 fmith   = (ficmi / (finmi + tiny(finmi))) 
    2202                 if (fmith.ge.fstarmi) then 
    2203                    fmigrow = xbetan * finmi 
    2204                    fmiexcr = 0.0 
    2205                 else 
    2206                    fmigrow = (xbetac * xkc * ficmi) / xthetazmi 
    2207                    fmiexcr = ficmi * ((xbetan / (fmith + tiny(fmith))) - ((xbetac * xkc) / xthetazmi)) 
    2208                 endif 
     2339               !! AXY (26/11/08): implicit detrital carbon change 
     2340               fgmidc  = xthetad * fgmid              !! grazing on detrital carbon 
     2341# endif 
     2342               !! 
     2343               !! which translates to these incoming N and C fluxes 
     2344               finmi   = (1.0 - xphi) * (fgmipn + fgmid) 
     2345               ficmi   = (1.0 - xphi) * ((xthetapn * fgmipn) + fgmidc) 
     2346               !! 
     2347               !! the ideal food C:N ratio for microzooplankton 
     2348               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
     2349               fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 
     2350               !! 
     2351               !! process these to determine proportioning of grazed N and C 
     2352               !! (since there is no explicit consideration of respiration, 
     2353               !! only growth and excretion are calculated here) 
     2354               fmith   = (ficmi / (finmi + tiny(finmi))) 
     2355               if (fmith.ge.fstarmi) then 
     2356                  fmigrow = xbetan * finmi 
     2357                  fmiexcr = 0.0 
     2358               else 
     2359                  fmigrow = (xbetac * xkc * ficmi) / xthetazmi 
     2360                  fmiexcr = ficmi * ((xbetan / (fmith + tiny(fmith))) - ((xbetac * xkc) / xthetazmi)) 
     2361               endif 
    22092362# if defined key_roam 
    2210                 fmiresp = (xbetac * ficmi) - (xthetazmi * fmigrow) 
    2211 # endif 
    2212  
    2213                 !!---------------------------------------------------------------------- 
    2214                 !! Mesozooplankton second 
    2215                 !!---------------------------------------------------------------------- 
    2216                 !! 
    2217                 fme1    = (xkme * xkme) + (xpmepn * zphn * zphn) + (xpmepd * zphd * zphd) + &  
    2218                      (xpmezmi * zzmi * zzmi) + (xpmed * zdet * zdet) 
    2219                 fme     = xgme * zzme / fme1 
    2220                 fgmepn  = fme * xpmepn  * zphn * zphn  !! grazing on non-diatoms 
    2221                 fgmepd  = fme * xpmepd  * zphd * zphd  !! grazing on diatoms 
    2222                 fgmepds = fsin * fgmepd                !! grazing on diatom silicon 
    2223                 fgmezmi = fme * xpmezmi * zzmi * zzmi  !! grazing on microzooplankton 
    2224                 fgmed   = fme * xpmed   * zdet * zdet  !! grazing on detrital nitrogen 
     2363               fmiresp = (xbetac * ficmi) - (xthetazmi * fmigrow) 
     2364# endif 
     2365 
     2366# if defined key_debug_medusa 
     2367               !! report microzooplankton grazing 
     2368               if (idf.eq.1.AND.idfval.eq.1) then 
     2369                  IF (lwp) write (numout,*) '------------------------------' 
     2370                  IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1 
     2371                  IF (lwp) write (numout,*) 'fmi(',jk,')     = ', fmi 
     2372                  IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn 
     2373                  IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid 
     2374                  IF (lwp) write (numout,*) 'fgmidc(',jk,')  = ', fgmidc 
     2375                  IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi 
     2376                  IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi 
     2377                  IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi 
     2378                  IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith 
     2379                  IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow 
     2380                  IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr 
     2381#  if defined key_roam 
     2382                  IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp 
     2383#  endif 
     2384               endif 
     2385# endif 
     2386 
     2387               !!---------------------------------------------------------------------- 
     2388               !! Mesozooplankton second 
     2389               !!---------------------------------------------------------------------- 
     2390               !! 
     2391               fme1    = (xkme * xkme) + (xpmepn * zphn * zphn) + (xpmepd * zphd * zphd) + &  
     2392                         (xpmezmi * zzmi * zzmi) + (xpmed * zdet * zdet) 
     2393               fme     = xgme * zzme / fme1 
     2394               fgmepn  = fme * xpmepn  * zphn * zphn  !! grazing on non-diatoms 
     2395               fgmepd  = fme * xpmepd  * zphd * zphd  !! grazing on diatoms 
     2396               fgmepds = fsin * fgmepd                !! grazing on diatom silicon 
     2397               fgmezmi = fme * xpmezmi * zzmi * zzmi  !! grazing on microzooplankton 
     2398               fgmed   = fme * xpmed   * zdet * zdet  !! grazing on detrital nitrogen 
    22252399# if defined key_roam 
    2226                 fgmedc  = rsmall !acc 
    2227                 IF ( zdet .GT. rsmall ) fgmedc  = (zdtc / (zdet + tiny(zdet))) * fgmed  !! grazing on detrital carbon 
     2400               fgmedc  = rsmall !acc 
     2401               IF ( zdet .GT. rsmall ) fgmedc  = (zdtc / (zdet + tiny(zdet))) * fgmed  !! grazing on detrital carbon 
    22282402# else 
    2229                 !! AXY (26/11/08): implicit detrital carbon change 
    2230                 fgmedc  = xthetad * fgmed              !! grazing on detrital carbon 
    2231 # endif 
    2232                 !! 
    2233                 !! which translates to these incoming N and C fluxes 
    2234                 finme   = (1.0 - xphi) * (fgmepn + fgmepd + fgmezmi + fgmed) 
    2235                 ficme   = (1.0 - xphi) * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 
    2236                      (xthetazmi * fgmezmi) + fgmedc) 
    2237                 !! 
    2238                 !! the ideal food C:N ratio for mesozooplankton 
    2239                 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    2240                 fstarme = (xbetan * xthetazme) / (xbetac * xkc) 
    2241                 !! 
    2242                 !! process these to determine proportioning of grazed N and C 
    2243                 !! (since there is no explicit consideration of respiration, 
    2244                 !! only growth and excretion are calculated here) 
    2245                 fmeth   = (ficme / (finme + tiny(finme))) 
    2246                 if (fmeth.ge.fstarme) then 
    2247                    fmegrow = xbetan * finme 
    2248                    fmeexcr = 0.0 
    2249                 else 
    2250                    fmegrow = (xbetac * xkc * ficme) / xthetazme 
    2251                    fmeexcr = ficme * ((xbetan / (fmeth + tiny(fmeth))) - ((xbetac * xkc) / xthetazme)) 
    2252                 endif 
     2403               !! AXY (26/11/08): implicit detrital carbon change 
     2404               fgmedc  = xthetad * fgmed              !! grazing on detrital carbon 
     2405# endif 
     2406               !! 
     2407               !! which translates to these incoming N and C fluxes 
     2408               finme   = (1.0 - xphi) * (fgmepn + fgmepd + fgmezmi + fgmed) 
     2409               ficme   = (1.0 - xphi) * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 
     2410                        (xthetazmi * fgmezmi) + fgmedc) 
     2411               !! 
     2412               !! the ideal food C:N ratio for mesozooplankton 
     2413               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
     2414               fstarme = (xbetan * xthetazme) / (xbetac * xkc) 
     2415               !! 
     2416               !! process these to determine proportioning of grazed N and C 
     2417               !! (since there is no explicit consideration of respiration, 
     2418               !! only growth and excretion are calculated here) 
     2419               fmeth   = (ficme / (finme + tiny(finme))) 
     2420               if (fmeth.ge.fstarme) then 
     2421                  fmegrow = xbetan * finme 
     2422                  fmeexcr = 0.0 
     2423               else 
     2424                  fmegrow = (xbetac * xkc * ficme) / xthetazme 
     2425                  fmeexcr = ficme * ((xbetan / (fmeth + tiny(fmeth))) - ((xbetac * xkc) / xthetazme)) 
     2426               endif 
    22532427# if defined key_roam 
    2254                 fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) 
    2255 # endif 
    2256  
    2257                 fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fthk * (  & 
    2258                      fgmipn + fgmid ) 
    2259                 fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fthk * (  & 
    2260                      fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) 
    2261                 fzme_i(ji,jj)  = fzme_i(ji,jj)  + fthk * (  & 
    2262                      fgmepn + fgmepd + fgmezmi + fgmed ) 
    2263                 fzme_o(ji,jj)  = fzme_o(ji,jj)  + fthk * (  & 
    2264                      fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) 
    2265  
    2266                 !!====================================================================== 
    2267                 !! AXY (07/04/17): possible subroutine block; miscellaneous plankton losses 
    2268                 !!====================================================================== 
    2269  
    2270                 !!---------------------------------------------------------------------- 
    2271                 !! Plankton metabolic losses 
    2272                 !! Linear loss processes assumed to be metabolic in origin 
    2273                 !!---------------------------------------------------------------------- 
    2274                 !! 
    2275                 fdpn2  = xmetapn  * zphn 
    2276                 fdpd2  = xmetapd  * zphd 
    2277                 fdpds2 = xmetapd  * zpds 
    2278                 fdzmi2 = xmetazmi * zzmi 
    2279                 fdzme2 = xmetazme * zzme 
    2280  
    2281                 !!---------------------------------------------------------------------- 
    2282                 !! Plankton mortality losses 
    2283                 !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced  
    2284                 !! to improve performance in gyres 
    2285                 !!---------------------------------------------------------------------- 
    2286                 !! 
    2287                 !! non-diatom phytoplankton 
    2288                 if (jmpn.eq.1) fdpn = xmpn * zphn               !! linear 
    2289                 if (jmpn.eq.2) fdpn = xmpn * zphn * zphn        !! quadratic 
    2290                 if (jmpn.eq.3) fdpn = xmpn * zphn * &           !! hyperbolic 
    2291                      (zphn / (xkphn + zphn)) 
    2292                 if (jmpn.eq.4) fdpn = xmpn * zphn * &           !! sigmoid 
    2293                      ((zphn * zphn) / (xkphn + (zphn * zphn))) 
    2294                 !! 
    2295                 !! diatom phytoplankton 
    2296                 if (jmpd.eq.1) fdpd = xmpd * zphd               !! linear 
    2297                 if (jmpd.eq.2) fdpd = xmpd * zphd * zphd        !! quadratic 
    2298                 if (jmpd.eq.3) fdpd = xmpd * zphd * &           !! hyperbolic 
    2299                      (zphd / (xkphd + zphd)) 
    2300                 if (jmpd.eq.4) fdpd = xmpd * zphd * &           !! sigmoid 
    2301                      ((zphd * zphd) / (xkphd + (zphd * zphd))) 
    2302                 fdpds = fdpd * fsin 
    2303                 !! 
    2304                 !! microzooplankton 
    2305                 if (jmzmi.eq.1) fdzmi = xmzmi * zzmi            !! linear 
    2306                 if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi     !! quadratic 
    2307                 if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * &        !! hyperbolic 
    2308                      (zzmi / (xkzmi + zzmi)) 
    2309                 if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * &        !! sigmoid 
    2310                      ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) 
    2311                 !! 
    2312                 !! mesozooplankton 
    2313                 if (jmzme.eq.1) fdzme = xmzme * zzme            !! linear 
    2314                 if (jmzme.eq.2) fdzme = xmzme * zzme * zzme     !! quadratic 
    2315                 if (jmzme.eq.3) fdzme = xmzme * zzme * &        !! hyperbolic 
    2316                      (zzme / (xkzme + zzme)) 
    2317                 if (jmzme.eq.4) fdzme = xmzme * zzme * &        !! sigmoid 
    2318                      ((zzme * zzme) / (xkzme + (zzme * zzme))) 
    2319  
    2320                 !!====================================================================== 
    2321                 !! AXY (07/04/17): possible subroutine block; detritus processes (fuse with later?) 
    2322                 !!====================================================================== 
    2323  
    2324                 !!---------------------------------------------------------------------- 
    2325                 !! Detritus remineralisation 
    2326                 !! Constant or temperature-dependent 
    2327                 !!---------------------------------------------------------------------- 
    2328                 !! 
    2329                 if (jmd.eq.1) then 
    2330                    !! temperature-dependent 
    2331                    fdd  = xmd  * fun_T * zdet 
     2428               fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) 
     2429# endif 
     2430 
     2431# if defined key_debug_medusa 
     2432               !! report mesozooplankton grazing 
     2433               if (idf.eq.1.AND.idfval.eq.1) then 
     2434                  IF (lwp) write (numout,*) '------------------------------' 
     2435                  IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1 
     2436                  IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme 
     2437                  IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn 
     2438                  IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd 
     2439                  IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds 
     2440                  IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi 
     2441                  IF (lwp) write (numout,*) 'fgmed(',jk,')   = ', fgmed 
     2442                  IF (lwp) write (numout,*) 'fgmedc(',jk,')  = ', fgmedc 
     2443                  IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme 
     2444                  IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme 
     2445                  IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme 
     2446                  IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth 
     2447                  IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow 
     2448                  IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr 
     2449#  if defined key_roam 
     2450                  IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp 
     2451#  endif 
     2452               endif 
     2453# endif 
     2454 
     2455               fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fthk * (  & 
     2456                  fgmipn + fgmid ) 
     2457               fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fthk * (  & 
     2458                  fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) 
     2459               fzme_i(ji,jj)  = fzme_i(ji,jj)  + fthk * (  & 
     2460                  fgmepn + fgmepd + fgmezmi + fgmed ) 
     2461               fzme_o(ji,jj)  = fzme_o(ji,jj)  + fthk * (  & 
     2462                  fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) 
     2463 
     2464               !!---------------------------------------------------------------------- 
     2465               !! Plankton metabolic losses 
     2466               !! Linear loss processes assumed to be metabolic in origin 
     2467               !!---------------------------------------------------------------------- 
     2468               !! 
     2469               fdpn2  = xmetapn  * zphn 
     2470               fdpd2  = xmetapd  * zphd 
     2471               fdpds2 = xmetapd  * zpds 
     2472               fdzmi2 = xmetazmi * zzmi 
     2473               fdzme2 = xmetazme * zzme 
     2474 
     2475               !!---------------------------------------------------------------------- 
     2476               !! Plankton mortality losses 
     2477               !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced  
     2478               !! to improve performance in gyres 
     2479               !!---------------------------------------------------------------------- 
     2480               !! 
     2481               !! non-diatom phytoplankton 
     2482               if (jmpn.eq.1) fdpn = xmpn * zphn               !! linear 
     2483               if (jmpn.eq.2) fdpn = xmpn * zphn * zphn        !! quadratic 
     2484               if (jmpn.eq.3) fdpn = xmpn * zphn * &           !! hyperbolic 
     2485                  (zphn / (xkphn + zphn)) 
     2486               if (jmpn.eq.4) fdpn = xmpn * zphn * &           !! sigmoid 
     2487                  ((zphn * zphn) / (xkphn + (zphn * zphn))) 
     2488               !! 
     2489               !! diatom phytoplankton 
     2490               if (jmpd.eq.1) fdpd = xmpd * zphd               !! linear 
     2491               if (jmpd.eq.2) fdpd = xmpd * zphd * zphd        !! quadratic 
     2492               if (jmpd.eq.3) fdpd = xmpd * zphd * &           !! hyperbolic 
     2493                  (zphd / (xkphd + zphd)) 
     2494               if (jmpd.eq.4) fdpd = xmpd * zphd * &           !! sigmoid 
     2495                  ((zphd * zphd) / (xkphd + (zphd * zphd))) 
     2496               fdpds = fdpd * fsin 
     2497               !! 
     2498               !! microzooplankton 
     2499               if (jmzmi.eq.1) fdzmi = xmzmi * zzmi            !! linear 
     2500               if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi     !! quadratic 
     2501               if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * &        !! hyperbolic 
     2502                  (zzmi / (xkzmi + zzmi)) 
     2503               if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * &        !! sigmoid 
     2504                  ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) 
     2505               !! 
     2506               !! mesozooplankton 
     2507               if (jmzme.eq.1) fdzme = xmzme * zzme            !! linear 
     2508               if (jmzme.eq.2) fdzme = xmzme * zzme * zzme     !! quadratic 
     2509               if (jmzme.eq.3) fdzme = xmzme * zzme * &        !! hyperbolic 
     2510                  (zzme / (xkzme + zzme)) 
     2511               if (jmzme.eq.4) fdzme = xmzme * zzme * &        !! sigmoid 
     2512                  ((zzme * zzme) / (xkzme + (zzme * zzme))) 
     2513 
     2514               !!---------------------------------------------------------------------- 
     2515               !! Detritus remineralisation 
     2516               !! Constant or temperature-dependent 
     2517               !!---------------------------------------------------------------------- 
     2518               !! 
     2519               if (jmd.eq.1) then 
     2520                  !! temperature-dependent 
     2521                  fdd  = xmd  * fun_T * zdet 
    23322522# if defined key_roam 
    2333                    fddc = xmdc * fun_T * zdtc 
    2334 # endif 
    2335                 elseif (jmd.eq.2) then 
    2336                    !! AXY (16/05/13): add in Q10-based parameterisation (def in nmlst) 
    2337                    !! temperature-dependent 
    2338                    fdd  = xmd  * fun_Q10 * zdet 
     2523                  fddc = xmdc * fun_T * zdtc 
     2524# endif 
     2525               elseif (jmd.eq.2) then 
     2526                  !! AXY (16/05/13): add in Q10-based parameterisation (def in nmlst) 
     2527                  !! temperature-dependent 
     2528                  fdd  = xmd  * fun_Q10 * zdet 
    23392529#if defined key_roam 
    2340                    fddc = xmdc * fun_Q10 * zdtc 
     2530                  fddc = xmdc * fun_Q10 * zdtc 
    23412531#endif 
    2342                 else 
    2343                    !! temperature-independent 
    2344                    fdd  = xmd  * zdet 
     2532               else 
     2533                  !! temperature-independent 
     2534                  fdd  = xmd  * zdet 
    23452535# if defined key_roam 
    2346                    fddc = xmdc * zdtc 
    2347 # endif 
    2348                 endif 
    2349                 !! 
    2350                 !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box 
    2351                 if ((jk.eq.jmbathy) .and. jsfd.eq.1) then 
    2352                    fdd  = 1.0  * zdet 
     2536                  fddc = xmdc * zdtc 
     2537# endif 
     2538               endif 
     2539               !! 
     2540               !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box 
     2541               if ((jk.eq.jmbathy) .and. jsfd.eq.1) then 
     2542                  fdd  = 1.0  * zdet 
    23532543# if defined key_roam 
    2354                    fddc = 1.0  * zdtc 
    2355 # endif 
    2356                 endif 
    2357  
    2358                 !!---------------------------------------------------------------------- 
    2359                 !! Detritus addition to benthos 
    2360                 !! If activated, slow detritus in the bottom box will enter the 
    2361                 !! benthic pool 
    2362                 !!---------------------------------------------------------------------- 
    2363                 !! 
    2364                 if ((jk.eq.jmbathy) .and. jorgben.eq.1) then 
    2365                    !! this is the BOTTOM OCEAN BOX -> into the benthic pool! 
    2366                    !! 
    2367                    f_sbenin_n(ji,jj)  = (zdet * vsed * 86400.) 
    2368                    f_sbenin_fe(ji,jj) = (zdet * vsed * 86400. * xrfn) 
     2544                  fddc = 1.0  * zdtc 
     2545# endif 
     2546               endif 
     2547                
     2548# if defined key_debug_medusa 
     2549               !! report plankton mortality and remineralisation 
     2550               if (idf.eq.1.AND.idfval.eq.1) then 
     2551                  IF (lwp) write (numout,*) '------------------------------' 
     2552                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2 
     2553                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2 
     2554                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2 
     2555                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2 
     2556                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2 
     2557                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn 
     2558                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd 
     2559                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds 
     2560                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi 
     2561                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme 
     2562                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd 
     2563#  if defined key_roam 
     2564                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc 
     2565#  endif 
     2566               endif 
     2567# endif 
     2568 
     2569               !!---------------------------------------------------------------------- 
     2570               !! Detritus addition to benthos 
     2571               !! If activated, slow detritus in the bottom box will enter the 
     2572               !! benthic pool 
     2573               !!---------------------------------------------------------------------- 
     2574               !! 
     2575               if ((jk.eq.jmbathy) .and. jorgben.eq.1) then 
     2576                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool! 
     2577                  !! 
     2578                  f_sbenin_n(ji,jj)  = (zdet * vsed * 86400.) 
     2579                  f_sbenin_fe(ji,jj) = (zdet * vsed * 86400. * xrfn) 
    23692580# if defined key_roam 
    2370                    f_sbenin_c(ji,jj)  = (zdtc * vsed * 86400.) 
     2581                  f_sbenin_c(ji,jj)  = (zdtc * vsed * 86400.) 
    23712582# else 
    2372                    f_sbenin_c(ji,jj)  = (zdet * vsed * 86400. * xthetad) 
    2373 # endif 
    2374                 endif 
    2375  
    2376                 !!====================================================================== 
    2377                 !! AXY (07/04/17): possible subroutine block; iron chemistry and scavenging 
    2378                 !!====================================================================== 
    2379  
    2380                 !!---------------------------------------------------------------------- 
    2381                 !! Iron chemistry and fractionation 
    2382                 !! following the Parekh et al. (2004) scheme adopted by the Met. 
    2383                 !! Office, Medusa models total iron but considers "free" and 
    2384                 !! ligand-bound forms for the purposes of scavenging (only "free" 
    2385                 !! iron can be scavenged 
    2386                 !!---------------------------------------------------------------------- 
    2387                 !! 
    2388                 !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
    2389                 xFeT        = zfer * 1.e3 
    2390                 !! 
    2391                 !! calculate fractionation (based on Diat-HadOCC; in turn based on Parekh et al., 2004) 
    2392                 xb_coef_tmp = xk_FeL * (xLgT - xFeT) - 1.0 
    2393                 xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) + (4.0 * xk_FeL * xLgT)), 0.0) 
    2394                 !! 
    2395                 !! "free" ligand concentration 
    2396                 xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL 
    2397                 !! 
    2398                 !! ligand-bound iron concentration 
    2399                 xFeL        = xLgT - xLgF 
    2400                 !! 
    2401                 !! "free" iron concentration (and convert to mmol Fe / m3) 
    2402                 xFeF        = (xFeT - xFeL) * 1.e-3 
    2403                 xFree(ji,jj)= xFeF / (zfer + tiny(zfer)) 
    2404                 !! 
    2405                 !! scavenging of iron 
    2406                 !! AXY (05/04/17): formerly several schemes, now the only appropriate 
    2407                 !! one, with all other options returning no scavenging (trc_nam_medusa 
    2408                 !! reports on this) 
    2409                 !! 
    2410                 if (jiron.eq.1) then 
    2411                    !!---------------------------------------------------------------------- 
    2412                    !! Scheme 1: Dutkiewicz et al. (2005) 
    2413                    !! This scheme includes a single scavenging term based solely on a 
    2414                    !! fixed rate and the availablility of "free" iron 
    2415                    !!---------------------------------------------------------------------- 
    2416                    !! 
    2417                    ffescav     = xk_sc_Fe * xFeF                     ! = mmol/m3/d 
    2418                    !! 
    2419                    !!---------------------------------------------------------------------- 
    2420                    !! 
    2421                    !! Mick's code contains a further (optional) implicit "scavenging" of  
    2422                    !! iron that sets an upper bound on "free" iron concentration, and  
    2423                    !! essentially caps the concentration of total iron as xFeL + "free"  
    2424                    !! iron; since the former is constrained by a fixed total ligand  
    2425                    !! concentration (= 1.0 umol/m3), and the latter isn't allowed above  
    2426                    !! this upper bound, total iron is constrained to a maximum of ... 
    2427                    !! 
    2428                    !!    xFeL + min(xFeF, 0.3 umol/m3) = 1.0 + 0.3 = 1.3 umol / m3 
    2429                    !!  
    2430                    !! In Mick's code, the actual value of total iron is reset to this 
    2431                    !! sum (i.e. TFe = FeL + Fe'; but Fe' <= 0.3 umol/m3); this isn't 
    2432                    !! our favoured approach to tracer updating here (not least because 
    2433                    !! of the leapfrog), so here the amount scavenged is augmented by an 
    2434                    !! additional amount that serves to drag total iron back towards that 
    2435                    !! expected from this limitation on iron concentration ... 
    2436                    !! 
    2437                    xmaxFeF     = min((xFeF * 1.e3), 0.3)             ! = umol/m3 
    2438                    !! 
    2439                    !! Here, the difference between current total Fe and (FeL + Fe') is 
    2440                    !! calculated and added to the scavenging flux already calculated 
    2441                    !! above ... 
    2442                    !! 
    2443                    fdeltaFe    = (xFeT - (xFeL + xmaxFeF)) * 1.e-3   ! = mmol/m3 
    2444                    !! 
    2445                    !! This assumes that the "excess" iron is dissipated with a time- 
    2446                    !! scale of 1 day; seems reasonable to me ... (famous last words) 
    2447                    !! 
    2448                    ffescav     = ffescav + fdeltaFe                  ! = mmol/m3/d 
    2449                    !! 
     2583                  f_sbenin_c(ji,jj)  = (zdet * vsed * 86400. * xthetad) 
     2584# endif 
     2585               endif 
     2586 
     2587               !!---------------------------------------------------------------------- 
     2588               !! Iron chemistry and fractionation 
     2589               !! following the Parekh et al. (2004) scheme adopted by the Met. 
     2590               !! Office, Medusa models total iron but considers "free" and 
     2591               !! ligand-bound forms for the purposes of scavenging (only "free" 
     2592               !! iron can be scavenged 
     2593               !!---------------------------------------------------------------------- 
     2594               !! 
     2595               !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
     2596               xFeT        = zfer * 1.e3 
     2597               !! 
     2598               !! calculate fractionation (based on Diat-HadOCC; in turn based on Parekh et al., 2004) 
     2599               xb_coef_tmp = xk_FeL * (xLgT - xFeT) - 1.0 
     2600               xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) + (4.0 * xk_FeL * xLgT)), 0.0) 
     2601               !! 
     2602               !! "free" ligand concentration 
     2603               xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL 
     2604               !! 
     2605               !! ligand-bound iron concentration 
     2606               xFeL        = xLgT - xLgF 
     2607               !! 
     2608               !! "free" iron concentration (and convert to mmol Fe / m3) 
     2609               xFeF        = (xFeT - xFeL) * 1.e-3 
     2610               xFree(ji,jj)= xFeF / (zfer + tiny(zfer)) 
     2611               !! 
     2612               !! scavenging of iron (multiple schemes); I'm only really happy with the  
     2613               !! first one at the moment - the others involve assumptions (sometimes 
     2614               !! guessed at by me) that are potentially questionable 
     2615               !! 
     2616               if (jiron.eq.1) then 
     2617                  !!---------------------------------------------------------------------- 
     2618                  !! Scheme 1: Dutkiewicz et al. (2005) 
     2619                  !! This scheme includes a single scavenging term based solely on a 
     2620                  !! fixed rate and the availablility of "free" iron 
     2621                  !!---------------------------------------------------------------------- 
     2622                  !! 
     2623                  ffescav     = xk_sc_Fe * xFeF                     ! = mmol/m3/d 
     2624                  !! 
     2625                  !!---------------------------------------------------------------------- 
     2626                  !! 
     2627                  !! Mick's code contains a further (optional) implicit "scavenging" of  
     2628                  !! iron that sets an upper bound on "free" iron concentration, and  
     2629                  !! essentially caps the concentration of total iron as xFeL + "free"  
     2630                  !! iron; since the former is constrained by a fixed total ligand  
     2631                  !! concentration (= 1.0 umol/m3), and the latter isn't allowed above  
     2632                  !! this upper bound, total iron is constrained to a maximum of ... 
     2633                  !! 
     2634                  !!    xFeL + min(xFeF, 0.3 umol/m3) = 1.0 + 0.3 = 1.3 umol / m3 
     2635                  !!  
     2636                  !! In Mick's code, the actual value of total iron is reset to this 
     2637                  !! sum (i.e. TFe = FeL + Fe'; but Fe' <= 0.3 umol/m3); this isn't 
     2638                  !! our favoured approach to tracer updating here (not least because 
     2639                  !! of the leapfrog), so here the amount scavenged is augmented by an 
     2640                  !! additional amount that serves to drag total iron back towards that 
     2641                  !! expected from this limitation on iron concentration ... 
     2642                  !! 
     2643                  xmaxFeF     = min((xFeF * 1.e3), 0.3)             ! = umol/m3 
     2644                  !! 
     2645                  !! Here, the difference between current total Fe and (FeL + Fe') is 
     2646                  !! calculated and added to the scavenging flux already calculated 
     2647                  !! above ... 
     2648                  !! 
     2649                  fdeltaFe    = (xFeT - (xFeL + xmaxFeF)) * 1.e-3   ! = mmol/m3 
     2650                  !! 
     2651                  !! This assumes that the "excess" iron is dissipated with a time- 
     2652                  !! scale of 1 day; seems reasonable to me ... (famous last words) 
     2653                  !! 
     2654                  ffescav     = ffescav + fdeltaFe                  ! = mmol/m3/d 
     2655                  !! 
    24502656# if defined key_deep_fe_fix 
    2451                    !! AXY (17/01/13) 
    2452                    !! stop scavenging for iron concentrations below 0.5 umol / m3 
    2453                    !! at depths greater than 1000 m; this aims to end MEDUSA's 
    2454                    !! continual loss of iron at depth without impacting things 
    2455                    !! at the surface too much; the justification for this is that 
    2456                    !! it appears to be what Mick Follows et al. do in their work 
    2457                    !! (as evidenced by the iron initial condition they supplied 
    2458                    !! me with); to be honest, it looks like Follow et al. do this 
    2459                    !! at shallower depths than 1000 m, but I'll stick with this 
    2460                    !! for now; I suspect that this seemingly arbitrary approach 
    2461                    !! effectively "parameterises" the particle-based scavenging 
    2462                    !! rates that other models use (i.e. at depth there are no 
    2463                    !! sinking particles, so scavenging stops); it might be fun 
    2464                    !! justifying this in a paper though! 
    2465                    !! 
    2466                    if ((fdep.gt.1000.) .and. (xFeT.lt.0.5)) then 
    2467                       ffescav = 0. 
    2468                    endif 
    2469 # endif 
    2470                 else 
    2471                    !!---------------------------------------------------------------------- 
    2472                    !! No Scheme: you coward! 
    2473                    !! This scheme puts its head in the sand and eskews any decision about 
    2474                    !! how iron is removed from the ocean; prepare to get deluged in iron 
    2475                    !! you fool! 
    2476                    !!---------------------------------------------------------------------- 
    2477                    ffescav     = 0. 
    2478                 endif 
    2479  
    2480                 !!---------------------------------------------------------------------- 
    2481                 !! Other iron cycle processes 
    2482                 !!---------------------------------------------------------------------- 
    2483                 !! 
    2484                 !! aeolian iron deposition 
    2485                 if (jk.eq.1) then 
    2486                    !! zirondep   is in mmol-Fe / m2 / day 
    2487                    !! ffetop     is in mmol-dissolved-Fe / m3 / day 
    2488                    ffetop  = zirondep(ji,jj) * xfe_sol / fthk  
    2489                 else 
    2490                    ffetop  = 0.0 
    2491                 endif 
    2492                 !! 
    2493                 !! seafloor iron addition 
    2494                 !! AXY (10/07/12): amended to only apply sedimentary flux up to ~500 m down 
    2495                 !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then 
    2496                 if ((jk.eq.jmbathy).AND.jk.le.i0500) then 
    2497                    !! Moore et al. (2004) cite a coastal California value of 5 umol/m2/d, but adopt a 
    2498                    !! global value of 2 umol/m2/d for all areas < 1100 m; here we use this latter value 
    2499                    !! but apply it everywhere 
    2500                    !! AXY (21/07/09): actually, let's just apply it below 1100 m (levels 1-37) 
    2501                    ffebot  = (xfe_sed / fthk) 
    2502                 else 
    2503                    ffebot  = 0.0 
    2504                 endif 
    2505  
    2506                 !!====================================================================== 
    2507                 !! AXY (07/04/17): possible subroutine block; miscellaneous processes (fuse?) 
    2508                 !!====================================================================== 
    2509  
    2510                 !!---------------------------------------------------------------------- 
    2511                 !! Miscellaneous 
    2512                 !!---------------------------------------------------------------------- 
    2513                 !! 
    2514                 !! diatom frustule dissolution 
    2515                 fsdiss  = xsdiss * zpds 
    2516  
    2517                 !!---------------------------------------------------------------------- 
    2518                 !! Slow detritus creation 
    2519                 !!---------------------------------------------------------------------- 
    2520                 !! this variable integrates the creation of slow sinking detritus 
    2521                 !! to allow the split between fast and slow detritus to be  
    2522                 !! diagnosed 
    2523                 fslown  = fdpn + fdzmi + ((1.0 - xfdfrac1) * fdpd) + & 
    2524                      ((1.0 - xfdfrac2) * fdzme) + ((1.0 - xbetan) * (finmi + finme)) 
    2525                 !! 
    2526                 !! this variable records the slow detrital sinking flux at this 
    2527                 !! particular depth; it is used in the output of this flux at 
    2528                 !! standard depths in the diagnostic outputs; needs to be 
    2529                 !! adjusted from per second to per day because of parameter vsed 
    2530                 fslownflux(ji,jj) = zdet * vsed * 86400. 
     2657                  !! AXY (17/01/13) 
     2658                  !! stop scavenging for iron concentrations below 0.5 umol / m3 
     2659                  !! at depths greater than 1000 m; this aims to end MEDUSA's 
     2660                  !! continual loss of iron at depth without impacting things 
     2661                  !! at the surface too much; the justification for this is that 
     2662                  !! it appears to be what Mick Follows et al. do in their work 
     2663                  !! (as evidenced by the iron initial condition they supplied 
     2664                  !! me with); to be honest, it looks like Follow et al. do this 
     2665                  !! at shallower depths than 1000 m, but I'll stick with this 
     2666                  !! for now; I suspect that this seemingly arbitrary approach 
     2667                  !! effectively "parameterises" the particle-based scavenging 
     2668                  !! rates that other models use (i.e. at depth there are no 
     2669                  !! sinking particles, so scavenging stops); it might be fun 
     2670                  !! justifying this in a paper though! 
     2671                  !! 
     2672                  if ((fdep.gt.1000.) .and. (xFeT.lt.0.5)) then 
     2673                     ffescav = 0. 
     2674                  endif 
     2675# endif 
     2676                  !! 
     2677               elseif (jiron.eq.2) then 
     2678                  !!---------------------------------------------------------------------- 
     2679                  !! Scheme 2: Moore et al. (2004) 
     2680                  !! This scheme includes a single scavenging term that accounts for 
     2681                  !! both suspended and sinking particles in the water column; this 
     2682                  !! term scavenges total iron rather than "free" iron 
     2683                  !!---------------------------------------------------------------------- 
     2684                  !! 
     2685                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
     2686                  xFeT        = zfer * 1.e3 
     2687                  !! 
     2688                  !! this has a base scavenging rate (12% / y) which is modified by local 
     2689                  !! particle concentration and sinking flux (and dust - but I'm ignoring 
     2690                  !! that here for now) and which is accelerated when Fe concentration gets 
     2691                  !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as concentrations 
     2692                  !! below 0.4 nM (= 0.4 umol/m3 = 0.0004 mmol/m3) 
     2693                  !! 
     2694                  !! base scavenging rate (0.12 / y) 
     2695                  fbase_scav = 0.12 / 365.25 
     2696                  !! 
     2697                  !! calculate sinking particle part of scaling factor 
     2698                  !! this takes local fast sinking carbon (mmol C / m2 / d) and 
     2699                  !! gets it into nmol C / cm3 / s ("rdt" below is the number of seconds in 
     2700                  !! a model timestep) 
     2701                  !! 
     2702                  !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.) 
     2703                  !! 
     2704                  !! ... actually, re-reading Moore et al.'s equations, it looks like he uses 
     2705                  !! his sinking flux directly, without scaling it by time-step or anything, 
     2706                  !! so I'll copy this here ... 
     2707                  !! 
     2708                  fscal_sink = ffastc(ji,jj) * 1.e2 
     2709                  !! 
     2710                  !! calculate particle part of scaling factor 
     2711                  !! this totals up the carbon in suspended particles (Pn, Pd, Zmi, Zme, D), 
     2712                  !! which comes out in mmol C / m3 (= nmol C / cm3), and then multiplies it 
     2713                  !! by a magic factor, 0.002, to get it into nmol C / cm2 / s 
     2714                  !! 
     2715                  fscal_part = ((xthetapn * zphn) + (xthetapd * zphd) + (xthetazmi * zzmi) + & 
     2716                  (xthetazme * zzme) + (xthetad * zdet)) * 0.002 
     2717                  !! 
     2718                  !! calculate scaling factor for base scavenging rate 
     2719                  !! this uses the (now correctly scaled) sinking flux and standing 
     2720                  !! particle concentration, divides through by some sort of reference 
     2721                  !! value (= 0.0066 nmol C / cm2 / s) and then uses this, or not if its 
     2722                  !! too high, to rescale the base scavenging rate 
     2723                  !! 
     2724                  fscal_scav = fbase_scav * min(((fscal_sink + fscal_part) / 0.0066), 4.0) 
     2725                  !! 
     2726                  !! the resulting scavenging rate is then scaled further according to the 
     2727                  !! local iron concentration (i.e. diminished in low iron regions; enhanced 
     2728                  !! in high iron regions; less alone in intermediate iron regions) 
     2729                  !! 
     2730                  if (xFeT.lt.0.4) then 
     2731                     !! 
     2732                     !! low iron region 
     2733                     !! 
     2734                     fscal_scav = fscal_scav * (xFeT / 0.4) 
     2735                     !! 
     2736                  elseif (xFeT.gt.0.6) then 
     2737                     !! 
     2738                     !! high iron region 
     2739                     !! 
     2740                     fscal_scav = fscal_scav + ((xFeT / 0.6) * (6.0 / 1.4)) 
     2741                     !! 
     2742                  else 
     2743                     !! 
     2744                     !! intermediate iron region: do nothing 
     2745                     !! 
     2746                  endif 
     2747                  !!  
     2748                  !! apply the calculated scavenging rate ... 
     2749                  !! 
     2750                  ffescav = fscal_scav * zfer 
     2751                  !! 
     2752               elseif (jiron.eq.3) then 
     2753                  !!---------------------------------------------------------------------- 
     2754                  !! Scheme 3: Moore et al. (2008) 
     2755                  !! This scheme includes a single scavenging term that accounts for 
     2756                  !! sinking particles in the water column, and includes organic C, 
     2757                  !! biogenic opal, calcium carbonate and dust in this (though the 
     2758                  !! latter is ignored here until I work out what units the incoming 
     2759                  !! "dust" flux is in); this term scavenges total iron rather than  
     2760                  !! "free" iron 
     2761                  !!---------------------------------------------------------------------- 
     2762                  !! 
     2763                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
     2764                  xFeT        = zfer * 1.e3 
     2765                  !! 
     2766                  !! this has a base scavenging rate which is modified by local 
     2767                  !! particle sinking flux (including dust - but I'm ignoring that  
     2768                  !! here for now) and which is accelerated when Fe concentration 
     2769                  !! is > 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as  
     2770                  !! concentrations < 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3) 
     2771                  !! 
     2772                  !! base scavenging rate (Fe_b in paper; units may be wrong there) 
     2773                  fbase_scav = 0.00384 ! (ng)^-1 cm 
     2774                  !! 
     2775                  !! calculate sinking particle part of scaling factor; this converts 
     2776                  !! mmol / m2 / d fluxes of organic carbon, silicon and calcium 
     2777                  !! carbonate into ng / cm2 / s fluxes; it is assumed here that the 
     2778                  !! mass conversions simply consider the mass of the main element 
     2779                  !! (C, Si and Ca) and *not* the mass of the molecules that they are 
     2780                  !! part of; Moore et al. (2008) is unclear on the conversion that 
     2781                  !! should be used 
     2782                  !! 
     2783                  !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s 
     2784                  fscal_csink  = (ffastc(ji,jj)  * 1.e6 * xmassc  * 1.e-4 / 86400.)      ! ng C  / cm2 / s 
     2785                  fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi * 1.e-4 / 86400.)      ! ng Si / cm2 / s 
     2786                  fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca * 1.e-4 / 86400.)      ! ng Ca / cm2 / s 
     2787                  !!  
     2788                  !! sum up these sinking fluxes and convert to ng / cm by dividing 
     2789                  !! through by a sinking rate of 100 m / d = 1.157 cm / s 
     2790                  fscal_sink   = ((fscal_csink * 6.) + fscal_sisink + fscal_casink) / & 
     2791                  (100. * 1.e3 / 86400)                                                  ! ng / cm 
     2792                  !! 
     2793                  !! now calculate the scavenging rate based upon the base rate and 
     2794                  !! this particle flux scaling; according to the published units, 
     2795                  !! the result actually has *no* units, but as it must be expressed 
     2796                  !! per unit time for it to make any sense, I'm assuming a missing 
     2797                  !! "per second" 
     2798                  fscal_scav = fbase_scav * fscal_sink                                   ! / s 
     2799                  !! 
     2800                  !! the resulting scavenging rate is then scaled further according to the 
     2801                  !! local iron concentration (i.e. diminished in low iron regions; enhanced 
     2802                  !! in high iron regions; less alone in intermediate iron regions) 
     2803                  !! 
     2804                  if (xFeT.lt.0.5) then 
     2805                     !! 
     2806                     !! low iron region (0.5 instead of the 0.4 in Moore et al., 2004) 
     2807                     !! 
     2808                     fscal_scav = fscal_scav * (xFeT / 0.5) 
     2809                     !! 
     2810                  elseif (xFeT.gt.0.6) then 
     2811                     !! 
     2812                     !! high iron region (functional form different in Moore et al., 2004) 
     2813                     !! 
     2814                     fscal_scav = fscal_scav + ((xFeT - 0.6) * 0.00904) 
     2815                     !! 
     2816                  else 
     2817                     !! 
     2818                     !! intermediate iron region: do nothing 
     2819                     !! 
     2820                  endif 
     2821                  !!  
     2822                  !! apply the calculated scavenging rate ... 
     2823                  !! 
     2824                  ffescav = fscal_scav * zfer 
     2825                  !! 
     2826               elseif (jiron.eq.4) then 
     2827                  !!---------------------------------------------------------------------- 
     2828                  !! Scheme 4: Galbraith et al. (2010) 
     2829                  !! This scheme includes two scavenging terms, one for organic, 
     2830                  !! particle-based scavenging, and another for inorganic scavenging; 
     2831                  !! both terms scavenge "free" iron only 
     2832                  !!---------------------------------------------------------------------- 
     2833                  !! 
     2834                  !! Galbraith et al. (2010) present a more straightforward outline of  
     2835                  !! the scheme in Parekh et al. (2005) ... 
     2836                  !!  
     2837                  !! sinking particulate carbon available for scavenging 
     2838                  !! this assumes a sinking rate of 100 m / d (Moore & Braucher, 2008), 
     2839                  xCscav1     = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3 
     2840                  !!  
     2841                  !! scale by Honeyman et al. (1981) exponent coefficient 
     2842                  !! multiply by 1.e-3 to express C flux in g C rather than mg C 
     2843                  xCscav2     = (xCscav1 * 1.e-3)**0.58 
     2844                  !! 
     2845                  !! multiply by Galbraith et al. (2010) scavenging rate 
     2846                  xk_org      = 0.5 ! ((g C m/3)^-1) / d 
     2847                  xORGscav    = xk_org * xCscav2 * xFeF 
     2848                  !! 
     2849                  !! Galbraith et al. (2010) also include an inorganic bit ... 
     2850                  !!  
     2851                  !! this occurs at a fixed rate, again based on the availability of 
     2852                  !! "free" iron 
     2853                  !! 
     2854                  !! k_inorg  = 1000 d**-1 nmol Fe**-0.5 kg**-0.5 
     2855                  !! 
     2856                  !! to implement this here, scale xFeF by 1026 to put in units of 
     2857                  !! umol/m3 which approximately equal nmol/kg 
     2858                  !! 
     2859                  xk_inorg    = 1000. ! ((nmol Fe / kg)^1.5) 
     2860                  xINORGscav  = (xk_inorg * (xFeF * 1026.)**1.5) * 1.e-3 
     2861                  !! 
     2862                  !! sum these two terms together 
     2863                  ffescav     = xORGscav + xINORGscav 
     2864               else 
     2865                  !!---------------------------------------------------------------------- 
     2866                  !! No Scheme: you coward! 
     2867                  !! This scheme puts its head in the sand and eskews any decision about 
     2868                  !! how iron is removed from the ocean; prepare to get deluged in iron 
     2869                  !! you fool! 
     2870                  !!---------------------------------------------------------------------- 
     2871                  ffescav     = 0. 
     2872               endif 
     2873 
     2874               !!---------------------------------------------------------------------- 
     2875               !! Other iron cycle processes 
     2876               !!---------------------------------------------------------------------- 
     2877               !! 
     2878               !! aeolian iron deposition 
     2879               if (jk.eq.1) then 
     2880                  !! zirondep   is in mmol-Fe / m2 / day 
     2881                  !! ffetop     is in mmol-dissolved-Fe / m3 / day 
     2882                  ffetop  = zirondep(ji,jj) * xfe_sol / fthk  
     2883               else 
     2884                  ffetop  = 0.0 
     2885               endif 
     2886               !!