New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8657 for branches/NERC/dev_r5518_GO6_COAREbulk – NEMO

Ignore:
Timestamp:
2017-10-25T14:46:18+02:00 (6 years ago)
Author:
jpalmier
Message:

update the branch to match last GO6 changes

Location:
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM
Files:
2 deleted
39 edited
18 copied

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml

    r8308 r8657  
    448448       <field id= "DMS_HALL"   long_name="DMS Surface Concentration, Halloran"       unit="nmol/L"      /> 
    449449       <field id= "DMS_ANDM"   long_name="DMS Surface Concentration, Anderson modif" unit="nmol/L"      /> 
     450       <field id= "CHL_MLD"    long_name="MLD averaged Chlorophyll"                  unit="mg Chl/m3"   /> 
    450451       <field id= "ATM_XCO2"   long_name="Atmospheric xCO2"                          unit="ppm"         /> 
    451452       <field id= "OCN_FCO2"   long_name="Surface ocean fCO2"                        unit="uatm"        /> 
     
    784785      <field field_ref= "CO2STARAIR" name="CO2STARAIR" /> 
    785786      <field field_ref= "OCN_DPCO2"  name="OCN_DPCO2"  /> 
     787      <field field_ref= "CHL_MLD"    name="CHL_MLD"    /> 
    786788    </field_group> 
    787789 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/namelist_ref

    r8280 r8657  
    971971                           !        = 0  constant 10 m length scale 
    972972                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
     973   rn_c        =   0.8     !  Default value only used when nn_htau = 2 (typically never!) 
    973974/ 
    974975!------------------------------------------------------------------------ 
     
    12251226   ln_s3d     = .false.    ! Logical switch for S profile observations 
    12261227   ln_ena     = .false.    ! Logical switch for ENACT insitu data set 
    1227    ln_cor     = .false.    ! Logical switch for Coriolis insitu data set 
     1228   !                       !     ln_cor                  Logical switch for Coriolis insitu data set 
    12281229   ln_profb   = .false.    ! Logical switch for feedback insitu data set 
    12291230   ln_sla     = .false.    ! Logical switch for SLA observations 
     1231 
    12301232   ln_sladt   = .false.    ! Logical switch for AVISO SLA data 
     1233 
    12311234   ln_slafb   = .false.    ! Logical switch for feedback SLA data 
    1232    ln_ssh     = .false.    ! Logical switch for SSH observations 
    1233    ln_sst     = .false.    ! Logical switch for SST observations 
    1234    ln_reysst  = .false.    ! Logical switch for Reynolds observations 
    1235    ln_ghrsst  = .false.    ! Logical switch for GHRSST observations 
     1235                           !     ln_ssh                  Logical switch for SSH observations 
     1236 
     1237   ln_sst     = .false.     ! Logical switch for SST observations 
     1238   ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations 
     1239   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations 
     1240 
    12361241   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
    1237    ln_sss     = .false.    ! Logical switch for SSS observations 
     1242                           !     ln_sss                  Logical switch for SSS observations 
    12381243   ln_seaice  = .false.    ! Logical switch for Sea Ice observations 
    1239    ln_vel3d   = .false.    ! Logical switch for velocity observations 
    1240    ln_velavcur= .false     ! Logical switch for velocity daily av. cur. 
    1241    ln_velhrcur= .false     ! Logical switch for velocity high freq. cur. 
    1242    ln_velavadcp = .false.  ! Logical switch for velocity daily av. ADCP 
    1243    ln_velhradcp = .false.  ! Logical switch for velocity high freq. ADCP 
    1244    ln_velfb   = .false.    ! Logical switch for feedback velocity data 
    1245    ln_grid_global = .false. ! Global distribtion of observations 
    1246    ln_grid_search_lookup = .false. !  Logical switch for obs grid search w/lookup table 
    1247    grid_search_file = 'grid_search'  !  Grid search lookup file header 
    1248 ! All of the *files* variables below are arrays. Use namelist_cfg to add more files 
    1249    enactfiles = 'enact.nc' !  ENACT input observation file names (specify full array in namelist_cfg) 
    1250    coriofiles = 'corio.nc' !  Coriolis input observation file name 
    1251    profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name 
    1252    ln_profb_enatim = .false !        Enact feedback input time setting switch 
    1253    slafilesact = 'sla_act.nc' !  Active SLA input observation file names 
    1254    slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names 
    1255    slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names 
    1256    sstfiles = 'ghrsst.nc'   ! GHRSST input observation file names 
    1257    sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names 
    1258    seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names 
    1259    velavcurfiles = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name 
    1260    velhrcurfiles = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name 
    1261    velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name 
    1262    velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name 
    1263    velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name 
    1264    dobsini = 20000101.000000  !  Initial date in window YYYYMMDD.HHMMSS 
    1265    dobsend = 20010101.000000  !  Final date in window YYYYMMDD.HHMMSS 
    1266    n1dint = 0  !               Type of vertical interpolation method 
    1267    n2dint = 0  !               Type of horizontal interpolation method 
    1268    ln_nea = .false.   !        Rejection of observations near land switch 
    1269    nmsshc     = 0     !        MSSH correction scheme 
    1270    mdtcorr = 1.61     !        MDT  correction 
    1271    mdtcutoff = 65.0   !        MDT cutoff for computed correction 
     1244                           !     ln_vel3d                Logical switch for velocity observations 
     1245                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
     1246                           !     ln_velhrcur             Logical switch for velocity high freq. cur. 
     1247                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP 
     1248                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP 
     1249                           !     ln_velfb                Logical switch for feedback velocity data 
     1250                           !     ln_grid_global          Global distribtion of observations 
     1251                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table 
     1252                           !     grid_search_file        Grid search lookup file header 
     1253                           !     enactfiles              ENACT input observation file names 
     1254                           !     coriofiles              Coriolis input observation file name 
     1255   !                       ! profbfiles: Profile feedback input observation file name 
     1256   profbfiles = 'profiles_01.nc' 
     1257                           !     ln_profb_enatim         Enact feedback input time setting switch 
     1258                           !     slafilesact             Active SLA input observation file name 
     1259                           !     slafilespas             Passive SLA input observation file name 
     1260   !                       ! slafbfiles: Feedback SLA input observation file name 
     1261   slafbfiles = 'sla_01.nc' 
     1262                           !     sstfiles                GHRSST input observation file name 
     1263   !                       ! sstfbfiles: Feedback SST input observation file name 
     1264   sstfbfiles = 'sst_01.nc' 
     1265                           !     seaicefiles             Sea Ice input observation file names 
     1266   seaicefiles = 'seaice_01.nc' 
     1267                           !     velavcurfiles           Vel. cur. daily av. input file name 
     1268                           !     velhvcurfiles           Vel. cur. high freq. input file name 
     1269                           !     velavadcpfiles          Vel. ADCP daily av. input file name 
     1270                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
     1271                           !     velfbfiles              Vel. feedback input observation file name 
     1272                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS 
     1273                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS 
     1274                           !     n1dint                  Type of vertical interpolation method 
     1275                           !     n2dint                  Type of horizontal interpolation method 
     1276                           !     ln_nea                  Rejection of observations near land switch 
     1277   nmsshc     = 0          ! MSSH correction scheme 
     1278                           !     mdtcorr                 MDT  correction 
     1279                           !     mdtcutoff               MDT cutoff for computed correction 
    12721280   ln_altbias = .false.    ! Logical switch for alt bias 
    12731281   ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
    1274    endailyavtypes = 820    ! ENACT daily average types - array (use namelist_cfg to set more values) 
     1282                           !     endailyavtypes   ENACT daily average types 
    12751283   ln_grid_global = .true. 
    12761284   ln_grid_search_lookup = .false. 
     
    12851293    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI) 
    12861294    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU) 
     1295    ln_seaiceinc = .false. !  Logical switch for applying sea ice increments 
     1296    ln_temnofreeze = .false. !  Logical to not add increments if temperature would fall below freezing 
    12871297    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1] 
    12881298    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1] 
     
    13211331   rn_htrmax         =  200.0   ! max. depth of transition range 
    13221332/ 
     1333!----------------------------------------------------------------------- 
     1334&nambias   ! Bias pressure correctiom 
     1335!----------------------------------------------------------------------- 
     1336   ln_bias        = .false. 
     1337   ln_bias_asm    = .false. 
     1338   ln_bias_rlx    = .false. 
     1339   ln_bias_ofl    = .false. 
     1340   ln_bias_ts_app = .false. 
     1341   ln_bias_pc_app = .false.         
     1342   fb_t_asm       = 0.0 
     1343   fb_t_rlx       = 0.0 
     1344   fb_t_ofl       = 1.0 
     1345   fb_p_asm       = 1.0 
     1346   fb_p_rlx       = 1.0 
     1347   fb_p_ofl       = 0.0 
     1348   eft_rlx        = 365.0 
     1349   eft_asm        = 365.0 
     1350   t_rlx_upd      = 0.1 
     1351   t_asm_upd      = 0.1 
     1352   nn_lat_ramp    = 0           
     1353   bias_time_unit_asm = 86400.0 
     1354   bias_time_unit_rlx = 1.0 
     1355   bias_time_unit_ofl = 1.0  
     1356   cn_bias_tot    = "bias_tot.nc"  
     1357   cn_bias_asm    = "bias_asm.nc" 
     1358   cn_dir         = './'   
     1359   ln_bsyncro     = .FALSE.  
     1360   fctamp         = 1. 
     1361   rn_maxlat_bias = 23.0       
     1362   rn_minlat_bias = 10.0 
     1363   nn_bias_itwrt  = 15 
     1364   ln_itdecay     = .FALSE. 
     1365   ln_incpc       = .FALSE. 
     1366/ 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_ref

    r8280 r8657  
    6262   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    6363   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
     64   rn_fact_lap      =     1.    !     enhanced zonal eddy diffusivity 
    6465/ 
    6566!----------------------------------------------------------------------- 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r6486 r8657  
    119119            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
    120120#endif 
    121             CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
     121!            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
     122            CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               ) 
    122123            ! 
    123124            CALL iom_close( inum ) 
     
    153154            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
    154155            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     156            CALL iom_rstput( kt, nitdin_r, inum, 'avt'    , avt     ) 
    155157            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    156158#if defined key_lim2 || defined key_lim3 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r7962 r8657  
    3939   USE ice_2            ! LIM2 
    4040#endif 
     41#if defined key_cice && defined key_asminc 
     42   USE sbc_ice, ONLY : & ! CICE Ice model variables 
     43   & ndaice_da, nfresh_da, nfsalt_da 
     44#endif 
    4145   USE sbc_oce          ! Surface boundary condition variables. 
    4246 
     
    133137         &                 ln_asmdin, ln_asmiau,                           & 
    134138         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    135          &                 ln_salfix, salfixmin, nn_divdmp 
     139         &                 ln_salfix, salfixmin, nn_divdmp,                & 
     140         &                 ln_seaiceinc, ln_temnofreeze 
    136141      !!---------------------------------------------------------------------- 
    137142 
     
    892897            ENDIF 
    893898 
     899         ELSE 
     900#if defined key_asminc 
     901            ssh_iau(:,:) = 0.0 
     902#endif 
    894903         ENDIF 
    895904 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r7747 r8657  
    8484      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    8585      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
     86      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
    8687      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    8788      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
     
    9394      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
    9495      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
    95       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
    9696 
    9797 
     
    130130            zmask(:,:,:) = 0._wp 
    131131            zts(:,:,:,:) = 0._wp 
    132             zvn(:,:,:) = 0._wp 
    133132            DO jk = 1, jpkm1 
    134133               DO jj = 1, jpjm1 
     
    138137                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    139138                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    140                      zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
    141139                  ENDDO 
    142140               ENDDO 
     
    151149             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
    152150             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
    153              v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
     151             v_msf(:,:,1) = ptr_sjk( pvtr(:,:,:) ) 
    154152 
    155153             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
     
    177175                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    178176                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    179                     v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
     177                    v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn) )  
    180178                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
    181179                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
     
    202200             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
    203201             
    204             vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
     202            vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,1)) 
    205203            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
    206204            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
     
    224222                    r1_sjk(:,1,jn) = 0._wp 
    225223                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
    226                     vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
     224                    vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,jn)) 
    227225                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
    228226                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     
    408406            ENDIF 
    409407            IF( iom_use("zomsfeivglo") ) THEN 
    410                z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:) )  ! zonal cumulative effective transport 
     408               DO jk=1,jpk 
     409                  DO jj=1,jpj 
     410                     DO ji=1,jpi 
     411                        zvn(ji,jj,jk) = v_eiv(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 
     412                     ENDDO 
     413                  ENDDO 
     414               ENDDO 
     415               z3d(1,:,:) = ptr_sjk( zvn(:,:,:) )  ! zonal cumulative effective transport 
    411416               DO jk = jpkm1,1,-1 
    412417                 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk)   ! effective j-Stream-Function (MSF) 
     
    419424               IF( ln_subbas ) THEN 
    420425                  DO jn = 2, nptr                                    ! by sub-basins 
    421                      z3d(1,:,:) =  ptr_sjk( v_eiv(:,:,:), btmsk(:,:,jn) )  
     426                     z3d(1,:,:) =  ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
    422427                     DO jk = jpkm1,1,-1 
    423428                        z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk)    ! effective j-Stream-Function (MSF) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r8280 r8657  
    4747   USE iom 
    4848   USE ioipsl 
    49    USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities      
    50  
     49   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities     
     50   USE insitu_tem, ONLY: insitu_t, theta2t 
    5151#if defined key_lim2 
    5252   USE limwri_2  
     
    164164       
    165165      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
     166      CALL theta2t ! in-situ temperature conversion 
     167      CALL iom_put( "tinsitu", insitu_t(:,:,:))    ! in-situ temperature 
    166168      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    167169      IF ( iom_use("sbt") ) THEN 
     
    202204         CALL iom_put( "taubot", z2d )            
    203205      ENDIF 
    204           
     206       
    205207      CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current 
    206208      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r6486 r8657  
    355355         &      gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         & 
    356356         &      gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) ) 
     357 
     358      ! Initilaise key variables at risk of being intercepted before properly set up.  
     359      e3t_0(:,:,:) = 0.0 
    357360         ! 
    358361#if defined key_vvl 
     
    368371         &      ehu_b    (jpi,jpj)    , ehv_b  (jpi,jpj),                                                     & 
    369372         &      ehur_b   (jpi,jpj)    , ehvr_b (jpi,jpj),                                  STAT=ierr(5) )                           
     373 
     374      ! Initilaise key variables at risk of being intercepted before properly set up.  
     375      e3t_n(:,:,:) = 0.0 
    370376#endif 
    371377         ! 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r6486 r8657  
    4444   USE wrk_nemo        ! Memory Allocation 
    4545   USE timing          ! Timing 
     46   USE biaspar         ! bias correction variables 
    4647 
    4748   IMPLICIT NONE 
     
    8485      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8586      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     87      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z_rhd_st  ! tmp density storage for pressure corr 
     88      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   z_gru_st  ! tmp ua trends storage for pressure corr 
     89      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   z_grv_st  ! tmp va trends storage for pressure corr 
    8690      !!---------------------------------------------------------------------- 
    8791      ! 
     
    9498      ENDIF 
    9599      ! 
     100      IF ( ln_bias .AND. ln_bias_pc_app ) THEN 
     101 
     102         !Allocate space for tempory variables 
     103         ALLOCATE( z_rhd_st(jpi,jpj,jpk), & 
     104            &      z_gru_st(jpi,jpj),     & 
     105            &      z_grv_st(jpi,jpj)      ) 
     106 
     107         z_rhd_st(:,:,:) = rhd(:,:,:)     ! store orig density  
     108         rhd(:,:,:)      = rhd_pc(:,:,:)  ! use pressure corrected density 
     109         z_gru_st(:,:)   = gru(:,:) 
     110         gru(:,:)        = gru_pc(:,:) 
     111         z_grv_st(:,:)   = grv(:,:) 
     112         grv(:,:)        = grv_pc(:,:) 
     113 
     114      ENDIF 
     115 
    96116      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation 
    97117      CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate 
     
    112132      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    113133         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     134      ! 
     135      IF ( ln_bias .AND. ln_bias_pc_app )  THEN 
     136         IF(lwp) THEN  
     137         WRITE(numout,*) " ! restore original density" 
     138         ENDIF 
     139         rhd(:,:,:) = z_rhd_st(:,:,:)     ! restore original density 
     140         gru(:,:)   = z_gru_st(:,:) 
     141         grv(:,:)   = z_grv_st(:,:) 
     142 
     143         !Deallocate tempory variables 
     144         DEALLOCATE( z_rhd_st,     & 
     145            &        z_gru_st,     & 
     146            &        z_grv_st      ) 
     147      ENDIF 
    114148      ! 
    115149      IF( nn_timing == 1 )  CALL timing_stop('dyn_hpg') 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r6487 r8657  
    7474      INTEGER, INTENT(in) ::   kt                      ! time step 
    7575      !  
    76       INTEGER             ::   jk                      ! dummy loop indice 
     76      INTEGER             ::   jk                      ! dummy loop indices 
    7777      REAL(wp)            ::   z2dt, z1_rau0           ! local scalars 
    7878      !!---------------------------------------------------------------------- 
     
    9494      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
    9595      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
     96 
     97 
     98#if defined key_asminc 
     99      !                                                ! Include the IAU weighted SSH increment 
     100      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
     101         CALL ssh_asm_inc( kt ) 
     102#if defined key_vvl 
     103! Don't directly adjust ssh but change hdivn at all levels instead 
     104! In trasbc also add in the heat and salt content associated with these changes at each level   
     105        DO jk = 1, jpkm1                                  
     106                 hdivn(:,:,jk) = hdivn(:,:,jk) - ( ssh_iau(:,:) / ( ht_0(:,:) + 1.0 - ssmask(:,:) ) ) * ( e3t_0(:,:,jk) / fse3t_n(:,:,jk) ) * tmask(:,:,jk)  
     107        END DO 
     108      ENDIF 
     109#endif 
     110#endif 
     111 
    96112 
    97113      !                                           !------------------------------! 
     
    123139#endif 
    124140 
    125 #if defined key_asminc 
    126       !                                                ! Include the IAU weighted SSH increment 
    127       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    128          CALL ssh_asm_inc( kt ) 
    129          ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    130       ENDIF 
    131 #endif 
    132141 
    133142      !                                           !------------------------------! 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r6498 r8657  
    110110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
    111111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_p, ht_p ! Meltpond fraction and depth 
     112    
     113   ! 
     114    
     115   ! 
     116#if defined key_asminc 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ndaice_da          !: NEMO fresh water flux to ocean due to data assim 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfresh_da          !: NEMO salt flux to ocean due to data assim 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfsalt_da          !: NEMO ice concentration change/second from data assim 
     120#endif 
     121       
    112122#endif 
    113123    
     
    162172                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    163173                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
     174#if defined key_asminc 
     175                ndaice_da(jpi,jpj)    , nfresh_da(jpi,jpj)    , nfsalt_da(jpi,jpj)    , & 
     176#endif 
    164177                sstfrz(jpi,jpj)       , STAT= ierr(1) ) 
    165178   ! Alex West: Allocating tn_ice with 5 categories.  When NEMO is used with CICE, this variable 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8280 r8657  
    21372137      REAL(wp) ::   zumax, zvmax 
    21382138      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
     2139      REAL(wp), POINTER, DIMENSION(:,:)   ::   zotx1_in, zoty1_in 
    21392140      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
    21402141      !!---------------------------------------------------------------------- 
     
    21432144      ! 
    21442145      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     2146      CALL wrk_alloc( jpi,jpj, zotx1_in, zoty1_in) 
    21452147      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    21462148 
     
    24112413            zotx1(:,:) = un(:,:,1)   
    24122414            zoty1(:,:) = vn(:,:,1)   
    2413          ELSE         
     2415         ELSE 
    24142416            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    24152417            CASE( 'oce only'             )      ! C-grid ==> T 
     
    25472549                  ENDDO 
    25482550               ENDDO 
    2549                 
     2551 
    25502552               ! Ensure any N fold and wrap columns are updated 
    25512553               CALL lbc_lnk(ztmp1, 'V', -1.0) 
    25522554               CALL lbc_lnk(ztmp2, 'U', -1.0) 
    2553                 
     2555                             
    25542556               ikchoix = -1 
    2555                CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 
     2557               ! We need copies of zotx1 and zoty2 in order to avoid problems  
     2558               ! caused by INTENTs used in the following subroutine.  
     2559               zotx1_in(:,:) = zotx1(:,:) 
     2560               zoty1_in(:,:) = zoty1(:,:) 
     2561               CALL repcmo (zotx1_in,ztmp2,ztmp1,zoty1_in,zotx1,zoty1,ikchoix) 
    25562562           ENDIF 
    25572563         ENDIF 
     
    26222628      ! 
    26232629      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     2630      CALL wrk_dealloc( jpi,jpj, zotx1_in, zoty1_in ) 
    26242631      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    26252632      ! 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r8280 r8657  
    5656                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,             & 
    5757                flatn_f,fsurfn_f,fcondtopn_f,                    & 
     58#ifdef key_asminc 
     59                daice_da,fresh_da,fsalt_da,                    & 
     60#endif 
    5861                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    5962                swvdr,swvdf,swidr,swidf,Tf,                      & 
     
    301304  
    302305      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
     306 
     307#if defined key_asminc 
     308      ! Initialize fresh water and salt fluxes from data assim    
     309      !  and data assimilation index to cice  
     310      nfresh_da(:,:) = 0.0    
     311      nfsalt_da(:,:) = 0.0    
     312      ndaice_da(:,:) = 0.0          
     313#endif 
    303314      ! 
    304315      ! In coupled mode get extra fields from CICE for passing back to atmosphere 
     
    454465      ENDIF 
    455466 
     467#if defined key_asminc 
     468!Ice concentration change (from assimilation) 
     469      ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1) 
     470      Call nemo2cice(ztmp,daice_da,'T', 1. ) 
     471#endif  
     472 
    456473! Snowfall 
    457474! Ensure fsnow is positive (as in CICE routine prepare_forcing) 
     
    716733         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
    717734      ENDIF 
     735 
     736#if defined key_asminc 
     737! Import fresh water and salt flux due to seaice da 
     738      CALL cice2nemo(fresh_da, nfresh_da,'T',1.0) 
     739      CALL cice2nemo(fsalt_da, nfsalt_da,'T',1.0) 
     740#endif 
    718741 
    719742! Release work space 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r7993 r8657  
    312312      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
    313313      !                                                                ! 2 : salinity               [psu] 
    314       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    315       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     314      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(inout) ::   prd    ! in situ density            [-] 
     315      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(inout) ::   prhop  ! potential density (surface referenced) 
    316316      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    317317      ! 
     
    457457      END SELECT 
    458458      ! 
     459      CALL lbc_lnk( prd, 'T', 1.0_wp ) 
     460      ! 
    459461      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    460462      ! 
     
    902904      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
    903905      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
    904       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     906      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(inout) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    905907      ! 
    906908      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r7771 r8657  
    549549      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    550550 
    551                                         !* sign of grad(H) at u- and v-points 
    552       mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
     551      !! AXY (16/08/17): remove the following per George and Andrew bug-hunt 
     552      !!                                   !* sign of grad(H) at u- and v-points 
     553      !! mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
     554      !! DO jj = 1, jpjm1 
     555      !!    DO ji = 1, jpim1 
     556      !!       mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     557      !!       mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     558      !!    END DO 
     559      !! END DO 
     560 
     561      !! AXY (16/08/17): add the following replacement per George and Andrew bug-hunt 
     562                                        !* sign of grad(H) at u- and  v-points; zero if grad(H) = 0 
     563      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0 
    553564      DO jj = 1, jpjm1 
    554565         DO ji = 1, jpim1 
    555             mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    556             mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     566#if defined key_bbl_old_nonconserve 
     567             ! This key allows old (non conservative version) to be used for continuity of results 
     568             mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     569             mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     570#else 
     571            IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
     572               mgrhu(ji,jj) = INT(  SIGN( 1.e0, & 
     573               gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     574            ENDIF 
     575            !      
     576            IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
     577               mgrhv(ji,jj) = INT(  SIGN( 1.e0, & 
     578               gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     579            ENDIF 
     580#endif 
    557581         END DO 
    558582      END DO 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7993 r8657  
    3333   USE timing          ! Timing 
    3434   USE eosbn2 
     35#if defined key_asminc    
     36   USE asminc          ! Assimilation increment 
     37#endif 
    3538 
    3639   IMPLICIT NONE 
     
    120123      REAL(wp) ::   zfact, z1_e3t, zdep 
    121124      REAL(wp) ::   zalpha, zhk 
     125      REAL(wp) ::  zt_frz, zpress 
    122126      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    123127      !!---------------------------------------------------------------------- 
     
    283287      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss 
    284288 
     289#if defined key_asminc 
     290! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM... 
     291! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0 
     292! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n) 
     293      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation 
     294         DO jj = 2, jpj  
     295            DO ji = fs_2, fs_jpim1 
     296               zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) ) 
     297               DO jk = 1, jpkm1 
     298                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
     299                                        &            + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 
     300                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
     301                                        &            + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 
     302               END DO 
     303            END DO   
     304         END DO   
     305      ENDIF 
     306#endif 
     307  
    285308      IF( l_trdtra )   THEN                      ! send trends for further diagnostics 
    286309         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8280 r8657  
    227227#endif 
    228228      ! 
     229      ! Met Office addition: if failed, return non-zero exit code 
     230      IF( nstop /= 0 )  CALL exit( 9 )  
     231      ! 
    229232   END SUBROUTINE nemo_gcm 
    230233 
     
    480483                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    481484                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
     485                            CALL     bias_init  ! Pressure correction bias 
    482486      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    483487                            CALL dia_obs_init            ! Initialize observational data 
     
    646650      !!---------------------------------------------------------------------- 
    647651      USE diawri    , ONLY: dia_wri_alloc 
     652      USE insitu_tem, ONLY: insitu_tem_alloc 
    648653      USE dom_oce   , ONLY: dom_oce_alloc 
    649654      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 
     
    662667      ierr =        oce_alloc       ()          ! ocean 
    663668      ierr = ierr + dia_wri_alloc   () 
     669      ierr = ierr + insitu_tem_alloc() 
    664670      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    665671      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/step.F90

    r8280 r8657  
    103103      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp 
    104104 
     105      IF( ln_bias )          CALL bias_opn( kstp ) 
     106 
    105107      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    106108      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
     
    267269      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    268270      IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
     271      IF( ln_bias        )   CALL tra_bias   ( kstp ) 
    269272      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends 
    270273                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
     
    290293               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    291294               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
     295            IF( ln_bias )    CALL dyn_bias( kstp ) 
    292296      ELSE                                                  ! centered hpg  (eos then time stepping) 
    293297         IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
     
    303307         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    304308                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     309         IF( ln_bias )       CALL dyn_bias( kstp ) 
    305310      ENDIF 
    306311 
     
    377382      ENDIF 
    378383 
     384 
     385      IF( lrst_bias )          CALL bias_wrt     ( kstp ) 
     386 
    379387      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    380388      ! Coupled mode 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r6491 r8657  
    100100 
    101101   USE crsfld           ! Standard output on coarse grid   (crs_fld routine) 
    102  
     102   USE biaspar          ! bias param 
     103   USE bias             ! bias routines                    (tra_bias routine 
     104                        !                                   dyn_bias routine) 
    103105   USE asminc           ! assimilation increments      (tra_asm_inc routine) 
    104106   !                                                   (dyn_asm_inc routine) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90

    r6715 r8657  
    5757      IF( nn_timing == 1 )  CALL timing_start('trc_sms_age') 
    5858      ! 
    59       IF(lwp) WRITE(numout,*) 
    60       IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model' 
    61       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     59      IF( kt == nittrc000 ) THEN 
     60         IF(lwp) WRITE(numout,*) 
     61         IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model' 
     62         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     63      ENDIF 
    6264 
    6365      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrage ) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r6486 r8657  
    4949      ! definition of additional diagnostic as a structure 
    5050      INTEGER :: jl, jn 
    51       TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d 
    52       TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d 
    5351      !! 
    5452      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    55       NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics 
    5653      !!------------------------------------------------------------------- 
    5754      !                             ! Open namelist file 
     
    7774      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    7875      ! 
    79       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    80          ! 
    81          ! Namelist namc14dia 
    82          ! ------------------- 
    83          REWIND( numnatb_ref )              ! Namelist namc14dia in reference namelist : c14b diagnostics 
    84          READ  ( numnatb_ref, namc14dia, IOSTAT = ios, ERR = 903) 
    85 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in reference namelist', lwp ) 
    86  
    87          REWIND( numnatb_cfg )              ! Namelist namc14dia in configuration namelist : c14b diagnostics 
    88          READ  ( numnatb_cfg, namc14dia, IOSTAT = ios, ERR = 904 ) 
    89 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in configuration namelist', lwp ) 
    90          IF(lwm) WRITE ( numonb, namc14dia ) 
    91  
    92          DO jl = 1, jp_c14b_2d 
    93             jn = jp_c14b0_2d + jl - 1 
    94             ctrc2d(jn) = c14dia2d(jl)%sname 
    95             ctrc2l(jn) = c14dia2d(jl)%lname 
    96             ctrc2u(jn) = c14dia2d(jl)%units 
    97          END DO 
    98  
    99          DO jl = 1, jp_c14b_3d 
    100             jn = jp_c14b0_3d + jl - 1 
    101             ctrc3d(jn) = c14dia3d(jl)%sname 
    102             ctrc3l(jn) = c14dia3d(jl)%lname 
    103             ctrc3u(jn) = c14dia3d(jl)%units 
    104          END DO 
    105  
    106          IF(lwp) THEN                   ! control print 
    107             WRITE(numout,*) 
    108             WRITE(numout,*) ' Namelist : natadd' 
    109             DO jl = 1, jp_c14b_3d 
    110                jn = jp_c14b0_3d + jl - 1 
    111                WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
    112                  &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
    113             END DO 
    114             WRITE(numout,*) ' ' 
    115  
    116             DO jl = 1, jp_c14b_2d 
    117                jn = jp_c14b0_2d + jl - 1 
    118                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    119                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    120             END DO 
    121             WRITE(numout,*) ' ' 
    122          ENDIF 
    123          ! 
    124       ENDIF 
    12576 
    12677   IF(lwm) CALL FLUSH ( numonb )     ! flush output namelist C14b 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r8280 r8657  
    4747      INTEGER :: ios                 ! Local integer output status for namelist read 
    4848      INTEGER :: jl, jn 
    49       TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5049      !! 
    5150      NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type  
    52       NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
    5351      !!---------------------------------------------------------------------- 
    5452      !                             ! Open namelist files 
     
    8280      ! 
    8381 
    84       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    85          ! 
    86          ! Namelist namcfcdia 
    87          ! ------------------- 
    88          REWIND( numnatc_ref )              ! Namelist namcfcdia in reference namelist : CFC diagnostics 
    89          READ  ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903) 
    90 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp ) 
    91  
    92          REWIND( numnatc_cfg )              ! Namelist namcfcdia in configuration namelist : CFC diagnostics 
    93          READ  ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 ) 
    94 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp ) 
    95          IF(lwm) WRITE ( numonc, namcfcdia ) 
    96  
    97          DO jl = 1, jp_cfc_2d 
    98             jn = jp_cfc0_2d + jl - 1 
    99             ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 
    100             ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 
    101             ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 
    102          END DO 
    103  
    104          IF(lwp) THEN                   ! control print 
    105             WRITE(numout,*) 
    106             WRITE(numout,*) ' Namelist : natadd' 
    107             DO jl = 1, jp_cfc_2d 
    108                jn = jp_cfc0_2d + jl - 1 
    109                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    110                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    111             END DO 
    112             WRITE(numout,*) ' ' 
    113          ENDIF 
    114          ! 
    115       ENDIF 
    116  
    11782   IF(lwm) CALL FLUSH ( numonc )     ! flush output namelist CFC 
    11883 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r8280 r8657  
    257257      !ENDIF                                             
    258258      ! 
    259       IF( lk_iomput ) THEN 
    260          IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    261          IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    262          IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
    263          IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
    264          IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
    265          IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    266       ELSE 
    267          IF( ln_diatrc ) THEN 
    268             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    269             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    270             trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 
    271             trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 
    272             trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 
    273             trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 
    274          END IF 
    275       END IF 
     259      IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     260      IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     261      IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
     262      IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
     263      IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
     264      IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    276265      ! 
    277266      IF( l_trdtrc ) THEN 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

    r6829 r8657  
    165165      !ENDIF 
    166166      ! 
    167       IF( lk_iomput ) THEN 
    168167         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) ) 
    169168         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) 
    170169         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) 
    171       ELSE 
    172          IF( ln_diatrc ) THEN 
    173             trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1) 
    174             trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1) 
    175             trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1) 
    176          END IF 
    177       END IF 
    178170      ! 
    179171# if defined key_debug_medusa 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90

    r6164 r8657  
    6363# endif 
    6464 
     65   ! assign an index in trc arrays for each PTS prognostic variables 
     66   INTEGER, PUBLIC, PARAMETER ::   jpchn_lc  =  1      !: non-diatom chlorophyll concentration 
     67   INTEGER, PUBLIC, PARAMETER ::   jpchd_lc  =  2      !: diatom     chlorophyll concentration 
     68   INTEGER, PUBLIC, PARAMETER ::   jpphn_lc  =  3      !: non-diatom concentration 
     69   INTEGER, PUBLIC, PARAMETER ::   jpphd_lc  =  4      !: diatom     concentration 
     70   INTEGER, PUBLIC, PARAMETER ::   jpzmi_lc  =  5      !: microzooplankton concentration 
     71   INTEGER, PUBLIC, PARAMETER ::   jpzme_lc  =  6      !: mesozooplankton  concentration 
     72   INTEGER, PUBLIC, PARAMETER ::   jpdin_lc  =  7      !: dissolved inorganic nitrogen concentration 
     73   INTEGER, PUBLIC, PARAMETER ::   jpsil_lc  =  8      !: silicic acid concentration 
     74   INTEGER, PUBLIC, PARAMETER ::   jpfer_lc  =  9      !: total iron concentration 
     75   INTEGER, PUBLIC, PARAMETER ::   jpdet_lc  =  10     !: slow-sinking detritus concentration 
     76   INTEGER, PUBLIC, PARAMETER ::   jppds_lc  =  11     !: diatom silicon concentration 
     77# if defined key_roam 
     78   INTEGER, PUBLIC, PARAMETER ::   jpdtc_lc  =  12     !: slow-sinking detritus carbon concentration 
     79   INTEGER, PUBLIC, PARAMETER ::   jpdic_lc  =  13     !: dissolved inorganic carbon concentration 
     80   INTEGER, PUBLIC, PARAMETER ::   jpalk_lc  =  14     !: alkalinity 
     81   INTEGER, PUBLIC, PARAMETER ::   jpoxy_lc  =  15     !: dissolved oxygen concentration 
     82# endif 
     83 
    6584#else 
    6685   !!--------------------------------------------------------------------- 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r8224 r8657  
    66   !! History : 
    77   !!  -   !  1999-07  (M. Levy)              original code 
    8    !!  -   !  2000-12  (E. Kestenare)         assign parameters to name individual tracers 
     8   !!  -   !  2000-12  (E. Kestenare)         assign parameters to name  
     9   !!                                         individual tracers 
    910   !!  -   !  2001-03  (M. Levy)              LNO3 + dia2d  
    1011   !! 2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
     
    1819   !!  -   !  2015-06  (A. Yool)              Update to include MOCSY 
    1920   !!  -   !  2015-07  (A. Yool)              Update for rolling averages 
    20    !!  -   !  2015-10  (J. Palm)              Update for diag outputs through iom_use   
     21   !!  -   !  2015-10  (J. Palm)              Update for diag outputs through  
     22   !!                                         iom_use   
    2123   !!  -   !  2016-11  (A. Yool)              Updated diags for CMIP6 
    2224   !!  -   !  2017-05  (A. Yool)              Added extra DMS calculation 
     
    6062   !!   trc_bio_medusa        :   
    6163   !!---------------------------------------------------------------------- 
    62       USE oce_trc 
    63       USE trc 
    64       USE sms_medusa 
    65       USE lbclnk 
    66       USE prtctl_trc      ! Print control for debugging 
    67       USE trcsed_medusa 
    68       USE sbc_oce         ! surface forcing 
    69       USE sbcrnf          ! surface boundary condition: runoff variables 
    70       USE in_out_manager  ! I/O manager 
    71 # if defined key_iomput 
    72       USE iom 
    73       USE trcnam_medusa         ! JPALM 13-11-2015 -- if iom_use for diag 
    74       !!USE trc_nam_iom_medusa  ! JPALM 13-11-2015 -- if iom_use for diag 
    75 # endif 
    76 # if defined key_roam 
    77       USE gastransfer 
    78 #  if defined key_mocsy 
    79       USE mocsy_wrapper 
    80 #  else 
    81       USE trcco2_medusa 
    82 #  endif 
    83       USE trcoxy_medusa 
    84       !! Jpalm (08/08/2014) 
    85       USE trcdms_medusa 
    86 # endif 
    87       !! AXY (18/01/12): brought in for benthic timestepping 
    88       USE trcnam_trp      ! AXY (24/05/2013) 
    89       USE trdmxl_trc 
    90       USE trdtrc_oce  ! AXY (24/05/2013) 
    91  
    9264      !! AXY (30/01/14): necessary to find NaNs on HECTOR 
    9365      USE, INTRINSIC :: ieee_arithmetic  
    9466 
     67      USE bio_medusa_mod,             ONLY: b0, fdep1,                      &  
     68                                            ibenthic, idf, idfval,          & 
     69# if defined key_roam 
     70                                            f_xco2a,                        & 
     71                                            zalk, zdic, zoxy, zsal, ztmp,   & 
     72# endif 
     73# if defined key_mocsy 
     74                                            zpho,                           & 
     75# endif 
     76                                            zchd, zchn, zdet, zdin, zdtc,   & 
     77                                            zfer, zpds, zphd, zphn, zsil,   & 
     78                                            zzme, zzmi 
     79      USE dom_oce,                    ONLY: e3t_0, e3t_n,                   & 
     80                                            gdept_0, gdept_n,               & 
     81                                            gdepw_0, gdepw_n,               & 
     82                                            nday_year, nsec_day, nyear,     & 
     83                                            rdt, tmask 
     84      USE in_out_manager,             ONLY: lwp, numout, nn_date0 
     85# if defined key_iomput 
     86      USE iom,                        ONLY: lk_iomput 
     87# endif 
     88      USE lbclnk,                     ONLY: lbc_lnk 
     89      USE lib_mpp,                    ONLY: ctl_stop 
     90      USE oce,                        ONLY: tsb, tsn 
     91      USE par_kind,                   ONLY: wp 
     92      USE par_medusa,                 ONLY: jpalk, jpchd, jpchn, jpdet,     & 
     93                                            jpdic, jpdin, jpdtc, jpfer,     & 
     94                                            jpoxy, jppds, jpphd, jpphn,     & 
     95                                            jpsil, jpzme, jpzmi 
     96      USE par_oce,                    ONLY: jp_sal, jp_tem, jpi, jpim1,     & 
     97                                            jpj, jpjm1, jpk 
    9598      !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm 
    96       USE sbc_oce, ONLY: lk_oasis 
    97       USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, chloro_out_cpl 
     99      USE sbc_oce,                    ONLY: lk_oasis 
     100      USE sms_medusa,                 ONLY: hist_pco2 
     101      USE trc,                        ONLY: ln_rsttr, nittrc000, trn 
     102      USE bio_medusa_init_mod,        ONLY: bio_medusa_init 
     103      USE carb_chem_mod,              ONLY: carb_chem 
     104      USE air_sea_mod,                ONLY: air_sea 
     105      USE plankton_mod,               ONLY: plankton 
     106      USE iron_chem_scav_mod,         ONLY: iron_chem_scav 
     107      USE detritus_mod,               ONLY: detritus 
     108      USE bio_medusa_update_mod,      ONLY: bio_medusa_update 
     109      USE bio_medusa_diag_mod,        ONLY: bio_medusa_diag 
     110      USE bio_medusa_diag_slice_mod,  ONLY: bio_medusa_diag_slice 
     111      USE bio_medusa_fin_mod,         ONLY: bio_medusa_fin 
    98112 
    99113      IMPLICIT NONE 
    100114      PRIVATE 
    101115       
    102       PUBLIC   trc_bio_medusa    ! called in ??? 
     116      PUBLIC   trc_bio_medusa    ! called in trcsms_medusa.F90 
    103117 
    104118   !!* Substitution 
     
    113127 
    114128   SUBROUTINE trc_bio_medusa( kt ) 
    115       !!--------------------------------------------------------------------- 
     129      !!------------------------------------------------------------------ 
    116130      !!                     ***  ROUTINE trc_bio  *** 
    117131      !! 
    118       !! ** Purpose :   compute the now trend due to biogeochemical processes 
    119       !!              and add it to the general trend of passive tracers equations 
    120       !! 
    121       !! ** Method  :   each now biological flux is calculated in function of now 
    122       !!              concentrations of tracers. 
    123       !!              depending on the tracer, these fluxes are sources or sinks. 
    124       !!              the total of the sources and sinks for each tracer 
     132      !! ** Purpose : compute the now trend due to biogeochemical processes 
     133      !!              and add it to the general trend of passive tracers  
     134      !!              equations 
     135      !! 
     136      !! ** Method  : each now biological flux is calculated in function of 
     137      !!              now concentrations of tracers. 
     138      !!              depending on the tracer, these fluxes are sources or  
     139      !!              sinks. 
     140      !!              The total of the sources and sinks for each tracer 
    125141      !!              is added to the general trend. 
    126142      !!         
     
    132148      !!              IF 'key_trc_diabio' defined , the biogeochemical trends 
    133149      !!              for passive tracers are saved for futher diagnostics. 
    134       !!--------------------------------------------------------------------- 
    135       !! 
    136       !! 
    137       !!----------------------------------------------------------------------             
     150      !!------------------------------------------------------------------ 
     151      !! 
     152      !! 
     153      !!------------------------------------------------------------------ 
    138154      !! Variable conventions 
    139       !!---------------------------------------------------------------------- 
     155      !!------------------------------------------------------------------ 
    140156      !! 
    141157      !! names: z*** - state variable  
    142       !!        f*** - function (or temporary variable used in part of a function) 
     158      !!        f*** - function (or temporary variable used in part of  
     159      !!               a function) 
    143160      !!        x*** - parameter 
    144161      !!        b*** - right-hand part (sources and sinks) 
     
    151168      INTEGER  ::    ji,jj,jk,jn 
    152169      !! 
    153       !! AXY (27/07/10): add in indices for depth horizons (for sinking flux 
    154       !!                 and seafloor iron inputs) 
    155       !! INTEGER  ::    i0100, i0200, i0500, i1000, i1100 
    156       !! 
    157       !! model state variables 
    158       REAL(wp) ::    zchn,zchd,zphn,zphd,zpds,zzmi 
    159       REAL(wp) ::    zzme,zdet,zdtc,zdin,zsil,zfer 
    160       REAL(wp) ::    zage 
     170      INTEGER  ::    iball 
    161171# if defined key_roam 
    162       REAL(wp) ::    zdic, zalk, zoxy 
    163       REAL(wp) ::    ztmp, zsal 
    164 # endif 
    165 # if defined key_mocsy 
    166       REAL(wp) ::    zpho 
    167 # endif 
    168       !! 
    169       !! integrated source and sink terms 
    170       REAL(wp) ::    b0 
    171       !! AXY (23/08/13): changed from individual variables for each flux to 
    172       !!                 an array that holds all fluxes 
    173       REAL(wp), DIMENSION(jp_medusa) ::    btra 
    174       !! 
    175       !! primary production and chl related quantities       
    176       REAL(wp)                     ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn 
    177       REAL(wp)                     ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd 
    178       !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) 
    179       REAL(wp)                     ::    fjlim_pn, fjlim_pd 
    180       !! AXY (03/02/11): add in Liebig terms 
    181       REAL(wp) ::    fpnlim, fpdlim 
    182       !! AXY (16/07/09): add in Eppley curve functionality 
    183       REAL(wp) ::    loc_T,fun_T,xvpnT,xvpdT 
    184       INTEGER  ::    ieppley 
    185       !! AXY (16/05/11): per Katya's prompting, add in new T-dependence 
    186       !!                 for phytoplankton growth only (i.e. no change 
    187       !!                 for remineralisation) 
    188       REAL(wp) ::    fun_Q10 
    189       !! AXY (01/03/10): add in mixed layer PP diagnostics 
    190       REAL(wp), DIMENSION(jpi,jpj) ::  fprn_ml,fprd_ml 
    191       !! 
    192       !! nutrient limiting factors 
    193       REAL(wp) ::    fnln,ffln            !! N and Fe 
    194       REAL(wp) ::    fnld,ffld,fsld,fsld2 !! N, Fe and Si 
    195       !! 
    196       !! silicon cycle 
    197       REAL(wp) ::    fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss 
    198       !! 
    199       !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 
    200       REAL(wp) ::    ffetop,ffebot,ffescav 
    201       REAL(wp) ::    xLgF, xFeT, xFeF, xFeL         !! state variables for iron-ligand system 
    202       REAL(wp), DIMENSION(jpi,jpj) ::  xFree        !! state variables for iron-ligand system 
    203       REAL(wp) ::    xb_coef_tmp, xb2M4ac           !! iron-ligand parameters 
    204       REAL(wp) ::    xmaxFeF,fdeltaFe               !! max Fe' parameters 
    205       !! 
    206       !! local parameters for Moore et al. (2004) alternative scavenging scheme 
    207       REAL(wp) ::    fbase_scav,fscal_sink,fscal_part,fscal_scav 
    208       !! 
    209       !! local parameters for Moore et al. (2008) alternative scavenging scheme 
    210       REAL(wp) ::    fscal_csink,fscal_sisink,fscal_casink 
    211       !! 
    212       !! local parameters for Galbraith et al. (2010) alternative scavenging scheme 
    213       REAL(wp) ::    xCscav1, xCscav2, xk_org, xORGscav  !! organic portion of scavenging 
    214       REAL(wp) ::    xk_inorg, xINORGscav                !! inorganic portion of scavenging 
    215       !! 
    216       !! microzooplankton grazing 
    217       REAL(wp) ::    fmi1,fmi,fgmipn,fgmid,fgmidc 
    218       REAL(wp) ::    finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp 
    219       !! 
    220       !! mesozooplankton grazing 
    221       REAL(wp) ::    fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc 
    222       REAL(wp) ::    finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp 
    223       !! 
    224       !! mortality/Remineralisation (defunct parameter "fz" removed) 
    225       REAL(wp) ::    fdpn,fdpd,fdpds,fdzmi,fdzme,fdd 
    226 # if defined key_roam 
    227       REAL(wp) ::    fddc 
    228 # endif 
    229       REAL(wp) ::    fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2 
    230       REAL(wp) ::    fslown, fslowc 
    231       REAL(wp), DIMENSION(jpi,jpj) ::    fslownflux, fslowcflux 
    232       REAL(wp) ::    fregen,fregensi 
    233       REAL(wp), DIMENSION(jpi,jpj) ::    fregenfast,fregenfastsi 
    234 # if defined key_roam 
    235       REAL(wp) ::    fregenc 
    236       REAL(wp), DIMENSION(jpi,jpj) ::    fregenfastc 
    237 # endif 
    238       !! 
    239       !! particle flux 
    240       REAL(WP) ::    fthk,fdep,fdep1,fdep2,flat,fcaco3 
    241       REAL(WP) ::    ftempn,ftempsi,ftempfe,ftempc,ftempca 
    242       REAL(wp) ::    freminn,freminsi,freminfe,freminc,freminca 
    243       REAL(wp), DIMENSION(jpi,jpj) ::    ffastn,ffastsi,ffastfe,ffastc,ffastca 
    244       REAL(wp) ::    fleftn,fleftsi,fleftfe,fleftc,fleftca 
    245       REAL(wp) ::    fheren,fheresi,fherefe,fherec,fhereca 
    246       REAL(wp) ::    fprotf 
    247       REAL(wp), DIMENSION(jpi,jpj) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca 
    248       REAL(wp), DIMENSION(jpi,jpj) ::    fccd 
    249       REAL(wp) ::    fccd_dep 
    250       !! AXY (28/11/16): fix mbathy bug 
    251       INTEGER  ::    jmbathy 
    252       !! 
    253       !! AXY (06/07/11): alternative fast detritus schemes 
    254       REAL(wp) ::    fb_val, fl_sst 
    255       !! 
    256       !! AXY (08/07/11): fate of fast detritus reaching the seafloor 
    257       REAL(wp) ::    ffast2slown,ffast2slowfe,ffast2slowc 
    258       !! 
    259       !! conservation law 
    260       REAL(wp) ::    fnit0,fsil0,ffer0  
    261 # if defined key_roam 
    262       REAL(wp) ::    fcar0,falk0,foxy0  
    263 # endif       
     172      !! 
     173      INTEGER  ::    iyr1, iyr2 
     174      !! 
     175# endif 
    264176      !!  
    265177      !! temporary variables 
    266       REAL(wp) ::    fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8,fq9 
    267       !! 
    268       !! water column nutrient and flux integrals 
    269       REAL(wp), DIMENSION(jpi,jpj) ::    ftot_n,ftot_si,ftot_fe 
    270       REAL(wp), DIMENSION(jpi,jpj) ::    fflx_n,fflx_si,fflx_fe 
    271       REAL(wp), DIMENSION(jpi,jpj) ::    fifd_n,fifd_si,fifd_fe 
    272       REAL(wp), DIMENSION(jpi,jpj) ::    fofd_n,fofd_si,fofd_fe 
    273 # if defined key_roam 
    274       REAL(wp), DIMENSION(jpi,jpj) ::    ftot_c,ftot_a,ftot_o2 
    275       REAL(wp), DIMENSION(jpi,jpj) ::    fflx_c,fflx_a,fflx_o2 
    276       REAL(wp), DIMENSION(jpi,jpj) ::    fifd_c,fifd_a,fifd_o2 
    277       REAL(wp), DIMENSION(jpi,jpj) ::    fofd_c,fofd_a,fofd_o2 
    278 # endif 
    279       !! 
    280       !! zooplankton grazing integrals 
    281       REAL(wp), DIMENSION(jpi,jpj) ::    fzmi_i,fzmi_o,fzme_i,fzme_o 
    282       !! 
    283       !! limitation term temporary variables 
    284       REAL(wp), DIMENSION(jpi,jpj) ::    ftot_pn,ftot_pd 
    285       REAL(wp), DIMENSION(jpi,jpj) ::    ftot_zmi,ftot_zme,ftot_det,ftot_dtc 
    286       !! use ballast scheme (1) or simple exponential scheme (0; a conservation test) 
    287       INTEGER  ::    iball 
    288       !! use biological fluxes (1) or not (0) 
    289       INTEGER  ::    ibio_switch 
    290       !! 
    291       !! diagnose fluxes (should only be used in 1D runs) 
    292       INTEGER  ::    idf, idfval 
    293       !! 
    294       !! nitrogen and silicon production and consumption 
    295       REAL(wp) ::    fn_prod, fn_cons, fs_prod, fs_cons 
    296       REAL(wp), DIMENSION(jpi,jpj) ::    fnit_prod, fnit_cons, fsil_prod, fsil_cons 
    297 # if defined key_roam 
    298       !! 
    299       !! flags to help with calculating the position of the CCD 
    300       INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg 
    301       !! 
    302       !! ROAM air-sea flux and diagnostic parameters 
    303       REAL(wp) ::    f_wind 
    304       !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) 
    305       REAL(wp) ::    f_xco2a 
    306       REAL(wp) ::    f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux 
    307       REAL(wp) ::    f_TDIC, f_TALK, f_dcf, f_henry 
    308       REAL(wp) ::    f_uwind, f_vwind, f_pp0 
    309       REAL(wp) ::    f_kw660, f_o2flux, f_o2sat, f_o2sat3 
    310       REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg 
    311       !! 
    312       !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
    313       REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm 
    314       REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 
    315       !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s 
    316       REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol 
    317       REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d 
    318       REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day 
    319  
    320       !! 
    321       INTEGER  ::    iters 
    322       REAL(wp) ::    f_year 
    323       INTEGER  ::    i_year 
    324       INTEGER  ::    iyr1, iyr2 
    325       !! 
    326       !! carbon, alkalinity production and consumption 
    327       REAL(wp) ::    fc_prod, fc_cons, fa_prod, fa_cons 
    328       REAL(wp), DIMENSION(jpi,jpj) ::    fcomm_resp 
    329       REAL(wp), DIMENSION(jpi,jpj) ::    fcar_prod, fcar_cons 
    330       !! 
    331       !! oxygen production and consumption (and non-consumption) 
    332       REAL(wp) ::    fo2_prod, fo2_cons, fo2_ncons, fo2_ccons 
    333       REAL(wp), DIMENSION(jpi,jpj) ::    foxy_prod, foxy_cons, foxy_anox 
    334       !! Jpalm (11-08-2014) 
    335       !! add DMS in MEDUSA for UKESM1 model 
    336       REAL(wp) ::    dms_surf 
    337       !! AXY (13/03/15): add in other DMS calculations 
    338       REAL(wp) ::    dms_andr, dms_simo, dms_aran, dms_hall, dms_andm, dms_nlim, dms_wtkn 
    339  
    340 # endif 
    341       !!  
    342       !! benthic fluxes 
    343       INTEGER  ::    ibenthic 
    344       REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe,              f_sbenin_c 
    345       REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca 
    346       REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca 
    347       REAL(wp) ::    zfact 
    348       !!  
    349       !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline 
    350       REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca 
    351       !! 
    352       !! riverine fluxes 
    353       REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 
    354       !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface 
    355       REAL(wp) ::    f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 
    356       !! 
    357       !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 
    358       !! 2D var for diagnostics. 
    359       REAL(wp), POINTER, DIMENSION(:,:  ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d 
    360       REAL(wp), POINTER, DIMENSION(:,:  ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d 
    361       REAL(wp), POINTER, DIMENSION(:,:  ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d 
    362       REAL(wp), POINTER, DIMENSION(:,:  ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 
    363       REAL(wp), POINTER, DIMENSION(:,:  ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d 
    364       REAL(wp), POINTER, DIMENSION(:,:  ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d 
    365       REAL(wp), POINTER, DIMENSION(:,:  ) :: freminc2d, freminca2d 
    366       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    367 # if defined key_roam 
    368       REAL(wp), POINTER, DIMENSION(:,:  ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d 
    369       REAL(wp), POINTER, DIMENSION(:,:  ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d 
    370       REAL(wp), POINTER, DIMENSION(:,:  ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d 
    371       REAL(wp), POINTER, DIMENSION(:,:  ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d 
    372       REAL(wp), POINTER, DIMENSION(:,:  ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d 
    373       REAL(wp), POINTER, DIMENSION(:,:  ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d 
    374       REAL(wp), POINTER, DIMENSION(:,:  ) :: dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d, dms_andm2d, dms_surf2d 
    375       REAL(wp), POINTER, DIMENSION(:,:  ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d 
    376       REAL(wp), POINTER, DIMENSION(:,:  ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d 
    377       REAL(wp), POINTER, DIMENSION(:,:  ) :: sfr_oarg2d, lyso_ca2d  
    378       !! AXY (23/11/16): extra MOCSY diagnostics 
    379       REAL(wp), POINTER, DIMENSION(:,:  ) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d 
    380       REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnrhosw_2d, f_ocnschco2_2d, f_ocnkwco2_2d 
    381       REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnk0_2d, f_co2starair_2d, f_ocndpco2_2d 
    382 # endif 
    383       !! 
    384       !! 3D var for diagnostics. 
    385       REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn 
    386       !! 
    387 # if defined key_roam 
    388       !! AXY (04/11/16) 
    389       !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef for simplicity) 
    390       REAL(wp), POINTER, DIMENSION(:,:  ) :: fgco2, intdissic, intdissin, intdissisi, inttalk, o2min, zo2min 
    391       REAL(wp), POINTER, DIMENSION(:,:  ) :: fbddtalk, fbddtdic, fbddtdife, fbddtdin, fbddtdisi 
    392       !! 
    393       !! 3D var for new CMIP6 diagnostics 
    394       REAL(wp), POINTER, DIMENSION(:,:,:) :: tppd3 
    395       REAL(wp), POINTER, DIMENSION(:,:,:) :: bddtalk3, bddtdic3, bddtdife3, bddtdin3, bddtdisi3 
    396       REAL(wp), POINTER, DIMENSION(:,:,:) :: fd_nit3, fd_sil3, fd_car3, fd_cal3 
    397       REAL(wp), POINTER, DIMENSION(:,:,:) :: co33, co3satarag3, co3satcalc3, dcalc3 
    398       REAL(wp), POINTER, DIMENSION(:,:,:) :: expc3, expn3 
    399       REAL(wp), POINTER, DIMENSION(:,:,:) :: fediss3, fescav3 
    400       REAL(wp), POINTER, DIMENSION(:,:,:) :: migrazp3, migrazd3, megrazp3, megrazd3, megrazz3 
    401       REAL(wp), POINTER, DIMENSION(:,:,:) :: o2sat3, pbsi3, pcal3, remoc3 
    402       REAL(wp), POINTER, DIMENSION(:,:,:) :: pnlimj3, pnlimn3, pnlimfe3, pdlimj3, pdlimn3, pdlimfe3, pdlimsi3 
    403 # endif 
    404       !!--------------------------------------------------------------------- 
     178      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4 
     179      !! 
     180      !!------------------------------------------------------------------ 
    405181 
    406182# if defined key_debug_medusa 
     
    421197      ibenthic = 1 
    422198 
    423       !! not sure what this is for; it's not used anywhere; commenting out 
    424       !! fbodn(:,:) = 0.e0    
    425  
    426       !! 
    427       IF( ln_diatrc ) THEN 
    428          !! blank 2D diagnostic array 
    429          trc2d(:,:,:) = 0.e0 
    430          !! 
    431          !! blank 3D diagnostic array 
    432          trc3d(:,:,:,:) = 0.e0 
    433       ENDIF 
    434  
    435       !!---------------------------------------------------------------------- 
     199      !!------------------------------------------------------------------ 
    436200      !! b0 is present for debugging purposes; using b0 = 0 sets the tendency 
    437201      !! terms of all biological equations to 0. 
    438       !!---------------------------------------------------------------------- 
     202      !!------------------------------------------------------------------ 
    439203      !! 
    440204      !! AXY (03/09/14): probably not the smartest move ever, but it'll fit 
     
    446210      b0 = 1. 
    447211# endif 
    448       !!---------------------------------------------------------------------- 
     212      !!------------------------------------------------------------------ 
    449213      !! fast detritus ballast scheme (0 = no; 1 = yes) 
    450214      !! alternative to ballast scheme is same scheme but with no ballast 
    451215      !! protection (not dissimilar to Martin et al., 1987) 
    452       !!---------------------------------------------------------------------- 
     216      !!------------------------------------------------------------------ 
    453217      !! 
    454218      iball = 1 
    455219 
    456       !!---------------------------------------------------------------------- 
     220      !!------------------------------------------------------------------ 
    457221      !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output 
    458222      !! these should *only* be used in 1D since they give comprehensive 
    459223      !! output for ecological functions in the model; primarily used in 
    460224      !! debugging 
    461       !!---------------------------------------------------------------------- 
     225      !!------------------------------------------------------------------ 
    462226      !! 
    463227      idf    = 0 
     
    470234      endif 
    471235 
    472       !!---------------------------------------------------------------------- 
    473       !! blank fast-sinking detritus 2D fields 
    474       !!---------------------------------------------------------------------- 
    475       !! 
    476       ffastn(:,:)  = 0.0        !! organic nitrogen 
    477       ffastsi(:,:) = 0.0        !! biogenic silicon 
    478       ffastfe(:,:) = 0.0        !! organic iron 
    479       ffastc(:,:)  = 0.0        !! organic carbon 
    480       ffastca(:,:) = 0.0        !! biogenic calcium carbonate 
    481       !! 
    482       fsedn(:,:)   = 0.0        !! Seafloor flux of N  
    483       fsedsi(:,:)  = 0.0        !! Seafloor flux of Si 
    484       fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe 
    485       fsedc(:,:)   = 0.0        !! Seafloor flux of C 
    486       fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3 
    487       !! 
    488       fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus) 
    489       fregenfastsi(:,:) = 0.0   !! integrated Si regeneration (fast detritus) 
    490 # if defined key_roam 
    491       fregenfastc(:,:)  = 0.0   !! integrated  C regeneration (fast detritus) 
    492 # endif 
    493       !! 
    494       fccd(:,:)    = 0.0        !! last depth level before CCD 
    495  
    496       !!---------------------------------------------------------------------- 
    497       !! blank nutrient/flux inventories 
    498       !!---------------------------------------------------------------------- 
    499       !! 
    500       fflx_n(:,:)  = 0.0        !! nitrogen flux total 
    501       fflx_si(:,:) = 0.0        !! silicon  flux total 
    502       fflx_fe(:,:) = 0.0        !! iron     flux total 
    503       fifd_n(:,:)  = 0.0        !! nitrogen fast detritus production 
    504       fifd_si(:,:) = 0.0        !! silicon  fast detritus production 
    505       fifd_fe(:,:) = 0.0        !! iron     fast detritus production 
    506       fofd_n(:,:)  = 0.0        !! nitrogen fast detritus remineralisation 
    507       fofd_si(:,:) = 0.0        !! silicon  fast detritus remineralisation 
    508       fofd_fe(:,:) = 0.0        !! iron     fast detritus remineralisation 
    509 # if defined key_roam 
    510       fflx_c(:,:)  = 0.0        !! carbon     flux total 
    511       fflx_a(:,:)  = 0.0        !! alkalinity flux total 
    512       fflx_o2(:,:) = 0.0        !! oxygen     flux total 
    513       ftot_c(:,:)  = 0.0        !! carbon     inventory 
    514       ftot_a(:,:)  = 0.0        !! alkalinity inventory 
    515       ftot_o2(:,:) = 0.0        !! oxygen     inventory 
    516       fifd_c(:,:)  = 0.0        !! carbon     fast detritus production 
    517       fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production 
    518       fifd_o2(:,:) = 0.0        !! oxygen     fast detritus production 
    519       fofd_c(:,:)  = 0.0        !! carbon     fast detritus remineralisation 
    520       fofd_a(:,:)  = 0.0        !! alkalinity fast detritus remineralisation 
    521       fofd_o2(:,:) = 0.0        !! oxygen     fast detritus remineralisation 
    522       !! 
    523       fnit_prod(:,:) = 0.0      !! (organic)   nitrogen production 
    524       fnit_cons(:,:) = 0.0      !! (organic)   nitrogen consumption 
    525       fsil_prod(:,:) = 0.0      !! (inorganic) silicon production 
    526       fsil_cons(:,:) = 0.0      !! (inorganic) silicon consumption 
    527       fcar_prod(:,:) = 0.0      !! (organic)   carbon production 
    528       fcar_cons(:,:) = 0.0      !! (organic)   carbon consumption 
    529       !! 
    530       foxy_prod(:,:) = 0.0      !! oxygen production 
    531       foxy_cons(:,:) = 0.0      !! oxygen consumption 
    532       foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption 
    533       !! 
    534 # endif 
    535       ftot_n(:,:)   = 0.0       !! N inventory  
    536       ftot_si(:,:)  = 0.0       !! Si inventory 
    537       ftot_fe(:,:)  = 0.0       !! Fe inventory 
    538       ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton 
    539       ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton 
    540       ftot_zmi(:,:) = 0.0       !! integrated microzooplankton 
    541       ftot_zme(:,:) = 0.0       !! integrated mesozooplankton 
    542       ftot_det(:,:) = 0.0       !! integrated slow detritus, nitrogen 
    543       ftot_dtc(:,:) = 0.0       !! integrated slow detritus, carbon 
    544       !! 
    545       fzmi_i(:,:)  = 0.0        !! material grazed by microzooplankton 
    546       fzmi_o(:,:)  = 0.0        !! ... sum of fate of this material 
    547       fzme_i(:,:)  = 0.0        !! material grazed by  mesozooplankton 
    548       fzme_o(:,:)  = 0.0        !! ... sum of fate of this material 
    549       !! 
    550       f_sbenin_n(:,:)  = 0.0    !! slow detritus N  -> benthic pool 
    551       f_sbenin_fe(:,:) = 0.0    !! slow detritus Fe -> benthic pool 
    552       f_sbenin_c(:,:)  = 0.0    !! slow detritus C  -> benthic pool 
    553       f_fbenin_n(:,:)  = 0.0    !! fast detritus N  -> benthic pool 
    554       f_fbenin_fe(:,:) = 0.0    !! fast detritus Fe -> benthic pool 
    555       f_fbenin_si(:,:) = 0.0    !! fast detritus Si -> benthic pool 
    556       f_fbenin_c(:,:)  = 0.0    !! fast detritus C  -> benthic pool 
    557       f_fbenin_ca(:,:) = 0.0    !! fast detritus Ca -> benthic pool 
    558       !! 
    559       f_benout_n(:,:)  = 0.0    !! benthic N  pool  -> dissolved 
    560       f_benout_fe(:,:) = 0.0    !! benthic Fe pool  -> dissolved 
    561       f_benout_si(:,:) = 0.0    !! benthic Si pool  -> dissolved 
    562       f_benout_c(:,:)  = 0.0    !! benthic C  pool  -> dissolved 
    563       f_benout_ca(:,:) = 0.0    !! benthic Ca pool  -> dissolved 
    564       !! 
    565       f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool  -> dissolved (when it shouldn't!) 
    566       !! 
    567       f_runoff(:,:)  = 0.0      !! riverine runoff 
    568       f_riv_n(:,:)   = 0.0      !! riverine N   input  
    569       f_riv_si(:,:)  = 0.0      !! riverine Si  input  
    570       f_riv_c(:,:)   = 0.0      !! riverine C   input  
    571       f_riv_alk(:,:) = 0.0      !! riverine alk input  
    572       !!  
    573       !! Jpalm -- 06-03-2017 -- Forgotten var to init 
    574       f_omarg(:,:) = 0.0        !! 
    575       f_omcal(:,:) = 0.0  
    576       xFree(:,:) = 0.0          !! state variables for iron-ligand system 
    577       fcomm_resp(:,:) = 0.0  
    578       fprn_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
    579       fprd_ml(:,:) = 0.0        !! mixed layer PP diagnostics 
    580       !! 
    581       fslownflux(:,:) = 0.0 
    582       fslowcflux(:,:) = 0.0 
    583  
    584       !! 
    585       !! allocate and initiate 2D diag 
    586       !! ----------------------------- 
    587       !! Juju :: add kt condition !! 
    588       IF ( lk_iomput .AND. .NOT.  ln_diatrc ) THEN  
    589          !! 
    590          if ( kt == nittrc000 )   CALL trc_nam_iom_medusa !! initialise iom_use test 
    591          !! 
    592          CALL wrk_alloc( jpi, jpj,      zw2d ) 
    593          zw2d(:,:)      = 0.0   !! 
    594          IF ( med_diag%PRN%dgsave ) THEN 
    595             CALL wrk_alloc( jpi, jpj,   fprn2d    ) 
    596             fprn2d(:,:)      = 0.0 !! 
    597          ENDIF 
    598          IF ( med_diag%MPN%dgsave ) THEN 
    599             CALL wrk_alloc( jpi, jpj,   fdpn2d    ) 
    600             fdpn2d(:,:)      = 0.0 !! 
    601          ENDIF 
    602          IF ( med_diag%PRD%dgsave ) THEN 
    603             CALL wrk_alloc( jpi, jpj,   fprd2d    ) 
    604             fprd2d(:,:)      = 0.0 !! 
    605          ENDIF 
    606          IF( med_diag%MPD%dgsave ) THEN 
    607             CALL wrk_alloc( jpi, jpj,   fdpd2d    ) 
    608             fdpd2d(:,:)      = 0.0 !! 
    609          ENDIF 
    610          IF( med_diag%OPAL%dgsave ) THEN 
    611             CALL wrk_alloc( jpi, jpj,   fprds2d    ) 
    612             fprds2d(:,:)      = 0.0 !! 
    613          ENDIF 
    614          IF( med_diag%OPALDISS%dgsave ) THEN 
    615             CALL wrk_alloc( jpi, jpj,   fsdiss2d    ) 
    616             fsdiss2d(:,:)      = 0.0 !! 
    617          ENDIF 
    618          IF( med_diag%GMIPn%dgsave ) THEN 
    619             CALL wrk_alloc( jpi, jpj,   fgmipn2d    ) 
    620             fgmipn2d(:,:)      = 0.0 !! 
    621          ENDIF 
    622          IF( med_diag%GMID%dgsave ) THEN 
    623             CALL wrk_alloc( jpi, jpj,   fgmid2d    ) 
    624             fgmid2d(:,:)      = 0.0 !! 
    625          ENDIF 
    626          IF( med_diag%MZMI%dgsave ) THEN 
    627             CALL wrk_alloc( jpi, jpj,   fdzmi2d    ) 
    628             fdzmi2d(:,:)      = 0.0 !! 
    629          ENDIF 
    630          IF( med_diag%GMEPN%dgsave ) THEN 
    631             CALL wrk_alloc( jpi, jpj,   fgmepn2d    ) 
    632             fgmepn2d(:,:)      = 0.0 !! 
    633          ENDIF 
    634          IF( med_diag%GMEPD%dgsave ) THEN 
    635             CALL wrk_alloc( jpi, jpj,   fgmepd2d    ) 
    636             fgmepd2d(:,:)      = 0.0 !! 
    637          ENDIF 
    638          IF( med_diag%GMEZMI%dgsave ) THEN 
    639             CALL wrk_alloc( jpi, jpj,   fgmezmi2d    ) 
    640             fgmezmi2d(:,:)      = 0.0 !! 
    641          ENDIF 
    642          IF( med_diag%GMED%dgsave ) THEN 
    643             CALL wrk_alloc( jpi, jpj,   fgmed2d    ) 
    644             fgmed2d(:,:)      = 0.0 !! 
    645          ENDIF 
    646          IF( med_diag%MZME%dgsave ) THEN 
    647             CALL wrk_alloc( jpi, jpj,   fdzme2d    ) 
    648             fdzme2d(:,:)      = 0.0 !! 
    649          ENDIF 
    650          IF( med_diag%DETN%dgsave ) THEN 
    651             CALL wrk_alloc( jpi, jpj,   fslown2d    ) 
    652             fslown2d(:,:)      = 0.0 !! 
    653          ENDIF 
    654          IF( med_diag%MDET%dgsave ) THEN 
    655             CALL wrk_alloc( jpi, jpj,   fdd2d    ) 
    656             fdd2d(:,:)      = 0.0 !! 
    657          ENDIF       
    658          IF( med_diag%AEOLIAN%dgsave ) THEN 
    659             CALL wrk_alloc( jpi, jpj,   ffetop2d    ) 
    660             ffetop2d(:,:)      = 0.0 !! 
    661          ENDIF 
    662          IF( med_diag%BENTHIC%dgsave ) THEN 
    663             CALL wrk_alloc( jpi, jpj,    ffebot2d   ) 
    664             ffebot2d(:,:)      = 0.0 !! 
    665          ENDIF 
    666          IF( med_diag%SCAVENGE%dgsave ) THEN 
    667             CALL wrk_alloc( jpi, jpj,   ffescav2d    ) 
    668             ffescav2d(:,:)      = 0.0 !! 
    669          ENDIF 
    670          IF( med_diag%PN_JLIM%dgsave ) THEN 
    671             CALL wrk_alloc( jpi, jpj,   fjln2d    ) 
    672             fjln2d(:,:)      = 0.0 !! 
    673          ENDIF 
    674          IF( med_diag%PN_NLIM%dgsave ) THEN 
    675             CALL wrk_alloc( jpi, jpj,   fnln2d    ) 
    676             fnln2d(:,:)      = 0.0 !! 
    677          ENDIF 
    678          IF( med_diag%PN_FELIM%dgsave ) THEN 
    679             CALL wrk_alloc( jpi, jpj,   ffln2d    ) 
    680             ffln2d(:,:)      = 0.0 !! 
    681          ENDIF 
    682          IF( med_diag%PD_JLIM%dgsave ) THEN 
    683             CALL wrk_alloc( jpi, jpj,   fjld2d    ) 
    684             fjld2d(:,:)      = 0.0 !! 
    685          ENDIF 
    686          IF( med_diag%PD_NLIM%dgsave ) THEN 
    687             CALL wrk_alloc( jpi, jpj,   fnld2d    ) 
    688             fnld2d(:,:)      = 0.0 !! 
    689          ENDIF 
    690          IF( med_diag%PD_FELIM%dgsave ) THEN 
    691             CALL wrk_alloc( jpi, jpj,   ffld2d    ) 
    692             ffld2d(:,:)      = 0.0 !! 
    693          ENDIF 
    694          IF( med_diag%PD_SILIM%dgsave ) THEN 
    695             CALL wrk_alloc( jpi, jpj,   fsld2d2    ) 
    696             fsld2d2(:,:)      = 0.0 !! 
    697          ENDIF 
    698          IF( med_diag%PDSILIM2%dgsave ) THEN 
    699             CALL wrk_alloc( jpi, jpj,   fsld2d    ) 
    700             fsld2d(:,:)      = 0.0 !! 
    701          ENDIF 
    702 !! 
    703 !! skip SDT_XXXX diagnostics here 
    704 !! 
    705          IF( med_diag%TOTREG_N%dgsave ) THEN 
    706             CALL wrk_alloc( jpi, jpj,   fregen2d    ) 
    707             fregen2d(:,:)      = 0.0 !! 
    708          ENDIF 
    709          IF( med_diag%TOTRG_SI%dgsave ) THEN 
    710             CALL wrk_alloc( jpi, jpj,   fregensi2d    ) 
    711             fregensi2d(:,:)      = 0.0 !! 
    712          ENDIF 
    713 !! 
    714 !! skip REG_XXXX diagnostics here 
    715 !! 
    716          IF( med_diag%FASTN%dgsave ) THEN 
    717             CALL wrk_alloc( jpi, jpj,   ftempn2d    ) 
    718             ftempn2d(:,:)      = 0.0 !! 
    719          ENDIF 
    720          IF( med_diag%FASTSI%dgsave ) THEN 
    721             CALL wrk_alloc( jpi, jpj,   ftempsi2d    ) 
    722             ftempsi2d(:,:)      = 0.0 !! 
    723          ENDIF 
    724          IF( med_diag%FASTFE%dgsave ) THEN 
    725             CALL wrk_alloc( jpi, jpj,  ftempfe2d     ) 
    726             ftempfe2d(:,:)      = 0.0 !! 
    727          ENDIF 
    728          IF( med_diag%FASTC%dgsave ) THEN 
    729             CALL wrk_alloc( jpi, jpj,  ftempc2d     ) 
    730             ftempc2d(:,:)      = 0.0 !! 
    731          ENDIF 
    732          IF( med_diag%FASTCA%dgsave ) THEN 
    733             CALL wrk_alloc( jpi, jpj,   ftempca2d    ) 
    734             ftempca2d(:,:)      = 0.0 !! 
    735          ENDIF      
    736 !! 
    737 !! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here 
    738 !! 
    739          IF( med_diag%REMINN%dgsave ) THEN 
    740             CALL wrk_alloc( jpi, jpj,    freminn2d   ) 
    741             freminn2d(:,:)      = 0.0 !! 
    742          ENDIF 
    743          IF( med_diag%REMINSI%dgsave ) THEN 
    744             CALL wrk_alloc( jpi, jpj,    freminsi2d   ) 
    745             freminsi2d(:,:)      = 0.0 !! 
    746          ENDIF 
    747          IF( med_diag%REMINFE%dgsave ) THEN 
    748             CALL wrk_alloc( jpi, jpj,    freminfe2d   ) 
    749             freminfe2d(:,:)      = 0.0 !! 
    750          ENDIF 
    751          IF( med_diag%REMINC%dgsave ) THEN 
    752             CALL wrk_alloc( jpi, jpj,   freminc2d    ) 
    753             freminc2d(:,:)      = 0.0 !!  
    754          ENDIF 
    755          IF( med_diag%REMINCA%dgsave ) THEN 
    756             CALL wrk_alloc( jpi, jpj,   freminca2d    ) 
    757             freminca2d(:,:)      = 0.0 !! 
    758          ENDIF 
    759 # if defined key_roam 
    760 !! 
    761 !! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here 
    762 !! 
    763          IF( med_diag%RR_0100%dgsave ) THEN 
    764             CALL wrk_alloc( jpi, jpj,    ffastca2d   ) 
    765             ffastca2d(:,:)      = 0.0 !! 
    766          ENDIF 
    767  
    768          IF( med_diag%ATM_PCO2%dgsave ) THEN 
    769             CALL wrk_alloc( jpi, jpj,    f_pco2a2d   ) 
    770             f_pco2a2d(:,:)      = 0.0 !! 
    771          ENDIF 
    772 !! 
    773 !! skip OCN_PH diagnostic here 
    774 !! 
    775          IF( med_diag%OCN_PCO2%dgsave ) THEN 
    776             CALL wrk_alloc( jpi, jpj,    f_pco2w2d   ) 
    777             f_pco2w2d(:,:)      = 0.0 !! 
    778          ENDIF 
    779 !! 
    780 !! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here 
    781 !! 
    782          IF( med_diag%CO2FLUX%dgsave ) THEN 
    783             CALL wrk_alloc( jpi, jpj,   f_co2flux2d    ) 
    784             f_co2flux2d(:,:)      = 0.0 !! 
    785          ENDIF 
    786 !! 
    787 !! skip OM_XXX diagnostics here 
    788 !! 
    789          IF( med_diag%TCO2%dgsave ) THEN 
    790             CALL wrk_alloc( jpi, jpj,   f_TDIC2d    ) 
    791             f_TDIC2d(:,:)      = 0.0 !! 
    792          ENDIF 
    793          IF( med_diag%TALK%dgsave ) THEN 
    794             CALL wrk_alloc( jpi, jpj,    f_TALK2d   ) 
    795             f_TALK2d(:,:)      = 0.0 !! 
    796          ENDIF 
    797          IF( med_diag%KW660%dgsave ) THEN 
    798             CALL wrk_alloc( jpi, jpj,    f_kw6602d   ) 
    799             f_kw6602d(:,:)      = 0.0 !! 
    800          ENDIF 
    801          IF( med_diag%ATM_PP0%dgsave ) THEN 
    802             CALL wrk_alloc( jpi, jpj,    f_pp02d   ) 
    803             f_pp02d(:,:)      = 0.0 !! 
    804          ENDIF 
    805          IF( med_diag%O2FLUX%dgsave ) THEN 
    806             CALL wrk_alloc( jpi, jpj,   f_o2flux2d    ) 
    807             f_o2flux2d(:,:)      = 0.0 !! 
    808          ENDIF 
    809          IF( med_diag%O2SAT%dgsave ) THEN 
    810             CALL wrk_alloc( jpi, jpj,    f_o2sat2d   ) 
    811             f_o2sat2d(:,:)      = 0.0 !! 
    812          ENDIF  
    813 !! 
    814 !! skip XXX_CCD diagnostics here 
    815 !!  
    816          IF( med_diag%SFR_OCAL%dgsave ) THEN 
    817             CALL wrk_alloc( jpi, jpj,    sfr_ocal2d  ) 
    818             sfr_ocal2d(:,:)      = 0.0 !! 
    819          ENDIF 
    820          IF( med_diag%SFR_OARG%dgsave ) THEN 
    821             CALL wrk_alloc( jpi, jpj,    sfr_oarg2d  ) 
    822             sfr_oarg2d(:,:)      = 0.0 !! 
    823          ENDIF 
    824 !! 
    825 !! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here 
    826 !!  
    827          IF( med_diag%IBEN_N%dgsave ) THEN 
    828             CALL wrk_alloc( jpi, jpj,    iben_n2d  ) 
    829             iben_n2d(:,:)      = 0.0 !! 
    830          ENDIF 
    831          IF( med_diag%IBEN_FE%dgsave ) THEN 
    832             CALL wrk_alloc( jpi, jpj,   iben_fe2d   ) 
    833             iben_fe2d(:,:)      = 0.0 !! 
    834          ENDIF 
    835          IF( med_diag%IBEN_C%dgsave ) THEN 
    836             CALL wrk_alloc( jpi, jpj,   iben_c2d   ) 
    837             iben_c2d(:,:)      = 0.0 !! 
    838          ENDIF 
    839          IF( med_diag%IBEN_SI%dgsave ) THEN 
    840             CALL wrk_alloc( jpi, jpj,   iben_si2d   ) 
    841             iben_si2d(:,:)      = 0.0 !! 
    842          ENDIF 
    843          IF( med_diag%IBEN_CA%dgsave ) THEN 
    844             CALL wrk_alloc( jpi, jpj,   iben_ca2d   ) 
    845             iben_ca2d(:,:)      = 0.0 !! 
    846          ENDIF 
    847          IF( med_diag%OBEN_N%dgsave ) THEN 
    848             CALL wrk_alloc( jpi, jpj,    oben_n2d  ) 
    849             oben_n2d(:,:)      = 0.0 !! 
    850          ENDIF 
    851          IF( med_diag%OBEN_FE%dgsave ) THEN 
    852             CALL wrk_alloc( jpi, jpj,    oben_fe2d  ) 
    853             oben_fe2d(:,:)      = 0.0 !! 
    854          ENDIF 
    855          IF( med_diag%OBEN_C%dgsave ) THEN 
    856             CALL wrk_alloc( jpi, jpj,    oben_c2d  ) 
    857             oben_c2d(:,:)      = 0.0 !! 
    858          ENDIF 
    859          IF( med_diag%OBEN_SI%dgsave ) THEN 
    860             CALL wrk_alloc( jpi, jpj,    oben_si2d  ) 
    861             oben_si2d(:,:)      = 0.0 !! 
    862          ENDIF 
    863          IF( med_diag%OBEN_CA%dgsave ) THEN 
    864             CALL wrk_alloc( jpi, jpj,    oben_ca2d  ) 
    865             oben_ca2d(:,:)      = 0.0 !! 
    866          ENDIF 
    867 !! 
    868 !! skip BEN_XX diagnostics here 
    869 !! 
    870          IF( med_diag%RIV_N%dgsave ) THEN 
    871             CALL wrk_alloc( jpi, jpj,    rivn2d   ) 
    872             rivn2d(:,:)      = 0.0 !! 
    873          ENDIF 
    874          IF( med_diag%RIV_SI%dgsave ) THEN 
    875             CALL wrk_alloc( jpi, jpj,    rivsi2d   ) 
    876             rivsi2d(:,:)      = 0.0 !! 
    877          ENDIF 
    878          IF( med_diag%RIV_C%dgsave ) THEN 
    879             CALL wrk_alloc( jpi, jpj,   rivc2d    ) 
    880             rivc2d(:,:)      = 0.0 !! 
    881          ENDIF 
    882          IF( med_diag%RIV_ALK%dgsave ) THEN 
    883             CALL wrk_alloc( jpi, jpj,    rivalk2d   ) 
    884             rivalk2d(:,:)      = 0.0 !! 
    885          ENDIF 
    886          IF( med_diag%DETC%dgsave ) THEN 
    887             CALL wrk_alloc( jpi, jpj,    fslowc2d   ) 
    888             fslowc2d(:,:)      = 0.0 !! 
    889          ENDIF  
    890 !! 
    891 !! skip SDC_XXXX, INVTXXX diagnostics here 
    892 !! 
    893          IF( med_diag%LYSO_CA%dgsave ) THEN 
    894             CALL wrk_alloc( jpi, jpj,    lyso_ca2d  ) 
    895             lyso_ca2d(:,:)      = 0.0 !! 
    896          ENDIF 
    897 !! 
    898 !! skip COM_RESP diagnostic here 
    899 !! 
    900          IF( med_diag%PN_LLOSS%dgsave ) THEN 
    901             CALL wrk_alloc( jpi, jpj,    fdpn22d   ) 
    902             fdpn22d(:,:)      = 0.0 !! 
    903          ENDIF 
    904          IF( med_diag%PD_LLOSS%dgsave ) THEN 
    905             CALL wrk_alloc( jpi, jpj,    fdpd22d   ) 
    906             fdpd22d(:,:)      = 0.0 !! 
    907          ENDIF 
    908          IF( med_diag%ZI_LLOSS%dgsave ) THEN 
    909             CALL wrk_alloc( jpi, jpj,    fdzmi22d   ) 
    910             fdzmi22d(:,:)      = 0.0 !! 
    911          ENDIF 
    912          IF( med_diag%ZE_LLOSS%dgsave ) THEN 
    913             CALL wrk_alloc( jpi, jpj,   fdzme22d    ) 
    914             fdzme22d(:,:)      = 0.0 !! 
    915          ENDIF 
    916          IF( med_diag%ZI_MES_N%dgsave ) THEN    
    917             CALL wrk_alloc( jpi, jpj,   zimesn2d    ) 
    918             zimesn2d(:,:)      = 0.0 !! 
    919          ENDIF 
    920          IF( med_diag%ZI_MES_D%dgsave ) THEN 
    921             CALL wrk_alloc( jpi, jpj,    zimesd2d   ) 
    922             zimesd2d(:,:)      = 0.0 !! 
    923          ENDIF 
    924          IF( med_diag%ZI_MES_C%dgsave ) THEN 
    925             CALL wrk_alloc( jpi, jpj,    zimesc2d   ) 
    926             zimesc2d(:,:)      = 0.0 !! 
    927          ENDIF 
    928          IF( med_diag%ZI_MESDC%dgsave ) THEN 
    929             CALL wrk_alloc( jpi, jpj,    zimesdc2d   ) 
    930             zimesdc2d(:,:)      = 0.0 !! 
    931          ENDIF 
    932          IF( med_diag%ZI_EXCR%dgsave ) THEN 
    933             CALL wrk_alloc( jpi, jpj,     ziexcr2d  ) 
    934             ziexcr2d(:,:)      = 0.0 !! 
    935          ENDIF 
    936          IF( med_diag%ZI_RESP%dgsave ) THEN 
    937             CALL wrk_alloc( jpi, jpj,    ziresp2d   ) 
    938             ziresp2d(:,:)      = 0.0 !! 
    939          ENDIF 
    940          IF( med_diag%ZI_GROW%dgsave ) THEN 
    941             CALL wrk_alloc( jpi, jpj,    zigrow2d   ) 
    942             zigrow2d(:,:)      = 0.0 !! 
    943          ENDIF 
    944          IF( med_diag%ZE_MES_N%dgsave ) THEN 
    945             CALL wrk_alloc( jpi, jpj,   zemesn2d    ) 
    946             zemesn2d(:,:)      = 0.0 !! 
    947          ENDIF 
    948          IF( med_diag%ZE_MES_D%dgsave ) THEN 
    949             CALL wrk_alloc( jpi, jpj,    zemesd2d   ) 
    950             zemesd2d(:,:)      = 0.0 !! 
    951          ENDIF 
    952          IF( med_diag%ZE_MES_C%dgsave ) THEN 
    953             CALL wrk_alloc( jpi, jpj,    zemesc2d   ) 
    954             zemesc2d(:,:)      = 0.0 !! 
    955          ENDIF 
    956          IF( med_diag%ZE_MESDC%dgsave ) THEN 
    957             CALL wrk_alloc( jpi, jpj,    zemesdc2d   ) 
    958             zemesdc2d(:,:)      = 0.0 !! 
    959          ENDIF 
    960          IF( med_diag%ZE_EXCR%dgsave ) THEN 
    961             CALL wrk_alloc( jpi, jpj,    zeexcr2d   ) 
    962             zeexcr2d(:,:)      = 0.0 !! 
    963          ENDIF                   
    964          IF( med_diag%ZE_RESP%dgsave ) THEN 
    965             CALL wrk_alloc( jpi, jpj,    zeresp2d   ) 
    966             zeresp2d(:,:)      = 0.0 !! 
    967          ENDIF 
    968          IF( med_diag%ZE_GROW%dgsave ) THEN 
    969             CALL wrk_alloc( jpi, jpj,    zegrow2d   ) 
    970             zegrow2d(:,:)      = 0.0 !! 
    971          ENDIF 
    972          IF( med_diag%MDETC%dgsave ) THEN 
    973             CALL wrk_alloc( jpi, jpj,   mdetc2d    ) 
    974             mdetc2d(:,:)      = 0.0 !! 
    975          ENDIF 
    976          IF( med_diag%GMIDC%dgsave ) THEN 
    977             CALL wrk_alloc( jpi, jpj,    gmidc2d   ) 
    978             gmidc2d(:,:)      = 0.0 !! 
    979          ENDIF 
    980          IF( med_diag%GMEDC%dgsave ) THEN 
    981             CALL wrk_alloc( jpi, jpj,    gmedc2d   ) 
    982             gmedc2d(:,:)      = 0.0 !! 
    983          ENDIF 
    984 !! 
    985 !! skip INT_XXX diagnostics here 
    986 !! 
    987          IF (jdms .eq. 1) THEN 
    988             IF( med_diag%DMS_SURF%dgsave ) THEN 
    989                CALL wrk_alloc( jpi, jpj,   dms_surf2d    ) 
    990                dms_surf2d(:,:)      = 0.0 !! 
    991             ENDIF 
    992             IF( med_diag%DMS_ANDR%dgsave ) THEN 
    993                CALL wrk_alloc( jpi, jpj,   dms_andr2d    ) 
    994                dms_andr2d(:,:)      = 0.0 !! 
    995             ENDIF 
    996             IF( med_diag%DMS_SIMO%dgsave ) THEN 
    997                CALL wrk_alloc( jpi, jpj,  dms_simo2d     ) 
    998                dms_simo2d(:,:)      = 0.0 !! 
    999             ENDIF 
    1000             IF( med_diag%DMS_ARAN%dgsave ) THEN 
    1001                CALL wrk_alloc( jpi, jpj,   dms_aran2d    ) 
    1002                dms_aran2d(:,:)      = 0.0 !! 
    1003             ENDIF 
    1004             IF( med_diag%DMS_HALL%dgsave ) THEN 
    1005                CALL wrk_alloc( jpi, jpj,   dms_hall2d    ) 
    1006                dms_hall2d(:,:)      = 0.0 !! 
    1007             ENDIF 
    1008             IF( med_diag%DMS_ANDM%dgsave ) THEN 
    1009                CALL wrk_alloc( jpi, jpj,   dms_andm2d    ) 
    1010                dms_andm2d(:,:)      = 0.0 !! 
    1011             ENDIF 
    1012          ENDIF    
    1013          !! 
    1014          !! AXY (24/11/16): extra MOCSY diagnostics, 2D 
    1015          IF( med_diag%ATM_XCO2%dgsave ) THEN 
    1016             CALL wrk_alloc( jpi, jpj, f_xco2a_2d      ) 
    1017             f_xco2a_2d(:,:)      = 0.0 !! 
    1018          ENDIF 
    1019          IF( med_diag%OCN_FCO2%dgsave ) THEN 
    1020             CALL wrk_alloc( jpi, jpj, f_fco2w_2d      ) 
    1021             f_fco2w_2d(:,:)      = 0.0 !! 
    1022          ENDIF 
    1023          IF( med_diag%ATM_FCO2%dgsave ) THEN 
    1024             CALL wrk_alloc( jpi, jpj, f_fco2a_2d      ) 
    1025             f_fco2a_2d(:,:)      = 0.0 !! 
    1026          ENDIF 
    1027          IF( med_diag%OCN_RHOSW%dgsave ) THEN 
    1028             CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d   ) 
    1029             f_ocnrhosw_2d(:,:)      = 0.0 !! 
    1030          ENDIF 
    1031          IF( med_diag%OCN_SCHCO2%dgsave ) THEN 
    1032             CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d  ) 
    1033             f_ocnschco2_2d(:,:)      = 0.0 !! 
    1034          ENDIF 
    1035          IF( med_diag%OCN_KWCO2%dgsave ) THEN 
    1036             CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d   ) 
    1037             f_ocnkwco2_2d(:,:)      = 0.0 !! 
    1038          ENDIF 
    1039          IF( med_diag%OCN_K0%dgsave ) THEN 
    1040             CALL wrk_alloc( jpi, jpj, f_ocnk0_2d      ) 
    1041             f_ocnk0_2d(:,:)      = 0.0 !! 
    1042          ENDIF 
    1043          IF( med_diag%CO2STARAIR%dgsave ) THEN 
    1044             CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) 
    1045             f_co2starair_2d(:,:)      = 0.0 !! 
    1046          ENDIF 
    1047          IF( med_diag%OCN_DPCO2%dgsave ) THEN 
    1048             CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d   ) 
    1049             f_ocndpco2_2d(:,:)      = 0.0 !! 
    1050          ENDIF 
    1051 # endif   
    1052          IF( med_diag%TPP3%dgsave ) THEN 
    1053             CALL wrk_alloc( jpi, jpj, jpk,       tpp3d ) 
    1054             tpp3d(:,:,:)      = 0.0 !!  
    1055          ENDIF 
    1056          IF( med_diag%DETFLUX3%dgsave ) THEN 
    1057             CALL wrk_alloc( jpi, jpj, jpk,        detflux3d ) 
    1058             detflux3d(:,:,:)      = 0.0 !!  
    1059          ENDIF 
    1060          IF( med_diag%REMIN3N%dgsave ) THEN 
    1061              CALL wrk_alloc( jpi, jpj, jpk,        remin3dn ) 
    1062              remin3dn(:,:,:)      = 0.0 !!  
    1063           ENDIF 
    1064           !!  
    1065           !! AXY (10/11/16): CMIP6 diagnostics, 2D 
    1066           !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request 
    1067           !!                   needed for coupling/passed through restart 
    1068           !! IF( med_diag%FGCO2%dgsave ) THEN 
    1069              CALL wrk_alloc( jpi, jpj,   fgco2    ) 
    1070              fgco2(:,:)      = 0.0 !! 
    1071           !! ENDIF 
    1072           IF( med_diag%INTDISSIC%dgsave ) THEN 
    1073              CALL wrk_alloc( jpi, jpj,   intdissic    ) 
    1074              intdissic(:,:)  = 0.0 !! 
    1075           ENDIF           
    1076           IF( med_diag%INTDISSIN%dgsave ) THEN 
    1077              CALL wrk_alloc( jpi, jpj,   intdissin    ) 
    1078              intdissin(:,:)  = 0.0 !! 
    1079           ENDIF           
    1080           IF( med_diag%INTDISSISI%dgsave ) THEN 
    1081              CALL wrk_alloc( jpi, jpj,   intdissisi    ) 
    1082              intdissisi(:,:)  = 0.0 !! 
    1083           ENDIF           
    1084           IF( med_diag%INTTALK%dgsave ) THEN 
    1085              CALL wrk_alloc( jpi, jpj,   inttalk    ) 
    1086              inttalk(:,:)  = 0.0 !! 
    1087           ENDIF           
    1088           IF( med_diag%O2min%dgsave ) THEN 
    1089              CALL wrk_alloc( jpi, jpj,   o2min    ) 
    1090              o2min(:,:)  = 1.e3 !! set to high value as we're looking for min(o2) 
    1091           ENDIF           
    1092           IF( med_diag%ZO2min%dgsave ) THEN 
    1093              CALL wrk_alloc( jpi, jpj,   zo2min    ) 
    1094              zo2min(:,:)  = 0.0 !! 
    1095           ENDIF           
    1096           IF( med_diag%FBDDTALK%dgsave  ) THEN 
    1097              CALL wrk_alloc( jpi, jpj, fbddtalk  ) 
    1098              fbddtalk(:,:)  = 0.0 !!  
    1099           ENDIF 
    1100           IF( med_diag%FBDDTDIC%dgsave  ) THEN 
    1101              CALL wrk_alloc( jpi, jpj, fbddtdic  ) 
    1102              fbddtdic(:,:)  = 0.0 !!  
    1103           ENDIF 
    1104           IF( med_diag%FBDDTDIFE%dgsave ) THEN 
    1105              CALL wrk_alloc( jpi, jpj, fbddtdife ) 
    1106              fbddtdife(:,:) = 0.0 !!  
    1107           ENDIF 
    1108           IF( med_diag%FBDDTDIN%dgsave  ) THEN 
    1109              CALL wrk_alloc( jpi, jpj, fbddtdin  ) 
    1110              fbddtdin(:,:)  = 0.0 !!  
    1111           ENDIF 
    1112           IF( med_diag%FBDDTDISI%dgsave ) THEN 
    1113              CALL wrk_alloc( jpi, jpj, fbddtdisi ) 
    1114              fbddtdisi(:,:) = 0.0 !!  
    1115           ENDIF 
    1116           !!  
    1117           !! AXY (10/11/16): CMIP6 diagnostics, 3D 
    1118           IF( med_diag%TPPD3%dgsave     ) THEN 
    1119              CALL wrk_alloc( jpi, jpj, jpk, tppd3     ) 
    1120              tppd3(:,:,:)     = 0.0 !!  
    1121           ENDIF 
    1122           IF( med_diag%BDDTALK3%dgsave  ) THEN 
    1123              CALL wrk_alloc( jpi, jpj, jpk, bddtalk3  ) 
    1124              bddtalk3(:,:,:)  = 0.0 !!  
    1125           ENDIF 
    1126           IF( med_diag%BDDTDIC3%dgsave  ) THEN 
    1127              CALL wrk_alloc( jpi, jpj, jpk, bddtdic3  ) 
    1128              bddtdic3(:,:,:)  = 0.0 !!  
    1129           ENDIF 
    1130           IF( med_diag%BDDTDIFE3%dgsave ) THEN 
    1131              CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) 
    1132              bddtdife3(:,:,:) = 0.0 !!  
    1133           ENDIF 
    1134           IF( med_diag%BDDTDIN3%dgsave  ) THEN 
    1135              CALL wrk_alloc( jpi, jpj, jpk, bddtdin3  ) 
    1136              bddtdin3(:,:,:)  = 0.0 !!  
    1137           ENDIF 
    1138           IF( med_diag%BDDTDISI3%dgsave ) THEN 
    1139              CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) 
    1140              bddtdisi3(:,:,:) = 0.0 !!  
    1141           ENDIF 
    1142           IF( med_diag%FD_NIT3%dgsave   ) THEN 
    1143              CALL wrk_alloc( jpi, jpj, jpk, fd_nit3   ) 
    1144              fd_nit3(:,:,:)   = 0.0 !!  
    1145           ENDIF 
    1146           IF( med_diag%FD_SIL3%dgsave   ) THEN 
    1147              CALL wrk_alloc( jpi, jpj, jpk, fd_sil3   ) 
    1148              fd_sil3(:,:,:)   = 0.0 !!  
    1149           ENDIF 
    1150           IF( med_diag%FD_CAR3%dgsave   ) THEN 
    1151              CALL wrk_alloc( jpi, jpj, jpk, fd_car3   ) 
    1152              fd_car3(:,:,:)   = 0.0 !!  
    1153           ENDIF 
    1154           IF( med_diag%FD_CAL3%dgsave   ) THEN 
    1155              CALL wrk_alloc( jpi, jpj, jpk, fd_cal3   ) 
    1156              fd_cal3(:,:,:)   = 0.0 !!  
    1157           ENDIF 
    1158           IF( med_diag%DCALC3%dgsave    ) THEN 
    1159              CALL wrk_alloc( jpi, jpj, jpk, dcalc3    ) 
    1160              dcalc3(:,:,: )   = 0.0 !!  
    1161           ENDIF 
    1162           IF( med_diag%EXPC3%dgsave     ) THEN 
    1163              CALL wrk_alloc( jpi, jpj, jpk, expc3   ) 
    1164              expc3(:,:,: )    = 0.0 !!  
    1165           ENDIF 
    1166           IF( med_diag%EXPN3%dgsave     ) THEN 
    1167              CALL wrk_alloc( jpi, jpj, jpk, expn3   ) 
    1168              expn3(:,:,: )    = 0.0 !!  
    1169           ENDIF 
    1170           IF( med_diag%FEDISS3%dgsave   ) THEN 
    1171              CALL wrk_alloc( jpi, jpj, jpk, fediss3   ) 
    1172              fediss3(:,:,: )  = 0.0 !!  
    1173           ENDIF 
    1174           IF( med_diag%FESCAV3%dgsave   ) THEN 
    1175              CALL wrk_alloc( jpi, jpj, jpk, fescav3   ) 
    1176              fescav3(:,:,: )  = 0.0 !!  
    1177           ENDIF 
    1178           IF( med_diag%MIGRAZP3%dgsave   ) THEN 
    1179              CALL wrk_alloc( jpi, jpj, jpk, migrazp3  ) 
    1180              migrazp3(:,:,: )  = 0.0 !!  
    1181           ENDIF 
    1182           IF( med_diag%MIGRAZD3%dgsave   ) THEN 
    1183              CALL wrk_alloc( jpi, jpj, jpk, migrazd3  ) 
    1184              migrazd3(:,:,: )  = 0.0 !!  
    1185           ENDIF 
    1186           IF( med_diag%MEGRAZP3%dgsave   ) THEN 
    1187              CALL wrk_alloc( jpi, jpj, jpk, megrazp3  ) 
    1188              megrazp3(:,:,: )  = 0.0 !!  
    1189           ENDIF 
    1190           IF( med_diag%MEGRAZD3%dgsave   ) THEN 
    1191              CALL wrk_alloc( jpi, jpj, jpk, megrazd3  ) 
    1192              megrazd3(:,:,: )  = 0.0 !!  
    1193           ENDIF 
    1194           IF( med_diag%MEGRAZZ3%dgsave   ) THEN 
    1195              CALL wrk_alloc( jpi, jpj, jpk, megrazz3  ) 
    1196              megrazz3(:,:,: )  = 0.0 !!  
    1197           ENDIF 
    1198           IF( med_diag%O2SAT3%dgsave     ) THEN 
    1199              CALL wrk_alloc( jpi, jpj, jpk, o2sat3    ) 
    1200              o2sat3(:,:,: )    = 0.0 !!  
    1201           ENDIF 
    1202           IF( med_diag%PBSI3%dgsave      ) THEN 
    1203              CALL wrk_alloc( jpi, jpj, jpk, pbsi3     ) 
    1204              pbsi3(:,:,: )     = 0.0 !!  
    1205           ENDIF 
    1206           IF( med_diag%PCAL3%dgsave      ) THEN 
    1207              CALL wrk_alloc( jpi, jpj, jpk, pcal3     ) 
    1208              pcal3(:,:,: )     = 0.0 !!  
    1209           ENDIF 
    1210           IF( med_diag%REMOC3%dgsave     ) THEN 
    1211              CALL wrk_alloc( jpi, jpj, jpk, remoc3    ) 
    1212              remoc3(:,:,: )    = 0.0 !!  
    1213           ENDIF 
    1214           IF( med_diag%PNLIMJ3%dgsave    ) THEN 
    1215              CALL wrk_alloc( jpi, jpj, jpk, pnlimj3   ) 
    1216              pnlimj3(:,:,: )   = 0.0 !!  
    1217           ENDIF 
    1218           IF( med_diag%PNLIMN3%dgsave    ) THEN 
    1219              CALL wrk_alloc( jpi, jpj, jpk, pnlimn3   ) 
    1220              pnlimn3(:,:,: )   = 0.0 !!  
    1221           ENDIF 
    1222           IF( med_diag%PNLIMFE3%dgsave   ) THEN 
    1223              CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3  ) 
    1224              pnlimfe3(:,:,: )  = 0.0 !!  
    1225           ENDIF 
    1226           IF( med_diag%PDLIMJ3%dgsave    ) THEN 
    1227              CALL wrk_alloc( jpi, jpj, jpk, pdlimj3   ) 
    1228              pdlimj3(:,:,: )   = 0.0 !!  
    1229           ENDIF 
    1230           IF( med_diag%PDLIMN3%dgsave    ) THEN 
    1231              CALL wrk_alloc( jpi, jpj, jpk, pdlimn3   ) 
    1232              pdlimn3(:,:,: )   = 0.0 !!  
    1233           ENDIF 
    1234           IF( med_diag%PDLIMFE3%dgsave   ) THEN 
    1235              CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3  ) 
    1236              pdlimfe3(:,:,: )  = 0.0 !!  
    1237           ENDIF 
    1238           IF( med_diag%PDLIMSI3%dgsave   ) THEN 
    1239              CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3  ) 
    1240              pdlimsi3(:,:,: )  = 0.0 !!  
    1241           ENDIF 
    1242  
    1243        ENDIF 
    1244        !! lk_iomput                                    
    1245        !! 
     236      !!------------------------------------------------------------------ 
     237      !! Initialise arrays to zero and set up arrays for diagnostics 
     238      !!------------------------------------------------------------------ 
     239      CALL bio_medusa_init( kt ) 
     240 
    1246241# if defined key_axy_nancheck 
    1247        DO jn = 1,jptra 
     242       DO jn = jp_msa0,jp_msa1 
    1248243          !! fq0 = MINVAL(trn(:,:,:,jn)) 
    1249244          !! fq1 = MAXVAL(trn(:,:,:,jn)) 
    1250245          fq2 = SUM(trn(:,:,:,jn)) 
    1251           !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK', & 
    1252           !! &        kt, jn, fq0, fq1, fq2 
    1253           !! AXY (30/01/14): much to our surprise, the next line doesn't work on HECTOR 
    1254           !!                 and has been replaced here with a specialist routine 
     246          !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK',     & 
     247          !!                kt, jn, fq0, fq1, fq2 
     248          !! AXY (30/01/14): much to our surprise, the next line doesn't  
     249          !!                 work on HECTOR and has been replaced here with  
     250          !!                 a specialist routine 
    1255251          !! if (fq2 /= fq2 ) then 
    1256252          if ( ieee_is_nan( fq2 ) ) then 
    1257253             !! there's a NaN here 
    1258              if (lwp) write(numout,*) 'NAN detected in field', jn, 'at time', kt, 'at position:' 
     254             if (lwp) write(numout,*) 'NAN detected in field', jn,           & 
     255                                      'at time', kt, 'at position:' 
    1259256             DO jk = 1,jpk 
    1260257                DO jj = 1,jpj 
     
    1263260                      !! if (trn(ji,jj,jk,jn) /= trn(ji,jj,jk,jn)) then 
    1264261                      if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then 
    1265                          if (lwp) write (numout,'(a,1pe12.2,4i6)') 'NAN-CHECK', & 
    1266                          &        tmask(ji,jj,jk), ji, jj, jk, jn 
     262                         if (lwp) write (numout,'(a,1pe12.2,4i6)')           & 
     263                            'NAN-CHECK', tmask(ji,jj,jk), ji, jj, jk, jn 
    1267264                      endif 
    1268265                   enddo 
     
    1276273 
    1277274# if defined key_debug_medusa 
    1278       IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked' 
     275      IF (lwp) write (numout,*)                                              & 
     276                     'trc_bio_medusa: variables initialised and checked' 
    1279277      CALL flush(numout) 
    1280278# endif  
    1281279 
    1282280# if defined key_roam 
    1283       !!---------------------------------------------------------------------- 
     281      !!------------------------------------------------------------------ 
    1284282      !! calculate atmospheric pCO2 
    1285       !!---------------------------------------------------------------------- 
     283      !!------------------------------------------------------------------ 
    1286284      !! 
    1287285      !! what's atmospheric pCO2 doing? (data start in 1859) 
     
    1290288      if (iyr1 .le. 1) then 
    1291289         !! before 1860 
    1292          f_xco2a = hist_pco2(1) 
     290         f_xco2a(:,:) = hist_pco2(1) 
    1293291      elseif (iyr2 .ge. 242) then 
    1294292         !! after 2099 
    1295          f_xco2a = hist_pco2(242) 
     293         f_xco2a(:,:) = hist_pco2(242) 
    1296294      else 
    1297295         !! just right 
     
    1301299         !! AXY (14/06/12): tweaked to make more sense (and be correct) 
    1302300#  if defined key_bs_axy_yrlen 
    1303          fq3 = (real(nday_year) - 1.0 + fq2) / 360.0  !! bugfix: for 360d year with HadGEM2-ES forcing 
     301         !! bugfix: for 360d year with HadGEM2-ES forcing 
     302         fq3 = (real(nday_year) - 1.0 + fq2) / 360.0   
    1304303#  else 
    1305          fq3 = (real(nday_year) - 1.0 + fq2) / 365.0  !! original use of 365 days (not accounting for leap year or 360d year) 
     304         !! original use of 365 days (not accounting for leap year or  
     305         !! 360d year) 
     306         fq3 = (real(nday_year) - 1.0 + fq2) / 365.0 
    1306307#  endif 
    1307308         fq4 = (fq0 * (1.0 - fq3)) + (fq1 * fq3) 
    1308          f_xco2a = fq4 
     309         f_xco2a(:,:) = fq4 
    1309310      endif 
    1310311#  if defined key_axy_pi_co2 
    1311       !! f_xco2a = 284.725       !! CMIP5 pre-industrial pCO2 
    1312       f_xco2a = 284.317          !! CMIP6 pre-industrial pCO2 
     312      !! OCMIP pre-industrial pCO2 
     313      !! f_xco2a(:,:) = 284.725  !! CMIP5 pre-industrial pCO2 
     314      f_xco2a = 284.317          !! CMIP6 pre-industrial pCO2  
    1313315#  endif 
    1314316      !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear     =', nyear 
     
    1320322      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq2       =', fq2 
    1321323      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq3       =', fq3 
    1322       IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  =', f_xco2a 
     324      IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  =', f_xco2a(1,1) 
    1323325# endif 
    1324326 
     
    1338340      !!============================= 
    1339341      !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : 
    1340       !!          we don't want to call on the first time-step of all run submission,  
    1341       !!          but only on the very first time-step, and then every month 
    1342       !!          So we call on nittrc000 if not restarted run,  
    1343       !!          else if one month after last call. 
    1344       !!          assume one month is 30d --> 3600*24*30 : 2592000s 
    1345       !!          try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt)    
     342      !!          we don't want to call on the first time-step of all run  
     343      !!          submission, but only on the very first time-step, and  
     344      !!          then every month. So we call on nittrc000 if not  
     345      !!          restarted run, else if one month after last call. 
     346      !!          Assume one month is 30d --> 3600*24*30 : 2592000s 
     347      !!          try to call carb-chem at 1st month's tm-stp :  
     348      !!          x * 30d + 1*rdt(i.e: mod = rdt)    
    1346349      !!          ++ need to pass carb-chem output var through restarts 
    1347       !! We want this to be start of month or if starting afresh from  
    1348       !! climatology - marc 20/6/17 
    1349350      If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        & 
    1350351           ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 
    1351          !!---------------------------------------------------------------------- 
     352         !!--------------------------------------------------------------- 
    1352353         !! Calculate the carbonate chemistry for the whole ocean on the first 
    1353354         !! simulation timestep and every month subsequently; the resulting 3D 
    1354355         !! field of omega calcite is used to determine the depth of the CCD 
    1355          !!---------------------------------------------------------------------- 
    1356          !! 
    1357          IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt 
    1358          CALL flush(numout) 
    1359          !! blank flags 
    1360          i2_omcal(:,:) = 0 
    1361          i2_omarg(:,:) = 0 
    1362          !! loop over 3D space 
    1363          DO jk = 1,jpk 
    1364             DO jj = 2,jpjm1 
    1365                DO ji = 2,jpim1 
    1366                   !! OPEN wet point IF..THEN loop 
    1367                   if (tmask(ji,jj,jk).eq.1) then 
    1368                      IF (lk_oasis) THEN 
    1369                         f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling 
    1370                      ENDIF 
    1371                      !! do carbonate chemistry 
    1372                      !! 
    1373                      fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint 
    1374                      !! AXY (28/11/16): local seafloor depth 
    1375                      !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
    1376                      jmbathy = mbathy(ji,jj) 
    1377                      !! 
    1378                      !! set up required state variables 
    1379                      zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
    1380                      zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 
    1381                      ztmp = tsn(ji,jj,jk,jp_tem)        !! temperature 
    1382                      zsal = tsn(ji,jj,jk,jp_sal)        !! salinity 
    1383 #  if defined key_mocsy 
    1384                      zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid 
    1385                      zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
    1386 #  endif 
    1387            !! 
    1388            !! AXY (28/02/14): check input fields 
    1389            if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
    1390                         IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', & 
    1391                         tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    & 
    1392                         ji, ',', jj, ',', jk, ') at time', kt 
    1393          IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', & 
    1394          tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
    1395                         ztmp = tsb(ji,jj,jk,jp_tem)     !! temperature 
    1396                      endif 
    1397            if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
    1398                         IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', & 
    1399                         tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    & 
    1400                         ji, ',', jj, ',', jk, ') at time', kt 
    1401                      endif 
    1402                      !! 
    1403                      !! blank input variables not used at this stage (they relate to air-sea flux) 
    1404                      f_kw660 = 1.0 
    1405                      f_pp0   = 1.0 
    1406                      !! 
    1407                      !! calculate carbonate chemistry at grid cell midpoint 
    1408 #  if defined key_mocsy 
    1409                      !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
    1410                      !!                 chemistry package 
    1411                      CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs 
    1412                      f_pp0, fdep2, gphit(ji,jj), f_kw660, f_xco2a, 1,                  &    ! inputs 
    1413                      f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs 
    1414                      f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs 
    1415                      f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs 
    1416                      f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs 
    1417                      !! 
    1418                      f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
    1419                      f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
    1420                      f_dcf  = f_rhosw 
    1421 #  else 
    1422                      !! AXY (22/06/15): use old PML carbonate chemistry package (the 
    1423                      !!                 MEDUSA-2 default) 
    1424                      CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660,      &    ! inputs 
    1425                      f_xco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),   &    ! outputs 
    1426                      f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters)      ! outputs 
    1427                      !!  
    1428                      !! AXY (28/02/14): check output fields 
    1429                      if (iters .eq. 25) then 
    1430                         IF(lwp) WRITE(numout,*) ' trc_bio_medusa: 3D ITERS WARNING, ', & 
    1431                         iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
    1432                      endif 
    1433 #  endif 
    1434                      !! 
    1435                      !! store 3D outputs 
    1436                      f3_pH(ji,jj,jk)    = f_ph 
    1437                      f3_h2co3(ji,jj,jk) = f_h2co3 
    1438                      f3_hco3(ji,jj,jk)  = f_hco3 
    1439                      f3_co3(ji,jj,jk)   = f_co3 
    1440                      f3_omcal(ji,jj,jk) = f_omcal(ji,jj) 
    1441                      f3_omarg(ji,jj,jk) = f_omarg(ji,jj) 
    1442                      !! 
    1443                      !! CCD calculation: calcite 
    1444                      if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then 
    1445                         if (jk .eq. 1) then 
    1446                            f2_ccd_cal(ji,jj) = fdep2 
    1447                         else 
    1448                            fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) 
    1449                            fq1 = f3_omcal(ji,jj,jk-1) - 1.0 
    1450                            fq2 = fq1 / (fq0 + tiny(fq0)) 
    1451                            fq3 = fdep2 - fsdept(ji,jj,jk-1) 
    1452                            fq4 = fq2 * fq3 
    1453                            f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
    1454                         endif 
    1455                         i2_omcal(ji,jj)   = 1 
    1456                      endif 
    1457                      if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
    1458                         !! reached seafloor and still no dissolution; set to seafloor (W-point) 
    1459                         f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) 
    1460                         i2_omcal(ji,jj)   = 1 
    1461                      endif 
    1462                      !! 
    1463                      !! CCD calculation: aragonite 
    1464                      if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then 
    1465                         if (jk .eq. 1) then 
    1466                            f2_ccd_arg(ji,jj) = fdep2 
    1467                         else 
    1468                            fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) 
    1469                            fq1 = f3_omarg(ji,jj,jk-1) - 1.0 
    1470                            fq2 = fq1 / (fq0 + tiny(fq0)) 
    1471                            fq3 = fdep2 - fsdept(ji,jj,jk-1) 
    1472                            fq4 = fq2 * fq3 
    1473                            f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 
    1474                         endif 
    1475                         i2_omarg(ji,jj)   = 1 
    1476                      endif 
    1477                      if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 
    1478                         !! reached seafloor and still no dissolution; set to seafloor (W-point) 
    1479                         f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) 
    1480                         i2_omarg(ji,jj)   = 1 
    1481                      endif 
    1482                   endif 
    1483                ENDDO 
    1484             ENDDO 
    1485          ENDDO 
     356         !!--------------------------------------------------------------- 
     357         CALL carb_chem( kt ) 
     358 
    1486359      ENDIF 
    1487360# endif 
     
    1492365# endif  
    1493366 
    1494       !!---------------------------------------------------------------------- 
     367      !!------------------------------------------------------------------ 
    1495368      !! MEDUSA has unified equation through the water column 
    1496369      !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers)  
    1497370      !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1           
    1498       !!---------------------------------------------------------------------- 
     371      !!------------------------------------------------------------------ 
    1499372      !! 
    1500373      !! NOTE: the ordering of the loops below differs from that of some other 
     
    1512385         !! OPEN horizontal loops 
    1513386         DO jj = 2,jpjm1 
    1514          DO ji = 2,jpim1 
    1515             !! OPEN wet point IF..THEN loop 
    1516             if (tmask(ji,jj,jk).eq.1) then                
    1517                !!====================================================================== 
    1518                !! SETUP LOCAL GRID CELL 
    1519                !!====================================================================== 
    1520                !! 
    1521                !!--------------------------------------------------------------------- 
    1522                !! Some notes on grid vertical structure 
    1523                !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk 
    1524                !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk 
    1525                !! - fse3t(ji,jj,jk)  is the thickness of level jk 
    1526                !!--------------------------------------------------------------------- 
    1527                !! 
    1528                !! AXY (11/12/08): set up level thickness 
    1529                fthk  = fse3t(ji,jj,jk) 
    1530                !! AXY (25/02/10): set up level depth (top of level) 
    1531                fdep  = fsdepw(ji,jj,jk) 
    1532                !! AXY (01/03/10): set up level depth (bottom of level) 
    1533                fdep1 = fdep + fthk 
    1534                !! AXY (28/11/16): local seafloor depth 
    1535                !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 
    1536                jmbathy = mbathy(ji,jj) 
    1537                !! 
    1538                !! set up model tracers 
    1539                !! negative values of state variables are not allowed to 
    1540                !! contribute to the calculated fluxes 
    1541                zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll 
    1542                zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll 
    1543                zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms 
    1544                zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms 
    1545                zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon 
    1546                !! AXY (28/01/10): probably need to take account of chl/biomass connection 
    1547                if (zchn.eq.0.) zphn = 0. 
    1548                if (zchd.eq.0.) zphd = 0. 
    1549                if (zphn.eq.0.) zchn = 0. 
    1550                if (zphd.eq.0.) zchd = 0. 
    1551           !! AXY (23/01/14): duh - why did I forget diatom silicon? 
    1552           if (zpds.eq.0.) zphd = 0. 
    1553           if (zphd.eq.0.) zpds = 0. 
    1554                zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton 
    1555                zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton 
    1556                zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen 
    1557                zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen 
    1558                zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid 
    1559                zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" 
    1560 # if defined key_roam 
    1561                zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon 
    1562                zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
    1563                zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 
    1564                zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen 
    1565 #  if defined key_axy_carbchem && defined key_mocsy 
    1566                zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
    1567 #  endif 
    1568                !! 
    1569                !! also need physical parameters for gas exchange calculations 
    1570                ztmp = tsn(ji,jj,jk,jp_tem) 
    1571                zsal = tsn(ji,jj,jk,jp_sal) 
    1572                !! 
    1573           !! AXY (28/02/14): check input fields 
    1574                if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 
    1575                   IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', & 
    1576                   tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    & 
    1577                   ji, ',', jj, ',', jk, ') at time', kt 
    1578         IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', & 
    1579                   tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
    1580                   ztmp = tsb(ji,jj,jk,jp_tem) !! temperature 
    1581                endif 
    1582                if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 
    1583                   IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', & 
    1584                   tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    & 
    1585                   ji, ',', jj, ',', jk, ') at time', kt 
    1586                endif 
    1587 # else 
    1588                zdtc = zdet * xthetad              !! implicit detrital carbon 
    1589 # endif 
    1590 # if defined key_debug_medusa 
    1591                if (idf.eq.1) then 
    1592                !! AXY (15/01/10) 
    1593                   if (trn(ji,jj,jk,jpdin).lt.0.) then 
    1594                      IF (lwp) write (numout,*) '------------------------------' 
    1595                      IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =', trn(ji,jj,jk,jpdin) 
    1596                      IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @', ji, jj, jk, kt 
    1597                   endif 
    1598                   if (trn(ji,jj,jk,jpsil).lt.0.) then 
    1599                      IF (lwp) write (numout,*) '------------------------------' 
    1600                      IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =', trn(ji,jj,jk,jpsil) 
    1601                      IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @', ji, jj, jk, kt 
    1602                   endif 
    1603 #  if defined key_roam 
    1604                   if (trn(ji,jj,jk,jpdic).lt.0.) then 
    1605                      IF (lwp) write (numout,*) '------------------------------' 
    1606                      IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =', trn(ji,jj,jk,jpdic) 
    1607                      IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @', ji, jj, jk, kt 
    1608                   endif 
    1609                   if (trn(ji,jj,jk,jpalk).lt.0.) then 
    1610                      IF (lwp) write (numout,*) '------------------------------' 
    1611                      IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =', trn(ji,jj,jk,jpalk) 
    1612                      IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @', ji, jj, jk, kt 
    1613                   endif 
    1614                   if (trn(ji,jj,jk,jpoxy).lt.0.) then 
    1615                      IF (lwp) write (numout,*) '------------------------------' 
    1616                      IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =', trn(ji,jj,jk,jpoxy) 
    1617                      IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @', ji, jj, jk, kt 
    1618                   endif 
    1619 #  endif 
    1620                endif 
    1621 # endif 
    1622 # if defined key_debug_medusa 
    1623                !! report state variable values 
    1624                if (idf.eq.1.AND.idfval.eq.1) then 
    1625                   IF (lwp) write (numout,*) '------------------------------' 
    1626                   IF (lwp) write (numout,*) 'fthk(',jk,') = ', fthk 
    1627                   IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn 
    1628                   IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd 
    1629                   IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds 
    1630                   IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi 
    1631                   IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme 
    1632                   IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet 
    1633                   IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin 
    1634                   IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil 
    1635                   IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer 
    1636 #  if defined key_roam 
    1637                   IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc 
    1638                   IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic 
    1639                   IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk 
    1640                   IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy                   
    1641 #  endif 
    1642                endif 
    1643 # endif 
    1644  
    1645 # if defined key_debug_medusa 
    1646                if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 
    1647                   IF (lwp) write (numout,*) '------------------------------' 
    1648                   IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj) 
    1649                endif 
    1650 # endif 
    1651  
    1652                !! sum tracers for inventory checks 
    1653                IF( lk_iomput ) THEN 
    1654                   IF ( med_diag%INVTN%dgsave )   THEN 
    1655                      ftot_n(ji,jj)  = ftot_n(ji,jj) + & 
    1656                              (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) ) 
    1657                   ENDIF 
    1658                   IF ( med_diag%INVTSI%dgsave )  THEN 
    1659                      ftot_si(ji,jj) = ftot_si(ji,jj) + &  
    1660                              (fthk * ( zpds + zsil ) ) 
    1661                   ENDIF 
    1662                   IF ( med_diag%INVTFE%dgsave )  THEN 
    1663                      ftot_fe(ji,jj) = ftot_fe(ji,jj) + &  
    1664                              (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) ) 
    1665                   ENDIF 
    1666 # if defined key_roam 
    1667                   IF ( med_diag%INVTC%dgsave )  THEN 
    1668                      ftot_c(ji,jj)  = ftot_c(ji,jj) + &  
    1669                              (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 
    1670                              (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc +   & 
    1671                              zdic ) ) 
    1672                   ENDIF 
    1673                   IF ( med_diag%INVTALK%dgsave ) THEN 
    1674                      ftot_a(ji,jj)  = ftot_a(ji,jj) + (fthk * ( zalk ) ) 
    1675                   ENDIF 
    1676                   IF ( med_diag%INVTO2%dgsave )  THEN 
    1677                      ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) ) 
    1678                   ENDIF 
     387            DO ji = 2,jpim1 
     388               !! OPEN wet point IF..THEN loop 
     389               if (tmask(ji,jj,jk) == 1) then                
     390                  !!====================================================== 
     391                  !! SETUP LOCAL GRID CELL 
     392                  !!====================================================== 
    1679393                  !! 
    1680                   !! AXY (10/11/16): CMIP6 diagnostics 
    1681                   IF ( med_diag%INTDISSIC%dgsave ) THEN 
    1682                      intdissic(ji,jj) = intdissic(ji,jj) + (fthk * zdic) 
    1683                   ENDIF 
    1684                   IF ( med_diag%INTDISSIN%dgsave ) THEN 
    1685                      intdissin(ji,jj) = intdissin(ji,jj) + (fthk * zdin) 
    1686                   ENDIF 
    1687                   IF ( med_diag%INTDISSISI%dgsave ) THEN 
    1688                      intdissisi(ji,jj) = intdissisi(ji,jj) + (fthk * zsil) 
    1689                   ENDIF 
    1690                   IF ( med_diag%INTTALK%dgsave ) THEN 
    1691                      inttalk(ji,jj) = inttalk(ji,jj) + (fthk * zalk) 
    1692                   ENDIF 
    1693                   IF ( med_diag%O2min%dgsave ) THEN 
    1694                      if ( zoxy < o2min(ji,jj) ) then 
    1695                         o2min(ji,jj)  = zoxy 
    1696                         IF ( med_diag%ZO2min%dgsave ) THEN 
    1697                            zo2min(ji,jj) = (fdep + fdep1) / 2. !! layer midpoint 
    1698                         ENDIF 
    1699                      endif 
    1700                   ENDIF 
    1701 # endif 
    1702                ENDIF 
    1703  
    1704                CALL flush(numout) 
    1705  
    1706                !!====================================================================== 
    1707                !! LOCAL GRID CELL CALCULATIONS 
    1708                !!====================================================================== 
    1709                !! 
    1710 # if defined key_roam 
    1711                if ( jk .eq. 1 ) then 
    1712                   !!---------------------------------------------------------------------- 
    1713                   !! Air-sea gas exchange 
    1714                   !!---------------------------------------------------------------------- 
     394                  !!------------------------------------------------------ 
     395                  !! Some notes on grid vertical structure 
     396                  !! - fsdepw(ji,jj,jk) is the depth of the upper surface of  
     397                  !!   level jk 
     398                  !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of  
     399                  !!   level jk 
     400                  !! - fse3t(ji,jj,jk)  is the thickness of level jk 
     401                  !!------------------------------------------------------ 
    1715402                  !! 
    1716                   !! AXY (17/07/14): zwind_i and zwind_j do not exist in this 
    1717                   !!                 version of NEMO because it does not include 
    1718                   !!                 the SBC changes that our local version has 
    1719                   !!                 for accessing the HadGEM2 forcing; they  
    1720                   !!                 could be added, but an alternative approach 
    1721                   !!                 is to make use of wndm from oce_trc.F90 
    1722                   !!                 which is wind speed at 10m (which is what 
    1723                   !!                 is required here; this may need to be 
    1724                   !!                 revisited when MEDUSA properly interacts 
    1725                   !!                 with UKESM1 physics 
     403                  !! AXY (01/03/10): set up level depth (bottom of level) 
     404                  fdep1(ji,jj) = fsdepw(ji,jj,jk) + fse3t(ji,jj,jk) 
    1726405                  !! 
    1727                   f_wind  = wndm(ji,jj) 
    1728                   IF (lk_oasis) THEN 
    1729                      f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling 
    1730                   ENDIF 
    1731                   !! 
    1732                   !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 
    1733                   !!                 in MEDUSA, the gas transfer velocity used in the carbon 
    1734                   !!                 and oxygen cycles has been harmonised and is calculated 
    1735                   !!                 by the same function here; this harmonisation includes 
    1736                   !!                 changes to the PML carbonate chemistry scheme so that 
    1737                   !!                 it too makes use of the same gas transfer velocity; the 
    1738                   !!                 preferred parameterisation of this is Wanninkhof (2014), 
    1739                   !!                 option 7 
    1740                   !! 
    1741 #   if defined key_debug_medusa 
    1742                      IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 
    1743                      CALL flush(numout) 
    1744 #   endif 
    1745                   CALL gas_transfer( f_wind, 1, 7, &  ! inputs 
    1746                                      f_kw660 )        ! outputs 
    1747 #   if defined key_debug_medusa 
    1748                      IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 
    1749                      CALL flush(numout) 
    1750 #   endif 
    1751                   !! 
    1752                   !! air pressure (atm); ultimately this will use air pressure at the base 
    1753                   !! of the UKESM1 atmosphere  
    1754                   !!                                      
    1755                   f_pp0   = 1.0 
    1756                   !! 
    1757                   !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp 
    1758                   !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj) 
    1759                   !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_j =', zwind_j(ji,jj) 
    1760                   !! IF(lwp) WRITE(numout,*) ' MEDUSA f_wind  =', f_wind 
    1761                   !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i    =', fr_i(ji,jj) 
    1762                   !! 
    1763 #  if defined key_axy_carbchem 
    1764 #   if defined key_mocsy 
    1765                   !! 
    1766                   !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
    1767                   !!                 chemistry package; note that depth is set to 
    1768                   !!                 zero in this call 
    1769                   CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs 
    1770                   f_pp0, 0.0, gphit(ji,jj), f_kw660, f_xco2a, 1,                   &  ! inputs 
    1771                   f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs 
    1772                   f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs 
    1773                   f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs 
    1774                   f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs 
    1775                   !! 
    1776                   f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
    1777                   f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
    1778                   f_dcf  = f_rhosw 
    1779 #   else                   
    1780                   iters = 0 
    1781                   !! 
    1782                   !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not) 
    1783                   CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_xco2a,  &  ! inputs 
    1784                   f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),               &  ! outputs 
    1785                   f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )      ! outputs 
    1786                   !! 
    1787                   !! AXY (09/01/14): removed iteration and NaN checks; these have 
    1788                   !!                 been moved to trc_co2_medusa together with a 
    1789                   !!                 fudge that amends erroneous values (this is 
    1790                   !!                 intended to be a temporary fudge!); the 
    1791                   !!                 output warnings are retained here so that 
    1792                   !!                 failure position can be determined 
    1793                   if (iters .eq. 25) then 
    1794                      IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 
    1795                      iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
    1796                   endif 
    1797 #   endif 
    1798 #  else 
    1799                   !! AXY (18/04/13): switch off carbonate chemistry calculations; provide 
    1800                   !!                 quasi-sensible alternatives 
    1801                   f_ph           = 8.1 
    1802                   f_pco2w        = f_xco2a 
    1803                   f_h2co3        = 0.005 * zdic 
    1804                   f_hco3         = 0.865 * zdic 
    1805                   f_co3          = 0.130 * zdic 
    1806                   f_omcal(ji,jj) = 4. 
    1807                   f_omarg(ji,jj) = 2. 
    1808                   f_co2flux      = 0. 
    1809                   f_TDIC         = zdic 
    1810                   f_TALK         = zalk 
    1811                   f_dcf          = 1.026 
    1812                   f_henry        = 1. 
    1813                   !! AXY (23/06/15): add in some extra MOCSY diagnostics 
    1814                   f_fco2w        = f_xco2a 
    1815                   f_BetaD        = 1. 
    1816                   f_rhosw        = 1.026 
    1817                   f_opres        = 0. 
    1818                   f_insitut      = ztmp 
    1819                   f_pco2atm      = f_xco2a 
    1820                   f_fco2atm      = f_xco2a 
    1821                   f_schmidtco2   = 660. 
    1822                   f_kwco2        = 0. 
    1823                   f_K0           = 0. 
    1824                   f_co2starair   = f_xco2a 
    1825                   f_dpco2        = 0. 
    1826 #  endif 
    1827                   !! 
    1828                   !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness 
    1829                   f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk 
    1830                   !! 
    1831                   !! oxygen (O2); OCMIP-2 code 
    1832                   !! AXY (23/06/15): amend input list for oxygen to account for common gas 
    1833                   !!                 transfer velocity 
    1834                   !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs 
    1835                   !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs 
    1836                   CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs 
    1837                   f_kwo2, f_o2flux, f_o2sat )                                ! outputs 
    1838                   !! 
    1839                   !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness 
    1840                   f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk 
    1841                   !! 
    1842                   !! Jpalm (08-2014) 
    1843                   !! DMS surface concentration calculation 
    1844                   !! initialy added for UKESM1 model. 
    1845                   !! using MET-OFFICE subroutine. 
    1846                   !! DMS module only needs Chl concentration and MLD 
    1847                   !! to get an aproximate value of DMS concentration. 
    1848                   !! air-sea fluxes are calculated by atmospheric chemitry model 
    1849                   !! from atm and oc-surface concentrations. 
    1850                   !! 
    1851                   !! AXY (13/03/15): this is amended to calculate all of the DMS 
    1852                   !!                 estimates examined during UKESM1 (see comments 
    1853                   !!                 in trcdms_medusa.F90) 
    1854                   !! 
    1855                   !! AXY (25/05/17): amended to additionally pass DIN limitation as well as [DIN]; 
    1856                   !!                 accounts for differences in nutrient half-saturations; changes 
    1857                   !!                 also made in trc_dms_medusa; this permits an additional DMS 
    1858                   !!                 calculation while retaining the existing Anderson one 
    1859                   !! 
    1860                   IF (jdms .eq. 1) THEN 
    1861                      !! 
    1862                      !! calculate weighted half-saturation for DIN uptake 
    1863                      dms_wtkn = ((zphn * xnln) + (zphd * xnld)) / (zphn + zphd) 
    1864                      !! 
    1865                      !! feed in correct inputs 
    1866                      if (jdms_input .eq. 0) then 
    1867                         !! use instantaneous inputs 
    1868                         dms_nlim = zdin / (zdin + dms_wtkn) 
    1869                         !! 
    1870                         CALL trc_dms_medusa( zchn, zchd,                           &  ! inputs 
    1871                         hmld(ji,jj), qsr(ji,jj),                                   &  ! inputs 
    1872                         zdin, dms_nlim,                                            &  ! inputs 
    1873                         dms_andr, dms_simo, dms_aran, dms_hall, dms_andm )            ! outputs 
    1874                      else 
    1875                         !! use diel-average inputs 
    1876                         dms_nlim = zn_dms_din(ji,jj) / (zn_dms_din(ji,jj) + dms_wtkn) 
    1877                         !! 
    1878                         CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs 
    1879                         zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj),                      &  ! inputs 
    1880                         zn_dms_din(ji,jj), dms_nlim,                               &  ! inputs 
    1881                         dms_andr, dms_simo, dms_aran, dms_hall, dms_andm )            ! outputs 
    1882                      endif 
    1883                      !! 
    1884                      !! assign correct output to variable passed to atmosphere 
    1885                      if     (jdms_model .eq. 1) then 
    1886                         dms_surf = dms_andr 
    1887                      elseif (jdms_model .eq. 2) then 
    1888                         dms_surf = dms_simo 
    1889                      elseif (jdms_model .eq. 3) then 
    1890                         dms_surf = dms_aran 
    1891                      elseif (jdms_model .eq. 4) then 
    1892                         dms_surf = dms_hall 
    1893                      elseif (jdms_model .eq. 5) then 
    1894                         dms_surf = dms_andm 
    1895                      endif 
    1896                      !! 
    1897                      !! 2D diag through iom_use 
    1898                      IF( lk_iomput ) THEN 
    1899                        IF( med_diag%DMS_SURF%dgsave ) THEN 
    1900                          dms_surf2d(ji,jj) = dms_surf 
    1901                        ENDIF 
    1902                        IF( med_diag%DMS_ANDR%dgsave ) THEN 
    1903                          dms_andr2d(ji,jj) = dms_andr 
    1904                        ENDIF 
    1905                        IF( med_diag%DMS_SIMO%dgsave ) THEN 
    1906                          dms_simo2d(ji,jj) = dms_simo 
    1907                        ENDIF 
    1908                        IF( med_diag%DMS_ARAN%dgsave ) THEN 
    1909                          dms_aran2d(ji,jj) = dms_aran 
    1910                        ENDIF 
    1911                        IF( med_diag%DMS_HALL%dgsave ) THEN 
    1912                          dms_hall2d(ji,jj) = dms_hall 
    1913                        ENDIF 
    1914                        IF( med_diag%DMS_ANDM%dgsave ) THEN 
    1915                          dms_andm2d(ji,jj) = dms_andm 
    1916                        ENDIF 
    1917 #   if defined key_debug_medusa 
    1918                        IF (lwp) write (numout,*) 'trc_bio_medusa: finish calculating dms' 
    1919                      CALL flush(numout) 
    1920 #   endif  
    1921                      ENDIF 
    1922                      !! End iom 
    1923                   ENDIF 
    1924                   !! End DMS Loop 
    1925                   !! 
    1926                   !! store 2D outputs 
    1927                   !! 
    1928                   !! JPALM -- 17-11-16 -- put fgco2 out of diag request 
    1929                   !!                    is needed for coupling; pass through restart 
    1930                   !! IF( med_diag%FGCO2%dgsave ) THEN 
    1931                      !! convert from  mol/m2/day to kg/m2/s 
    1932                      fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv  !! mmol-C/m3/d -> kg-CO2/m2/s 
    1933                   !! ENDIF 
    1934                   IF ( lk_iomput ) THEN 
    1935                       IF( med_diag%ATM_PCO2%dgsave ) THEN 
    1936                          f_pco2a2d(ji,jj) = f_pco2atm 
    1937                       ENDIF 
    1938                       IF( med_diag%OCN_PCO2%dgsave ) THEN 
    1939                          f_pco2w2d(ji,jj) = f_pco2w 
    1940                       ENDIF 
    1941                       IF( med_diag%CO2FLUX%dgsave ) THEN 
    1942                          f_co2flux2d(ji,jj) = f_co2flux * fthk           !! mmol/m3/d -> mmol/m2/d 
    1943                       ENDIF 
    1944                       IF( med_diag%TCO2%dgsave ) THEN 
    1945                          f_TDIC2d(ji,jj) = f_TDIC 
    1946                       ENDIF 
    1947                       IF( med_diag%TALK%dgsave ) THEN 
    1948                          f_TALK2d(ji,jj) = f_TALK 
    1949                       ENDIF 
    1950                       IF( med_diag%KW660%dgsave ) THEN 
    1951                          f_kw6602d(ji,jj) = f_kw660 
    1952                       ENDIF 
    1953                       IF( med_diag%ATM_PP0%dgsave ) THEN 
    1954                          f_pp02d(ji,jj) = f_pp0 
    1955                       ENDIF 
    1956                       IF( med_diag%O2FLUX%dgsave ) THEN 
    1957                          f_o2flux2d(ji,jj) = f_o2flux 
    1958                       ENDIF 
    1959                       IF( med_diag%O2SAT%dgsave ) THEN 
    1960                          f_o2sat2d(ji,jj) = f_o2sat 
    1961                       ENDIF 
    1962                       !! AXY (24/11/16): add in extra MOCSY diagnostics 
    1963                       IF( med_diag%ATM_XCO2%dgsave ) THEN 
    1964                          f_xco2a_2d(ji,jj) = f_xco2a 
    1965                       ENDIF 
    1966                       IF( med_diag%OCN_FCO2%dgsave ) THEN 
    1967                          f_fco2w_2d(ji,jj) = f_fco2w 
    1968                       ENDIF 
    1969                       IF( med_diag%ATM_FCO2%dgsave ) THEN 
    1970                          f_fco2a_2d(ji,jj) = f_fco2atm 
    1971                       ENDIF 
    1972                       IF( med_diag%OCN_RHOSW%dgsave ) THEN 
    1973                          f_ocnrhosw_2d(ji,jj) = f_rhosw 
    1974                       ENDIF 
    1975                       IF( med_diag%OCN_SCHCO2%dgsave ) THEN 
    1976                          f_ocnschco2_2d(ji,jj) = f_schmidtco2 
    1977                       ENDIF 
    1978                       IF( med_diag%OCN_KWCO2%dgsave ) THEN 
    1979                          f_ocnkwco2_2d(ji,jj) = f_kwco2 
    1980                       ENDIF 
    1981                       IF( med_diag%OCN_K0%dgsave ) THEN 
    1982                          f_ocnk0_2d(ji,jj) = f_K0 
    1983                       ENDIF 
    1984                       IF( med_diag%CO2STARAIR%dgsave ) THEN 
    1985                          f_co2starair_2d(ji,jj) = f_co2starair 
    1986                       ENDIF 
    1987                       IF( med_diag%OCN_DPCO2%dgsave ) THEN 
    1988                          f_ocndpco2_2d(ji,jj) = f_dpco2 
    1989                       ENDIF 
    1990                   ENDIF 
    1991                   !!  
    1992                endif 
    1993                !! End jk = 1 loop within ROAM key  
    1994  
    1995                !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic 
    1996                IF ( med_diag%O2SAT3%dgsave ) THEN 
    1997                   call oxy_sato( ztmp, zsal, f_o2sat3 ) 
    1998                   o2sat3(ji, jj, jk) = f_o2sat3 
    1999                ENDIF 
    2000  
    2001 # endif 
    2002  
    2003                if ( jk .eq. 1 ) then 
    2004                   !!---------------------------------------------------------------------- 
    2005                   !! River inputs 
    2006                   !!---------------------------------------------------------------------- 
    2007                   !! 
    2008                   !! runoff comes in as        kg / m2 / s 
    2009                   !! used and written out as   m3 / m2 / d (= m / d) 
    2010                   !! where                     1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d 
    2011                   !! 
    2012                   !! AXY (17/07/14): the compiler doesn't like this line for some reason; 
    2013                   !!                 as MEDUSA doesn't even use runoff for riverine inputs, 
    2014                   !!                 a temporary solution is to switch off runoff entirely 
    2015                   !!                 here; again, this change is one of several that will  
    2016                   !!                 need revisiting once MEDUSA has bedded down in UKESM1; 
    2017                   !!                 particularly so if the land scheme provides information 
    2018                   !!                 concerning nutrient fluxes 
    2019                   !! 
    2020                   !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. 
    2021                   f_runoff(ji,jj) = 0.0 
    2022                   !! 
    2023                   !! nutrients are added via rivers to the model in one of two ways: 
    2024                   !!   1. via river concentration; i.e. the average nutrient concentration 
    2025                   !!      of a river water is described by a spatial file, and this is 
    2026                   !!      multiplied by runoff to give a nutrient flux 
    2027                   !!   2. via direct river flux; i.e. the average nutrient flux due to 
    2028                   !!      rivers is described by a spatial file, and this is simply applied 
    2029                   !!      as a direct nutrient flux (i.e. it does not relate or respond to 
    2030                   !!      model runoff) 
    2031                   !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and 
    2032                   !! alkalinity are derived from continent-scale DIC estimates (Huang et al.,  
    2033                   !! 2012) and some Arctic river alkalinity estimates (Katya?) 
    2034                   !!  
    2035                   !! as of 19/07/12, riverine nutrients can now be spread vertically across  
    2036                   !! several grid cells rather than just poured into the surface box; this 
    2037                   !! block of code is still executed, however, to set up the total amounts 
    2038                   !! of nutrient entering via rivers 
    2039                   !! 
    2040                   !! nitrogen 
    2041                   if (jriver_n .eq. 1) then 
    2042                      !! river concentration specified; use runoff to calculate input 
    2043                      f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) 
    2044                   elseif (jriver_n .eq. 2) then 
    2045                      !! river flux specified; independent of runoff 
    2046                      f_riv_n(ji,jj) = riv_n(ji,jj) 
    2047                   endif 
    2048                   !! 
    2049                   !! silicon 
    2050                   if (jriver_si .eq. 1) then 
    2051                      !! river concentration specified; use runoff to calculate input 
    2052                      f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) 
    2053                   elseif (jriver_si .eq. 2) then 
    2054                      !! river flux specified; independent of runoff 
    2055                      f_riv_si(ji,jj) = riv_si(ji,jj) 
    2056                   endif 
    2057                   !! 
    2058                   !! carbon 
    2059                   if (jriver_c .eq. 1) then 
    2060                      !! river concentration specified; use runoff to calculate input 
    2061                      f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) 
    2062                   elseif (jriver_c .eq. 2) then 
    2063                      !! river flux specified; independent of runoff 
    2064                      f_riv_c(ji,jj) = riv_c(ji,jj) 
    2065                   endif 
    2066                   !! 
    2067                   !! alkalinity 
    2068                   if (jriver_alk .eq. 1) then 
    2069                      !! river concentration specified; use runoff to calculate input 
    2070                      f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) 
    2071                   elseif (jriver_alk .eq. 2) then 
    2072                      !! river flux specified; independent of runoff 
    2073                      f_riv_alk(ji,jj) = riv_alk(ji,jj) 
    2074                   endif 
    2075  
    2076                endif 
    2077  
    2078                !!---------------------------------------------------------------------- 
    2079                !! Chlorophyll calculations 
    2080                !!---------------------------------------------------------------------- 
    2081                !! 
    2082                !! non-diatoms 
    2083           if (zphn.GT.rsmall) then 
    2084                   fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) 
    2085                   faln    = xaln * fthetan 
    2086                else 
    2087                   fthetan = 0. 
    2088                   faln    = 0. 
    2089                endif 
    2090                !! 
    2091                !! diatoms 
    2092           if (zphd.GT.rsmall) then 
    2093                   fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) 
    2094                   fald    = xald * fthetad 
    2095                else 
    2096                   fthetad = 0. 
    2097                   fald    = 0. 
    2098                endif 
    2099  
    2100 # if defined key_debug_medusa 
    2101                !! report biological calculations 
    2102                if (idf.eq.1.AND.idfval.eq.1) then 
    2103                   IF (lwp) write (numout,*) '------------------------------' 
    2104                   IF (lwp) write (numout,*) 'faln(',jk,') = ', faln 
    2105                   IF (lwp) write (numout,*) 'fald(',jk,') = ', fald 
    2106                endif 
    2107 # endif 
    2108  
    2109                !!---------------------------------------------------------------------- 
    2110                !! Phytoplankton light limitation 
    2111                !!---------------------------------------------------------------------- 
    2112                !! 
    2113                !! It is assumed xpar is the depth-averaged (vertical layer) PAR  
    2114                !! Light limitation (check self-shading) in W/m2 
    2115                !! 
    2116                !! Note that there is no temperature dependence in phytoplankton 
    2117                !! growth rate or any other function.  
    2118                !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid 
    2119                !! NaNs in case of Phy==0.   
    2120                !! 
    2121                !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat:  
    2122                !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 
    2123                !! 
    2124                !! AXY (16/07/09) 
    2125                !! temperature for new Eppley style phytoplankton growth 
    2126                loc_T   = tsn(ji,jj,jk,jp_tem) 
    2127                fun_T   = 1.066**(1.0 * loc_T) 
    2128                !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for 
    2129                !phytoplankton 
    2130                !!                 growth; remin. unaffected 
    2131                fun_Q10 = jq10**((loc_T - 0.0) / 10.0) 
    2132                if (jphy.eq.1) then 
    2133                   xvpnT = xvpn * fun_T 
    2134                   xvpdT = xvpd * fun_T 
    2135                elseif (jphy.eq.2) then 
    2136                   xvpnT = xvpn * fun_Q10 
    2137                   xvpdT = xvpd * fun_Q10 
    2138                else 
    2139                   xvpnT = xvpn 
    2140                   xvpdT = xvpd 
    2141                endif 
    2142                !! 
    2143                !! non-diatoms 
    2144                fchn1   = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    2145                if (fchn1.GT.rsmall) then 
    2146                   fchn    = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 
    2147                else 
    2148                   fchn    = 0. 
    2149                endif 
    2150                fjln    = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term 
    2151                fjlim_pn = fjln / xvpnT 
    2152                !! 
    2153                !! diatoms 
    2154                fchd1   = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    2155                if (fchd1.GT.rsmall) then 
    2156                   fchd    = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 
    2157                else 
    2158                   fchd    = 0. 
    2159                endif 
    2160                fjld    = fchd * fald * xpar(ji,jj,jk) !! diatom J term 
    2161                fjlim_pd = fjld / xvpdT 
    2162        
    2163 # if defined key_debug_medusa 
    2164                !! report phytoplankton light limitation 
    2165                if (idf.eq.1.AND.idfval.eq.1) then 
    2166                   IF (lwp) write (numout,*) '------------------------------' 
    2167                   IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn 
    2168                   IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd 
    2169                   IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln 
    2170                   IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld 
    2171                endif 
    2172 # endif 
    2173  
    2174                !!---------------------------------------------------------------------- 
    2175                !! Phytoplankton nutrient limitation 
    2176                !!---------------------------------------------------------------------- 
    2177                !! 
    2178                !! non-diatoms (N, Fe) 
    2179                fnln = zdin / (zdin + xnln) !! non-diatom Qn term 
    2180                ffln = zfer / (zfer + xfln) !! non-diatom Qf term 
    2181                !! 
    2182                !! diatoms (N, Si, Fe) 
    2183                fnld = zdin / (zdin + xnld) !! diatom Qn term 
    2184                fsld = zsil / (zsil + xsld) !! diatom Qs term 
    2185                ffld = zfer / (zfer + xfld) !! diatom Qf term 
    2186  
    2187 # if defined key_debug_medusa 
    2188                !! report phytoplankton nutrient limitation 
    2189                if (idf.eq.1.AND.idfval.eq.1) then 
    2190                   IF (lwp) write (numout,*) '------------------------------' 
    2191                   IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln 
    2192                   IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld 
    2193                   IF (lwp) write (numout,*) 'ffln(',jk,') = ', ffln 
    2194                   IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld 
    2195                   IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld 
    2196                endif 
    2197 # endif 
    2198  
    2199                !!---------------------------------------------------------------------- 
    2200                !! Primary production (non-diatoms) 
    2201                !! (note: still needs multiplying by phytoplankton concentration) 
    2202                !!---------------------------------------------------------------------- 
    2203                !! 
    2204                if (jliebig .eq. 0) then 
    2205                   !! multiplicative nutrient limitation 
    2206                   fpnlim = fnln * ffln 
    2207                elseif (jliebig .eq. 1) then 
    2208                   !! Liebig Law (= most limiting) nutrient limitation 
    2209                   fpnlim = min(fnln, ffln) 
    2210                endif 
    2211                fprn = fjln * fpnlim 
    2212  
    2213                !!---------------------------------------------------------------------- 
    2214                !! Primary production (diatoms) 
    2215                !! (note: still needs multiplying by phytoplankton concentration) 
    2216                !! 
    2217                !! production here is split between nitrogen production and that of 
    2218                !! silicon; depending upon the "intracellular" ratio of Si:N, model 
    2219                !! diatoms will uptake nitrogen/silicon differentially; this borrows 
    2220                !! from the diatom model of Mongin et al. (2006) 
    2221                !!---------------------------------------------------------------------- 
    2222                !! 
    2223                if (jliebig .eq. 0) then 
    2224                   !! multiplicative nutrient limitation 
    2225                   fpdlim = fnld * ffld 
    2226                elseif (jliebig .eq. 1) then 
    2227                   !! Liebig Law (= most limiting) nutrient limitation 
    2228                   fpdlim = min(fnld, ffld) 
    2229                endif 
    2230                !! 
    2231           if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then 
    2232                   !! "intracellular" elemental ratios 
    2233                   ! fsin  = zpds / (zphd + tiny(zphd)) 
    2234                   ! fnsi  = zphd / (zpds + tiny(zpds)) 
    2235                   fsin = 0.0 
    2236                   IF( zphd .GT. rsmall) fsin  = zpds / zphd 
    2237                   fnsi = 0.0 
    2238                   IF( zpds .GT. rsmall) fnsi  = zphd / zpds 
    2239                   !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) 
    2240                   fsin1 = 3.0 * xsin0 !! = 0.6 
    2241                   fnsi1 = 1.0 / fsin1 !! = 1.667 
    2242                   fnsi2 = 1.0 / xsin0 !! = 5.0 
    2243                   !! 
    2244                   !! conditionalities based on ratios 
    2245                   !! nitrogen (and iron and carbon) 
    2246                   if (fsin.le.xsin0) then 
    2247                      fprd  = 0.0 
    2248                      fsld2 = 0.0 
    2249                   elseif (fsin.lt.fsin1) then 
    2250                      fprd  = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) 
    2251                      fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) 
    2252                   elseif (fsin.ge.fsin1) then 
    2253                      fprd  = (fjld * fpdlim) 
    2254                      fsld2 = 1.0 
    2255                   endif 
    2256                   !! 
    2257                   !! silicon 
    2258                   if (fsin.lt.fnsi1) then 
    2259                      fprds = (fjld * fsld) 
    2260                   elseif (fsin.lt.fnsi2) then 
    2261                      fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) 
    2262                   else 
    2263                      fprds = 0.0 
    2264                   endif      
    2265                else 
    2266                   fsin  = 0.0 
    2267                   fnsi  = 0.0 
    2268                   fprd  = 0.0 
    2269                   fsld2 = 0.0 
    2270                   fprds = 0.0 
    2271                endif 
    2272  
    2273 # if defined key_debug_medusa 
    2274                !! report phytoplankton growth (including diatom silicon submodel) 
    2275                if (idf.eq.1.AND.idfval.eq.1) then 
    2276                   IF (lwp) write (numout,*) '------------------------------' 
    2277                   IF (lwp) write (numout,*) 'fsin(',jk,')   = ', fsin 
    2278                   IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi 
    2279                   IF (lwp) write (numout,*) 'fsld2(',jk,')  = ', fsld2 
    2280                   IF (lwp) write (numout,*) 'fprn(',jk,')   = ', fprn 
    2281                   IF (lwp) write (numout,*) 'fprd(',jk,')   = ', fprd 
    2282                   IF (lwp) write (numout,*) 'fprds(',jk,')  = ', fprds 
    2283                endif 
    2284 # endif 
    2285  
    2286                !!---------------------------------------------------------------------- 
    2287                !! Mixed layer primary production 
    2288                !! this block calculates the amount of primary production that occurs 
    2289                !! within the upper mixed layer; this allows the separate diagnosis 
    2290                !! of "sub-surface" primary production; it does assume that short- 
    2291                !! term variability in mixed layer depth doesn't mess with things 
    2292                !! though 
    2293                !!---------------------------------------------------------------------- 
    2294                !! 
    2295                if (fdep1.le.hmld(ji,jj)) then 
    2296                   !! this level is entirely in the mixed layer 
    2297                   fq0 = 1.0 
    2298                elseif (fdep.ge.hmld(ji,jj)) then 
    2299                   !! this level is entirely below the mixed layer 
    2300                   fq0 = 0.0 
    2301                else 
    2302                   !! this level straddles the mixed layer 
    2303                   fq0 = (hmld(ji,jj) - fdep) / fthk 
    2304                endif 
    2305                !! 
    2306                fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) 
    2307                fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) 
    2308                 
    2309                !!---------------------------------------------------------------------- 
    2310                !! Vertical Integral -- 
    2311                !!---------------------------------------------------------------------- 
    2312                ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)   !! vertical integral non-diatom phytoplankton 
    2313                ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)   !! vertical integral diatom phytoplankton 
    2314                ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)   !! vertical integral microzooplankton 
    2315                ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)   !! vertical integral mesozooplankton 
    2316                ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)   !! vertical integral slow detritus, nitrogen 
    2317                ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)   !! vertical integral slow detritus, carbon 
    2318                 
    2319                !!---------------------------------------------------------------------- 
    2320                !! More chlorophyll calculations 
    2321                !!---------------------------------------------------------------------- 
    2322                !! 
    2323                !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) 
    2324                !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) 
    2325                frn = (xthetam * fchn * fnln * ffln       ) / (fthetan + tiny(fthetan)) 
    2326                !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid  
    2327                !!   limitation, is used in the following line to regulate chlorophyll  
    2328                !!   growth in a manner that is inconsistent with its use in the regulation  
    2329                !!   of biomass growth; the Mongin term term used in growth is more complex 
    2330                !!   than the simple multiplicative function used below 
    2331                !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) 
    2332                !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to 
    2333                !!   regulate chlorophyll growth 
    2334                frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) 
    2335  
    2336 # if defined key_debug_medusa 
    2337                !! report chlorophyll calculations 
    2338                if (idf.eq.1.AND.idfval.eq.1) then 
    2339                   IF (lwp) write (numout,*) '------------------------------' 
    2340                   IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan 
    2341                   IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad 
    2342                   IF (lwp) write (numout,*) 'frn(',jk,')     = ', frn 
    2343                   IF (lwp) write (numout,*) 'frd(',jk,')     = ', frd 
    2344                endif 
    2345 # endif 
    2346  
    2347                !!---------------------------------------------------------------------- 
    2348                !! Zooplankton Grazing  
    2349                !! this code supplements the base grazing model with one that 
    2350                !! considers the C:N ratio of grazed food and balances this against 
    2351                !! the requirements of zooplankton growth; this model is derived  
    2352                !! from that of Anderson & Pondaven (2003) 
    2353                !! 
    2354                !! the current version of the code assumes a fixed C:N ratio for 
    2355                !! detritus (in contrast to Anderson & Pondaven, 2003), though the 
    2356                !! full equations are retained for future extension 
    2357                !!---------------------------------------------------------------------- 
    2358                !! 
    2359                !!---------------------------------------------------------------------- 
    2360                !! Microzooplankton first 
    2361                !!---------------------------------------------------------------------- 
    2362                !! 
    2363                fmi1    = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) 
    2364                fmi     = xgmi * zzmi / fmi1 
    2365                fgmipn  = fmi * xpmipn * zphn * zphn   !! grazing on non-diatoms 
    2366                fgmid   = fmi * xpmid  * zdet * zdet   !! grazing on detrital nitrogen 
    2367 # if defined key_roam 
    2368                fgmidc  = rsmall !acc 
    2369                IF ( zdet .GT. rsmall ) fgmidc  = (zdtc / (zdet + tiny(zdet))) * fgmid  !! grazing on detrital carbon 
    2370 # else 
    2371                !! AXY (26/11/08): implicit detrital carbon change 
    2372                fgmidc  = xthetad * fgmid              !! grazing on detrital carbon 
    2373 # endif 
    2374                !! 
    2375                !! which translates to these incoming N and C fluxes 
    2376                finmi   = (1.0 - xphi) * (fgmipn + fgmid) 
    2377                ficmi   = (1.0 - xphi) * ((xthetapn * fgmipn) + fgmidc) 
    2378                !! 
    2379                !! the ideal food C:N ratio for microzooplankton 
    2380                !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    2381                fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 
    2382                !! 
    2383                !! process these to determine proportioning of grazed N and C 
    2384                !! (since there is no explicit consideration of respiration, 
    2385                !! only growth and excretion are calculated here) 
    2386                fmith   = (ficmi / (finmi + tiny(finmi))) 
    2387                if (fmith.ge.fstarmi) then 
    2388                   fmigrow = xbetan * finmi 
    2389                   fmiexcr = 0.0 
    2390                else 
    2391                   fmigrow = (xbetac * xkc * ficmi) / xthetazmi 
    2392                   fmiexcr = ficmi * ((xbetan / (fmith + tiny(fmith))) - ((xbetac * xkc) / xthetazmi)) 
    2393                endif 
    2394 # if defined key_roam 
    2395                fmiresp = (xbetac * ficmi) - (xthetazmi * fmigrow) 
    2396 # endif 
    2397  
    2398 # if defined key_debug_medusa 
    2399                !! report microzooplankton grazing 
    2400                if (idf.eq.1.AND.idfval.eq.1) then 
    2401                   IF (lwp) write (numout,*) '------------------------------' 
    2402                   IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1 
    2403                   IF (lwp) write (numout,*) 'fmi(',jk,')     = ', fmi 
    2404                   IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn 
    2405                   IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid 
    2406                   IF (lwp) write (numout,*) 'fgmidc(',jk,')  = ', fgmidc 
    2407                   IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi 
    2408                   IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi 
    2409                   IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi 
    2410                   IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith 
    2411                   IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow 
    2412                   IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr 
    2413 #  if defined key_roam 
    2414                   IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp 
    2415 #  endif 
    2416                endif 
    2417 # endif 
    2418  
    2419                !!---------------------------------------------------------------------- 
    2420                !! Mesozooplankton second 
    2421                !!---------------------------------------------------------------------- 
    2422                !! 
    2423                fme1    = (xkme * xkme) + (xpmepn * zphn * zphn) + (xpmepd * zphd * zphd) + &  
    2424                          (xpmezmi * zzmi * zzmi) + (xpmed * zdet * zdet) 
    2425                fme     = xgme * zzme / fme1 
    2426                fgmepn  = fme * xpmepn  * zphn * zphn  !! grazing on non-diatoms 
    2427                fgmepd  = fme * xpmepd  * zphd * zphd  !! grazing on diatoms 
    2428                fgmepds = fsin * fgmepd                !! grazing on diatom silicon 
    2429                fgmezmi = fme * xpmezmi * zzmi * zzmi  !! grazing on microzooplankton 
    2430                fgmed   = fme * xpmed   * zdet * zdet  !! grazing on detrital nitrogen 
    2431 # if defined key_roam 
    2432                fgmedc  = rsmall !acc 
    2433                IF ( zdet .GT. rsmall ) fgmedc  = (zdtc / (zdet + tiny(zdet))) * fgmed  !! grazing on detrital carbon 
    2434 # else 
    2435                !! AXY (26/11/08): implicit detrital carbon change 
    2436                fgmedc  = xthetad * fgmed              !! grazing on detrital carbon 
    2437 # endif 
    2438                !! 
    2439                !! which translates to these incoming N and C fluxes 
    2440                finme   = (1.0 - xphi) * (fgmepn + fgmepd + fgmezmi + fgmed) 
    2441                ficme   = (1.0 - xphi) * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 
    2442                         (xthetazmi * fgmezmi) + fgmedc) 
    2443                !! 
    2444                !! the ideal food C:N ratio for mesozooplankton 
    2445                !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    2446                fstarme = (xbetan * xthetazme) / (xbetac * xkc) 
    2447                !! 
    2448                !! process these to determine proportioning of grazed N and C 
    2449                !! (since there is no explicit consideration of respiration, 
    2450                !! only growth and excretion are calculated here) 
    2451                fmeth   = (ficme / (finme + tiny(finme))) 
    2452                if (fmeth.ge.fstarme) then 
    2453                   fmegrow = xbetan * finme 
    2454                   fmeexcr = 0.0 
    2455                else 
    2456                   fmegrow = (xbetac * xkc * ficme) / xthetazme 
    2457                   fmeexcr = ficme * ((xbetan / (fmeth + tiny(fmeth))) - ((xbetac * xkc) / xthetazme)) 
    2458                endif 
    2459 # if defined key_roam 
    2460                fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) 
    2461 # endif 
    2462  
    2463 # if defined key_debug_medusa 
    2464                !! report mesozooplankton grazing 
    2465                if (idf.eq.1.AND.idfval.eq.1) then 
    2466                   IF (lwp) write (numout,*) '------------------------------' 
    2467                   IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1 
    2468                   IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme 
    2469                   IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn 
    2470                   IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd 
    2471                   IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds 
    2472                   IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi 
    2473                   IF (lwp) write (numout,*) 'fgmed(',jk,')   = ', fgmed 
    2474                   IF (lwp) write (numout,*) 'fgmedc(',jk,')  = ', fgmedc 
    2475                   IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme 
    2476                   IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme 
    2477                   IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme 
    2478                   IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth 
    2479                   IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow 
    2480                   IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr 
    2481 #  if defined key_roam 
    2482                   IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp 
    2483 #  endif 
    2484                endif 
    2485 # endif 
    2486  
    2487                fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fthk * (  & 
    2488                   fgmipn + fgmid ) 
    2489                fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fthk * (  & 
    2490                   fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) 
    2491                fzme_i(ji,jj)  = fzme_i(ji,jj)  + fthk * (  & 
    2492                   fgmepn + fgmepd + fgmezmi + fgmed ) 
    2493                fzme_o(ji,jj)  = fzme_o(ji,jj)  + fthk * (  & 
    2494                   fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) 
    2495  
    2496                !!---------------------------------------------------------------------- 
    2497                !! Plankton metabolic losses 
    2498                !! Linear loss processes assumed to be metabolic in origin 
    2499                !!---------------------------------------------------------------------- 
    2500                !! 
    2501                fdpn2  = xmetapn  * zphn 
    2502                fdpd2  = xmetapd  * zphd 
    2503                fdpds2 = xmetapd  * zpds 
    2504                fdzmi2 = xmetazmi * zzmi 
    2505                fdzme2 = xmetazme * zzme 
    2506  
    2507                !!---------------------------------------------------------------------- 
    2508                !! Plankton mortality losses 
    2509                !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced  
    2510                !! to improve performance in gyres 
    2511                !!---------------------------------------------------------------------- 
    2512                !! 
    2513                !! non-diatom phytoplankton 
    2514                if (jmpn.eq.1) fdpn = xmpn * zphn               !! linear 
    2515                if (jmpn.eq.2) fdpn = xmpn * zphn * zphn        !! quadratic 
    2516                if (jmpn.eq.3) fdpn = xmpn * zphn * &           !! hyperbolic 
    2517                   (zphn / (xkphn + zphn)) 
    2518                if (jmpn.eq.4) fdpn = xmpn * zphn * &           !! sigmoid 
    2519                   ((zphn * zphn) / (xkphn + (zphn * zphn))) 
    2520                !! 
    2521                !! diatom phytoplankton 
    2522                if (jmpd.eq.1) fdpd = xmpd * zphd               !! linear 
    2523                if (jmpd.eq.2) fdpd = xmpd * zphd * zphd        !! quadratic 
    2524                if (jmpd.eq.3) fdpd = xmpd * zphd * &           !! hyperbolic 
    2525                   (zphd / (xkphd + zphd)) 
    2526                if (jmpd.eq.4) fdpd = xmpd * zphd * &           !! sigmoid 
    2527                   ((zphd * zphd) / (xkphd + (zphd * zphd))) 
    2528                fdpds = fdpd * fsin 
    2529                !! 
    2530                !! microzooplankton 
    2531                if (jmzmi.eq.1) fdzmi = xmzmi * zzmi            !! linear 
    2532                if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi     !! quadratic 
    2533                if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * &        !! hyperbolic 
    2534                   (zzmi / (xkzmi + zzmi)) 
    2535                if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * &        !! sigmoid 
    2536                   ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) 
    2537                !! 
    2538                !! mesozooplankton 
    2539                if (jmzme.eq.1) fdzme = xmzme * zzme            !! linear 
    2540                if (jmzme.eq.2) fdzme = xmzme * zzme * zzme     !! quadratic 
    2541                if (jmzme.eq.3) fdzme = xmzme * zzme * &        !! hyperbolic 
    2542                   (zzme / (xkzme + zzme)) 
    2543                if (jmzme.eq.4) fdzme = xmzme * zzme * &        !! sigmoid 
    2544                   ((zzme * zzme) / (xkzme + (zzme * zzme))) 
    2545  
    2546                !!---------------------------------------------------------------------- 
    2547                !! Detritus remineralisation 
    2548                !! Constant or temperature-dependent 
    2549                !!---------------------------------------------------------------------- 
    2550                !! 
    2551                if (jmd.eq.1) then 
    2552                   !! temperature-dependent 
    2553                   fdd  = xmd  * fun_T * zdet 
    2554 # if defined key_roam 
    2555                   fddc = xmdc * fun_T * zdtc 
    2556 # endif 
    2557                elseif (jmd.eq.2) then 
    2558                   !! AXY (16/05/13): add in Q10-based parameterisation (def in nmlst) 
    2559                   !! temperature-dependent 
    2560                   fdd  = xmd  * fun_Q10 * zdet 
    2561 # if defined key_roam 
    2562                   fddc = xmdc * fun_Q10 * zdtc 
    2563 # endif 
    2564                else 
    2565                   !! temperature-independent 
    2566                   fdd  = xmd  * zdet 
    2567 # if defined key_roam 
    2568                   fddc = xmdc * zdtc 
    2569 # endif 
    2570                endif 
    2571                !! 
    2572                !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box 
    2573                if ((jk.eq.jmbathy) .and. jsfd.eq.1) then 
    2574                   fdd  = 1.0  * zdet 
    2575 # if defined key_roam 
    2576                   fddc = 1.0  * zdtc 
    2577 # endif 
    2578                endif 
    2579                 
    2580 # if defined key_debug_medusa 
    2581                !! report plankton mortality and remineralisation 
    2582                if (idf.eq.1.AND.idfval.eq.1) then 
    2583                   IF (lwp) write (numout,*) '------------------------------' 
    2584                   IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2 
    2585                   IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2 
    2586                   IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2 
    2587                   IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2 
    2588                   IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2 
    2589                   IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn 
    2590                   IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd 
    2591                   IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds 
    2592                   IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi 
    2593                   IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme 
    2594                   IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd 
    2595 #  if defined key_roam 
    2596                   IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc 
    2597 #  endif 
    2598                endif 
    2599 # endif 
    2600  
    2601                !!---------------------------------------------------------------------- 
    2602                !! Detritus addition to benthos 
    2603                !! If activated, slow detritus in the bottom box will enter the 
    2604                !! benthic pool 
    2605                !!---------------------------------------------------------------------- 
    2606                !! 
    2607                if ((jk.eq.jmbathy) .and. jorgben.eq.1) then 
    2608                   !! this is the BOTTOM OCEAN BOX -> into the benthic pool! 
    2609                   !! 
    2610                   f_sbenin_n(ji,jj)  = (zdet * vsed * 86400.) 
    2611                   f_sbenin_fe(ji,jj) = (zdet * vsed * 86400. * xrfn) 
    2612 # if defined key_roam 
    2613                   f_sbenin_c(ji,jj)  = (zdtc * vsed * 86400.) 
    2614 # else 
    2615                   f_sbenin_c(ji,jj)  = (zdet * vsed * 86400. * xthetad) 
    2616 # endif 
    2617                endif 
    2618  
    2619                !!---------------------------------------------------------------------- 
    2620                !! Iron chemistry and fractionation 
    2621                !! following the Parekh et al. (2004) scheme adopted by the Met. 
    2622                !! Office, Medusa models total iron but considers "free" and 
    2623                !! ligand-bound forms for the purposes of scavenging (only "free" 
    2624                !! iron can be scavenged 
    2625                !!---------------------------------------------------------------------- 
    2626                !! 
    2627                !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
    2628                xFeT        = zfer * 1.e3 
    2629                !! 
    2630                !! calculate fractionation (based on Diat-HadOCC; in turn based on Parekh et al., 2004) 
    2631                xb_coef_tmp = xk_FeL * (xLgT - xFeT) - 1.0 
    2632                xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) + (4.0 * xk_FeL * xLgT)), 0.0) 
    2633                !! 
    2634                !! "free" ligand concentration 
    2635                xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL 
    2636                !! 
    2637                !! ligand-bound iron concentration 
    2638                xFeL        = xLgT - xLgF 
    2639                !! 
    2640                !! "free" iron concentration (and convert to mmol Fe / m3) 
    2641                xFeF        = (xFeT - xFeL) * 1.e-3 
    2642                xFree(ji,jj)= xFeF / (zfer + tiny(zfer)) 
    2643                !! 
    2644                !! scavenging of iron (multiple schemes); I'm only really happy with the  
    2645                !! first one at the moment - the others involve assumptions (sometimes 
    2646                !! guessed at by me) that are potentially questionable 
    2647                !! 
    2648                if (jiron.eq.1) then 
    2649                   !!---------------------------------------------------------------------- 
    2650                   !! Scheme 1: Dutkiewicz et al. (2005) 
    2651                   !! This scheme includes a single scavenging term based solely on a 
    2652                   !! fixed rate and the availablility of "free" iron 
    2653                   !!---------------------------------------------------------------------- 
    2654                   !! 
    2655                   ffescav     = xk_sc_Fe * xFeF                     ! = mmol/m3/d 
    2656                   !! 
    2657                   !!---------------------------------------------------------------------- 
    2658                   !! 
    2659                   !! Mick's code contains a further (optional) implicit "scavenging" of  
    2660                   !! iron that sets an upper bound on "free" iron concentration, and  
    2661                   !! essentially caps the concentration of total iron as xFeL + "free"  
    2662                   !! iron; since the former is constrained by a fixed total ligand  
    2663                   !! concentration (= 1.0 umol/m3), and the latter isn't allowed above  
    2664                   !! this upper bound, total iron is constrained to a maximum of ... 
    2665                   !! 
    2666                   !!    xFeL + min(xFeF, 0.3 umol/m3) = 1.0 + 0.3 = 1.3 umol / m3 
    2667                   !!  
    2668                   !! In Mick's code, the actual value of total iron is reset to this 
    2669                   !! sum (i.e. TFe = FeL + Fe'; but Fe' <= 0.3 umol/m3); this isn't 
    2670                   !! our favoured approach to tracer updating here (not least because 
    2671                   !! of the leapfrog), so here the amount scavenged is augmented by an 
    2672                   !! additional amount that serves to drag total iron back towards that 
    2673                   !! expected from this limitation on iron concentration ... 
    2674                   !! 
    2675                   xmaxFeF     = min((xFeF * 1.e3), 0.3)             ! = umol/m3 
    2676                   !! 
    2677                   !! Here, the difference between current total Fe and (FeL + Fe') is 
    2678                   !! calculated and added to the scavenging flux already calculated 
    2679                   !! above ... 
    2680                   !! 
    2681                   fdeltaFe    = (xFeT - (xFeL + xmaxFeF)) * 1.e-3   ! = mmol/m3 
    2682                   !! 
    2683                   !! This assumes that the "excess" iron is dissipated with a time- 
    2684                   !! scale of 1 day; seems reasonable to me ... (famous last words) 
    2685                   !! 
    2686                   ffescav     = ffescav + fdeltaFe                  ! = mmol/m3/d 
    2687                   !! 
    2688 # if defined key_deep_fe_fix 
    2689                   !! AXY (17/01/13) 
    2690                   !! stop scavenging for iron concentrations below 0.5 umol / m3 
    2691                   !! at depths greater than 1000 m; this aims to end MEDUSA's 
    2692                   !! continual loss of iron at depth without impacting things 
    2693                   !! at the surface too much; the justification for this is that 
    2694                   !! it appears to be what Mick Follows et al. do in their work 
    2695                   !! (as evidenced by the iron initial condition they supplied 
    2696                   !! me with); to be honest, it looks like Follow et al. do this 
    2697                   !! at shallower depths than 1000 m, but I'll stick with this 
    2698                   !! for now; I suspect that this seemingly arbitrary approach 
    2699                   !! effectively "parameterises" the particle-based scavenging 
    2700                   !! rates that other models use (i.e. at depth there are no 
    2701                   !! sinking particles, so scavenging stops); it might be fun 
    2702                   !! justifying this in a paper though! 
    2703                   !! 
    2704                   if ((fdep.gt.1000.) .and. (xFeT.lt.0.5)) then 
    2705                      ffescav = 0. 
    2706                   endif 
    2707 # endif 
    2708                   !! 
    2709                elseif (jiron.eq.2) then 
    2710                   !!---------------------------------------------------------------------- 
    2711                   !! Scheme 2: Moore et al. (2004) 
    2712                   !! This scheme includes a single scavenging term that accounts for 
    2713                   !! both suspended and sinking particles in the water column; this 
    2714                   !! term scavenges total iron rather than "free" iron 
    2715                   !!---------------------------------------------------------------------- 
    2716                   !! 
    2717                   !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
    2718                   xFeT        = zfer * 1.e3 
    2719                   !! 
    2720                   !! this has a base scavenging rate (12% / y) which is modified by local 
    2721                   !! particle concentration and sinking flux (and dust - but I'm ignoring 
    2722                   !! that here for now) and which is accelerated when Fe concentration gets 
    2723                   !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as concentrations 
    2724                   !! below 0.4 nM (= 0.4 umol/m3 = 0.0004 mmol/m3) 
    2725                   !! 
    2726                   !! base scavenging rate (0.12 / y) 
    2727                   fbase_scav = 0.12 / 365.25 
    2728                   !! 
    2729                   !! calculate sinking particle part of scaling factor 
    2730                   !! this takes local fast sinking carbon (mmol C / m2 / d) and 
    2731                   !! gets it into nmol C / cm3 / s ("rdt" below is the number of seconds in 
    2732                   !! a model timestep) 
    2733                   !! 
    2734                   !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.) 
    2735                   !! 
    2736                   !! ... actually, re-reading Moore et al.'s equations, it looks like he uses 
    2737                   !! his sinking flux directly, without scaling it by time-step or anything, 
    2738                   !! so I'll copy this here ... 
    2739                   !! 
    2740                   fscal_sink = ffastc(ji,jj) * 1.e2 
    2741                   !! 
    2742                   !! calculate particle part of scaling factor 
    2743                   !! this totals up the carbon in suspended particles (Pn, Pd, Zmi, Zme, D), 
    2744                   !! which comes out in mmol C / m3 (= nmol C / cm3), and then multiplies it 
    2745                   !! by a magic factor, 0.002, to get it into nmol C / cm2 / s 
    2746                   !! 
    2747                   fscal_part = ((xthetapn * zphn) + (xthetapd * zphd) + (xthetazmi * zzmi) + & 
    2748                   (xthetazme * zzme) + (xthetad * zdet)) * 0.002 
    2749                   !! 
    2750                   !! calculate scaling factor for base scavenging rate 
    2751                   !! this uses the (now correctly scaled) sinking flux and standing 
    2752                   !! particle concentration, divides through by some sort of reference 
    2753                   !! value (= 0.0066 nmol C / cm2 / s) and then uses this, or not if its 
    2754                   !! too high, to rescale the base scavenging rate 
    2755                   !! 
    2756                   fscal_scav = fbase_scav * min(((fscal_sink + fscal_part) / 0.0066), 4.0) 
    2757                   !! 
    2758                   !! the resulting scavenging rate is then scaled further according to the 
    2759                   !! local iron concentration (i.e. diminished in low iron regions; enhanced 
    2760                   !! in high iron regions; less alone in intermediate iron regions) 
    2761                   !! 
    2762                   if (xFeT.lt.0.4) then 
    2763                      !! 
    2764                      !! low iron region 
    2765                      !! 
    2766                      fscal_scav = fscal_scav * (xFeT / 0.4) 
    2767                      !! 
    2768                   elseif (xFeT.gt.0.6) then 
    2769                      !! 
    2770                      !! high iron region 
    2771                      !! 
    2772                      fscal_scav = fscal_scav + ((xFeT / 0.6) * (6.0 / 1.4)) 
    2773                      !! 
    2774                   else 
    2775                      !! 
    2776                      !! intermediate iron region: do nothing 
    2777                      !! 
    2778                   endif 
    2779                   !!  
    2780                   !! apply the calculated scavenging rate ... 
    2781                   !! 
    2782                   ffescav = fscal_scav * zfer 
    2783                   !! 
    2784                elseif (jiron.eq.3) then 
    2785                   !!---------------------------------------------------------------------- 
    2786                   !! Scheme 3: Moore et al. (2008) 
    2787                   !! This scheme includes a single scavenging term that accounts for 
    2788                   !! sinking particles in the water column, and includes organic C, 
    2789                   !! biogenic opal, calcium carbonate and dust in this (though the 
    2790                   !! latter is ignored here until I work out what units the incoming 
    2791                   !! "dust" flux is in); this term scavenges total iron rather than  
    2792                   !! "free" iron 
    2793                   !!---------------------------------------------------------------------- 
    2794                   !! 
    2795                   !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 
    2796                   xFeT        = zfer * 1.e3 
    2797                   !! 
    2798                   !! this has a base scavenging rate which is modified by local 
    2799                   !! particle sinking flux (including dust - but I'm ignoring that  
    2800                   !! here for now) and which is accelerated when Fe concentration 
    2801                   !! is > 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as  
    2802                   !! concentrations < 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3) 
    2803                   !! 
    2804                   !! base scavenging rate (Fe_b in paper; units may be wrong there) 
    2805                   fbase_scav = 0.00384 ! (ng)^-1 cm 
    2806                   !! 
    2807                   !! calculate sinking particle part of scaling factor; this converts 
    2808                   !! mmol / m2 / d fluxes of organic carbon, silicon and calcium 
    2809                   !! carbonate into ng / cm2 / s fluxes; it is assumed here that the 
    2810                   !! mass conversions simply consider the mass of the main element 
    2811                   !! (C, Si and Ca) and *not* the mass of the molecules that they are 
    2812                   !! part of; Moore et al. (2008) is unclear on the conversion that 
    2813                   !! should be used 
    2814                   !! 
    2815                   !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s 
    2816                   fscal_csink  = (ffastc(ji,jj)  * 1.e6 * xmassc  * 1.e-4 / 86400.)      ! ng C  / cm2 / s 
    2817                   fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi * 1.e-4 / 86400.)      ! ng Si / cm2 / s 
    2818                   fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca * 1.e-4 / 86400.)      ! ng Ca / cm2 / s 
    2819                   !!  
    2820                   !! sum up these sinking fluxes and convert to ng / cm by dividing 
    2821                   !! through by a sinking rate of 100 m / d = 1.157 cm / s 
    2822                   fscal_sink   = ((fscal_csink * 6.) + fscal_sisink + fscal_casink) / & 
    2823                   (100. * 1.e3 / 86400)                                                  ! ng / cm 
    2824                   !! 
    2825                   !! now calculate the scavenging rate based upon the base rate and 
    2826                   !! this particle flux scaling; according to the published units, 
    2827                   !! the result actually has *no* units, but as it must be expressed 
    2828                   !! per unit time for it to make any sense, I'm assuming a missing 
    2829                   !! "per second" 
    2830                   fscal_scav = fbase_scav * fscal_sink                                   ! / s 
    2831                   !! 
    2832                   !! the resulting scavenging rate is then scaled further according to the 
    2833                   !! local iron concentration (i.e. diminished in low iron regions; enhanced 
    2834                   !! in high iron regions; less alone in intermediate iron regions) 
    2835                   !! 
    2836                   if (xFeT.lt.0.5) then 
    2837                      !! 
    2838                      !! low iron region (0.5 instead of the 0.4 in Moore et al., 2004) 
    2839                      !! 
    2840                      fscal_scav = fscal_scav * (xFeT / 0.5) 
    2841                      !! 
    2842                   elseif (xFeT.gt.0.6) then 
    2843                      !! 
    2844                      !! high iron region (functional form different in Moore et al., 2004) 
    2845                      !! 
    2846                      fscal_scav = fscal_scav + ((xFeT - 0.6) * 0.00904) 
    2847                      !! 
    2848                   else 
    2849                      !! 
    2850                      !! intermediate iron region: do nothing 
    2851                      !! 
    2852                   endif 
    2853                   !!  
    2854                   !! apply the calculated scavenging rate ... 
    2855                   !! 
    2856                   ffescav = fscal_scav * zfer 
    2857                   !! 
    2858                elseif (jiron.eq.4) then 
    2859                   !!---------------------------------------------------------------------- 
    2860                   !! Scheme 4: Galbraith et al. (2010) 
    2861                   !! This scheme includes two scavenging terms, one for organic, 
    2862                   !! particle-based scavenging, and another for inorganic scavenging; 
    2863                   !! both terms scavenge "free" iron only 
    2864                   !!---------------------------------------------------------------------- 
    2865                   !! 
    2866                   !! Galbraith et al. (2010) present a more straightforward outline of  
    2867                   !! the scheme in Parekh et al. (2005) ... 
    2868                   !!  
    2869                   !! sinking particulate carbon available for scavenging 
    2870                   !! this assumes a sinking rate of 100 m / d (Moore & Braucher, 2008), 
    2871                   xCscav1     = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3 
    2872                   !!  
    2873                   !! scale by Honeyman et al. (1981) exponent coefficient 
    2874                   !! multiply by 1.e-3 to express C flux in g C rather than mg C 
    2875                   xCscav2     = (xCscav1 * 1.e-3)**0.58 
    2876                   !! 
    2877                   !! multiply by Galbraith et al. (2010) scavenging rate 
    2878                   xk_org      = 0.5 ! ((g C m/3)^-1) / d 
    2879                   xORGscav    = xk_org * xCscav2 * xFeF 
    2880                   !! 
    2881                   !! Galbraith et al. (2010) also include an inorganic bit ... 
    2882                   !!  
    2883                   !! this occurs at a fixed rate, again based on the availability of 
    2884                   !! "free" iron 
    2885                   !! 
    2886                   !! k_inorg  = 1000 d**-1 nmol Fe**-0.5 kg**-0.5 
    2887                   !! 
    2888                   !! to implement this here, scale xFeF by 1026 to put in units of 
    2889                   !! umol/m3 which approximately equal nmol/kg 
    2890                   !! 
    2891                   xk_inorg    = 1000. ! ((nmol Fe / kg)^1.5) 
    2892                   xINORGscav  = (xk_inorg * (xFeF * 1026.)**1.5) * 1.e-3 
    2893                   !! 
    2894                   !! sum these two terms together 
    2895                   ffescav     = xORGscav + xINORGscav 
    2896                else 
    2897                   !!---------------------------------------------------------------------- 
    2898                   !! No Scheme: you coward! 
    2899                   !! This scheme puts its head in the sand and eskews any decision about 
    2900                   !! how iron is removed from the ocean; prepare to get deluged in iron 
    2901                   !! you fool! 
    2902                   !!---------------------------------------------------------------------- 
    2903                   ffescav     = 0. 
    2904                endif 
    2905  
    2906                !!---------------------------------------------------------------------- 
    2907                !! Other iron cycle processes 
    2908                !!---------------------------------------------------------------------- 
    2909                !! 
    2910                !! aeolian iron deposition 
    2911                if (jk.eq.1) then 
    2912                   !! zirondep   is in mmol-Fe / m2 / day 
    2913                   !! ffetop     is in mmol-dissolved-Fe / m3 / day 
    2914                   ffetop  = zirondep(ji,jj) * xfe_sol / fthk  
    2915                else 
    2916                   ffetop  = 0.0 
    2917                endif 
    2918                !! 
    2919                !! seafloor iron addition 
    2920                !! AXY (10/07/12): amended to only apply sedimentary flux up to ~500 m down 
    2921                !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then 
    2922                if ((jk.eq.jmbathy).AND.jk.le.i0500) then 
    2923                   !! Moore et al. (2004) cite a coastal California value of 5 umol/m2/d, but adopt a 
    2924                   !! global value of 2 umol/m2/d for all areas < 1100 m; here we use this latter value 
    2925                   !! but apply it everywhere 
    2926                   !! AXY (21/07/09): actually, let's just apply it below 1100 m (levels 1-37) 
    2927                   ffebot  = (xfe_sed / fthk) 
    2928                else 
    2929                   ffebot  = 0.0 
    2930                endif 
    2931  
    2932                !! AXY (16/12/09): remove iron addition/removal processes 
    2933                !! For the purposes of the quarter degree run, the iron cycle is being pegged to the 
    2934                !! initial condition supplied by Mick Follows via restoration with a 30 day period; 
    2935                !! iron addition at the seafloor is still permitted with the idea that this extra 
    2936                !! iron will be removed by the restoration away from the source 
    2937                !! ffescav = 0.0 
    2938                !! ffetop  = 0.0 
    2939                !! ffebot  = 0.0 
    2940  
    2941 # if defined key_debug_medusa 
    2942                !! report miscellaneous calculations 
    2943                if (idf.eq.1.AND.idfval.eq.1) then 
    2944                   IF (lwp) write (numout,*) '------------------------------' 
    2945                   IF (lwp) write (numout,*) 'xfe_sol  = ', xfe_sol 
    2946                   IF (lwp) write (numout,*) 'xfe_mass = ', xfe_mass 
    2947                   IF (lwp) write (numout,*) 'ffetop(',jk,')  = ', ffetop 
    2948                   IF (lwp) write (numout,*) 'ffebot(',jk,')  = ', ffebot 
    2949                   IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree(ji,jj) 
    2950                   IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav 
    2951                endif 
    2952 # endif 
    2953  
    2954                !!---------------------------------------------------------------------- 
    2955                !! Miscellaneous 
    2956                !!---------------------------------------------------------------------- 
    2957                !! 
    2958                !! diatom frustule dissolution 
    2959                fsdiss  = xsdiss * zpds 
    2960  
    2961 # if defined key_debug_medusa 
    2962                !! report miscellaneous calculations 
    2963                if (idf.eq.1.AND.idfval.eq.1) then 
    2964                   IF (lwp) write (numout,*) '------------------------------' 
    2965                   IF (lwp) write (numout,*) 'fsdiss(',jk,')  = ', fsdiss 
    2966                endif 
    2967 # endif 
    2968  
    2969                !!---------------------------------------------------------------------- 
    2970                !! Slow detritus creation 
    2971                !!---------------------------------------------------------------------- 
    2972                !! this variable integrates the creation of slow sinking detritus 
    2973                !! to allow the split between fast and slow detritus to be  
    2974                !! diagnosed 
    2975                fslown  = fdpn + fdzmi + ((1.0 - xfdfrac1) * fdpd) + & 
    2976                ((1.0 - xfdfrac2) * fdzme) + ((1.0 - xbetan) * (finmi + finme)) 
    2977                !! 
    2978                !! this variable records the slow detrital sinking flux at this 
    2979                !! particular depth; it is used in the output of this flux at 
    2980                !! standard depths in the diagnostic outputs; needs to be 
    2981                !! adjusted from per second to per day because of parameter vsed 
    2982                fslownflux(ji,jj) = zdet * vsed * 86400. 
    2983 # if defined key_roam 
    2984                !! 
    2985                !! and the same for detrital carbon 
    2986                fslowc  = (xthetapn * fdpn) + (xthetazmi * fdzmi) + & 
    2987                (xthetapd * (1.0 - xfdfrac1) * fdpd) + & 
    2988                (xthetazme * (1.0 - xfdfrac2) * fdzme) + & 
    2989                ((1.0 - xbetac) * (ficmi + ficme)) 
    2990                !! 
    2991                !! this variable records the slow detrital sinking flux at this 
    2992                !! particular depth; it is used in the output of this flux at 
    2993                !! standard depths in the diagnostic outputs; needs to be 
    2994                !! adjusted from per second to per day because of parameter vsed 
    2995                fslowcflux(ji,jj) = zdtc * vsed * 86400. 
    2996 # endif 
    2997  
    2998                !!---------------------------------------------------------------------- 
    2999                !! Nutrient regeneration 
    3000                !! this variable integrates total nitrogen regeneration down the 
    3001                !! watercolumn; its value is stored and output as a 2D diagnostic; 
    3002                !! the corresponding dissolution flux of silicon (from sources 
    3003                !! other than fast detritus) is also integrated; note that, 
    3004                !! confusingly, the linear loss terms from plankton compartments 
    3005                !! are labelled as fdX2 when one might have expected fdX or fdX1 
    3006                !!---------------------------------------------------------------------- 
    3007                !! 
    3008                !! nitrogen 
    3009                fregen   = (( (xphi * (fgmipn + fgmid)) +                &  ! messy feeding 
    3010                (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) +           &  ! messy feeding 
    3011                fmiexcr + fmeexcr + fdd +                                &  ! excretion + D remin. 
    3012                fdpn2 + fdpd2 + fdzmi2 + fdzme2) * fthk)                    ! linear mortality 
    3013                !! 
    3014                !! silicon 
    3015                fregensi = (( fsdiss + ((1.0 - xfdfrac1) * fdpds) +      &  ! dissolution + non-lin. mortality 
    3016                ((1.0 - xfdfrac3) * fgmepds) +                           &  ! egestion by zooplankton 
    3017                fdpds2) * fthk)                                             ! linear mortality 
    3018 # if defined key_roam 
    3019                !! 
    3020                !! carbon 
    3021                fregenc  = (( (xphi * ((xthetapn * fgmipn) + fgmidc)) +  &  ! messy feeding 
    3022                (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) +     &  ! messy feeding 
    3023                (xthetazmi * fgmezmi) + fgmedc)) +                       &  ! messy feeding 
    3024                fmiresp + fmeresp + fddc +                               &  ! respiration + D remin. 
    3025                (xthetapn * fdpn2) + (xthetapd * fdpd2) +                &  ! linear mortality 
    3026                (xthetazmi * fdzmi2) + (xthetazme * fdzme2)) * fthk)        ! linear mortality 
    3027 # endif 
    3028  
    3029                !!---------------------------------------------------------------------- 
    3030                !! Fast-sinking detritus terms 
    3031                !! "local" variables declared so that conservation can be checked; 
    3032                !! the calculated terms are added to the fast-sinking flux later on 
    3033                !! only after the flux entering this level has experienced some 
    3034                !! remineralisation 
    3035                !! note: these fluxes need to be scaled by the level thickness 
    3036                !!---------------------------------------------------------------------- 
    3037                !! 
    3038                !! nitrogen:   diatom and mesozooplankton mortality 
    3039                ftempn         = b0 * ((xfdfrac1 * fdpd)  + (xfdfrac2 * fdzme)) 
    3040                !! 
    3041                !! silicon:    diatom mortality and grazed diatoms 
    3042                ftempsi        = b0 * ((xfdfrac1 * fdpds) + (xfdfrac3 * fgmepds)) 
    3043                !! 
    3044                !! iron:       diatom and mesozooplankton mortality 
    3045                ftempfe        = b0 * (((xfdfrac1 * fdpd) + (xfdfrac2 * fdzme)) * xrfn) 
    3046                !! 
    3047                !! carbon:     diatom and mesozooplankton mortality 
    3048                ftempc         = b0 * ((xfdfrac1 * xthetapd * fdpd) + &  
    3049                                 (xfdfrac2 * xthetazme * fdzme)) 
    3050                !! 
    3051 # if defined key_roam 
    3052                if (jrratio.eq.0) then 
    3053                   !! CaCO3:      latitudinally-based fraction of total primary production 
    3054                   !!               absolute latitude of current grid cell 
    3055                   flat           = abs(gphit(ji,jj)) 
    3056                   !!               0.10 at equator; 0.02 at pole 
    3057                   fcaco3         = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0)) 
    3058                elseif (jrratio.eq.1) then 
    3059                   !! CaCO3:      Ridgwell et al. (2007) submodel, version 1 
    3060                   !!             this uses SURFACE omega calcite to regulate rain ratio 
    3061                   if (f_omcal(ji,jj).ge.1.0) then 
    3062                      fq1 = (f_omcal(ji,jj) - 1.0)**0.81 
    3063                   else 
    3064                      fq1 = 0. 
    3065                   endif 
    3066                   fcaco3 = xridg_r0 * fq1 
    3067                elseif (jrratio.eq.2) then 
    3068                   !! CaCO3:      Ridgwell et al. (2007) submodel, version 2 
    3069                   !!             this uses FULL 3D omega calcite to regulate rain ratio 
    3070                   if (f3_omcal(ji,jj,jk).ge.1.0) then 
    3071                      fq1 = (f3_omcal(ji,jj,jk) - 1.0)**0.81 
    3072                   else 
    3073                      fq1 = 0. 
    3074                   endif 
    3075                   fcaco3 = xridg_r0 * fq1 
    3076                endif 
    3077 # else 
    3078                !! CaCO3:      latitudinally-based fraction of total primary production 
    3079                !!               absolute latitude of current grid cell 
    3080                flat           = abs(gphit(ji,jj)) 
    3081                !!               0.10 at equator; 0.02 at pole 
    3082                fcaco3         = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0)) 
    3083 # endif 
    3084                !! AXY (09/03/09): convert CaCO3 production from function of  
    3085                !! primary production into a function of fast-sinking material;  
    3086                !! technically, this is what Dunne et al. (2007) do anyway; they  
    3087                !! convert total primary production estimated from surface  
    3088                !! chlorophyll to an export flux for which they apply conversion  
    3089                !! factors to estimate the various elemental fractions (Si, Ca) 
    3090                ftempca        = ftempc * fcaco3 
    3091  
    3092 # if defined key_debug_medusa 
    3093                !! integrate total fast detritus production 
    3094                if (idf.eq.1) then 
    3095                   fifd_n(ji,jj)  = fifd_n(ji,jj)  + (ftempn  * fthk) 
    3096                   fifd_si(ji,jj) = fifd_si(ji,jj) + (ftempsi * fthk) 
    3097                   fifd_fe(ji,jj) = fifd_fe(ji,jj) + (ftempfe * fthk) 
    3098 #  if defined key_roam 
    3099                   fifd_c(ji,jj)  = fifd_c(ji,jj)  + (ftempc  * fthk) 
    3100 #  endif 
    3101                endif 
    3102  
    3103                !! report quantities of fast-sinking detritus for each component 
    3104                if (idf.eq.1.AND.idfval.eq.1) then 
    3105                   IF (lwp) write (numout,*) '------------------------------' 
    3106                   IF (lwp) write (numout,*) 'fdpd(',jk,')    = ', fdpd 
    3107                   IF (lwp) write (numout,*) 'fdzme(',jk,')   = ', fdzme 
    3108                   IF (lwp) write (numout,*) 'ftempn(',jk,')  = ', ftempn 
    3109                   IF (lwp) write (numout,*) 'ftempsi(',jk,') = ', ftempsi 
    3110                   IF (lwp) write (numout,*) 'ftempfe(',jk,') = ', ftempfe 
    3111                   IF (lwp) write (numout,*) 'ftempc(',jk,')  = ', ftempc 
    3112                   IF (lwp) write (numout,*) 'ftempca(',jk,') = ', ftempca 
    3113                   IF (lwp) write (numout,*) 'flat(',jk,')    = ', flat 
    3114                   IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3 
    3115                endif 
    3116 # endif 
    3117  
    3118                !!---------------------------------------------------------------------- 
    3119                !! This version of MEDUSA offers a choice of three methods for 
    3120                !! handling the remineralisation of fast detritus.  All three 
    3121                !! do so in broadly the same way: 
    3122                !! 
    3123                !!   1.  Fast detritus is stored as a 2D array                   [ ffastX  ] 
    3124                !!   2.  Fast detritus is added level-by-level                   [ ftempX  ] 
    3125                !!   3.  Fast detritus is not remineralised in the top box       [ freminX ] 
    3126                !!   4.  Remaining fast detritus is remineralised in the bottom  [ fsedX   ] 
    3127                !!       box 
    3128                !! 
    3129                !! The three remineralisation methods are: 
    3130                !!    
    3131                !!   1.  Ballast model (i.e. that published in Yool et al., 2011) 
    3132                !!  (1b. Ballast-sans-ballast model) 
    3133                !!   2.  Martin et al. (1987) 
    3134                !!   3.  Henson et al. (2011) 
    3135                !!  
    3136                !! The first of these couples C, N and Fe remineralisation to 
    3137                !! the remineralisation of particulate Si and CaCO3, but the  
    3138                !! latter two treat remineralisation of C, N, Fe, Si and CaCO3 
    3139                !! completely separately.  At present a switch within the code 
    3140                !! regulates which submodel is used, but this should be moved 
    3141                !! to the namelist file. 
    3142                !!  
    3143                !! The ballast-sans-ballast submodel is an original development 
    3144                !! feature of MEDUSA in which the ballast submodel's general 
    3145                !! framework and parameterisation is used, but in which there 
    3146                !! is no protection of organic material afforded by ballasting 
    3147                !! minerals.  While similar, it is not the same as the Martin  
    3148                !! et al. (1987) submodel. 
    3149                !! 
    3150                !! Since the three submodels behave the same in terms of 
    3151                !! accumulating sinking material and remineralising it all at 
    3152                !! the seafloor, these portions of the code below are common to 
    3153                !! all three. 
    3154                !!---------------------------------------------------------------------- 
    3155  
    3156                if (jexport.eq.1) then 
    3157                   !!====================================================================== 
    3158                   !! BALLAST SUBMODEL 
    3159                   !!====================================================================== 
    3160                   !!  
    3161                   !!---------------------------------------------------------------------- 
    3162                   !! Fast-sinking detritus fluxes, pt. 1: REMINERALISATION 
    3163                   !! aside from explicitly modelled, slow-sinking detritus, the 
    3164                   !! model includes an implicit representation of detrital 
    3165                   !! particles that sink too quickly to be modelled with 
    3166                   !! explicit state variables; this sinking flux is instead 
    3167                   !! instantaneously remineralised down the water column using 
    3168                   !! the version of Armstrong et al. (2002)'s ballast model 
    3169                   !! used by Dunne et al. (2007); the version of this model 
    3170                   !! here considers silicon and calcium carbonate ballast 
    3171                   !! minerals; this section of the code redistributes the fast 
    3172                   !! sinking material generated locally down the water column; 
    3173                   !! this differs from Dunne et al. (2007) in that fast sinking 
    3174                   !! material is distributed at *every* level below that it is 
    3175                   !! generated, rather than at every level below some fixed 
    3176                   !! depth; this scheme is also different in that sinking material  
    3177                   !! generated in one level is aggregated with that generated by 
    3178                   !! shallower levels; this should make the ballast model more 
    3179                   !! self-consistent (famous last words) 
    3180                   !!---------------------------------------------------------------------- 
    3181                   !! 
    3182                   if (jk.eq.1) then 
    3183                      !! this is the SURFACE OCEAN BOX (no remineralisation) 
    3184                      !! 
    3185                      freminc  = 0.0 
    3186                      freminn  = 0.0 
    3187                      freminfe = 0.0 
    3188                      freminsi = 0.0 
    3189                      freminca = 0.0 
    3190                   elseif (jk.le.jmbathy) then 
    3191                      !! this is an OCEAN BOX (remineralise some material) 
    3192                      !! 
    3193                      !! set up CCD depth to be used depending on user choice 
    3194                      if (jocalccd.eq.0) then 
    3195                         !! use default CCD field 
    3196                         fccd_dep = ocal_ccd(ji,jj) 
    3197                      elseif (jocalccd.eq.1) then 
    3198                         !! use calculated CCD field 
    3199                         fccd_dep = f2_ccd_cal(ji,jj) 
    3200                      endif 
    3201                      !! 
    3202                      !! === organic carbon === 
    3203                      fq0      = ffastc(ji,jj)                        !! how much organic C enters this box        (mol) 
    3204                      if (iball.eq.1) then 
    3205                         fq1      = (fq0 * xmassc)                    !! how much it weighs                        (mass) 
    3206                         fq2      = (ffastca(ji,jj) * xmassca)        !! how much CaCO3 enters this box            (mass) 
    3207                         fq3      = (ffastsi(ji,jj) * xmasssi)        !! how much  opal enters this box            (mass) 
    3208                         fq4      = (fq2 * xprotca) + (fq3 * xprotsi) !! total protected organic C                 (mass) 
    3209                         !! this next term is calculated for C but used for N and Fe as well 
    3210                         !! it needs to be protected in case ALL C is protected 
    3211                         if (fq4.lt.fq1) then 
    3212                            fprotf   = (fq4 / (fq1 + tiny(fq1)))      !! protected fraction of total organic C     (non-dim) 
    3213                         else 
    3214                            fprotf   = 1.0                            !! all organic C is protected                (non-dim) 
    3215                         endif 
    3216                         fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic C   (non-dim) 
    3217                         fq6      = (fq0 * fq5)                       !! how much organic C is unprotected         (mol) 
    3218                         fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected C leaves this box    (mol) 
    3219                         fq8      = (fq7 + (fq0 * fprotf))            !! how much total C leaves this box          (mol) 
    3220                         freminc  = (fq0 - fq8) / fthk                !! C remineralisation in this box            (mol) 
    3221                         ffastc(ji,jj) = fq8                           
    3222 # if defined key_debug_medusa 
    3223                         !! report in/out/remin fluxes of carbon for this level 
    3224                            if (idf.eq.1.AND.idfval.eq.1) then 
    3225                               IF (lwp) write (numout,*) '------------------------------' 
    3226                               IF (lwp) write (numout,*) 'totalC(',jk,')  = ', fq1 
    3227                               IF (lwp) write (numout,*) 'prtctC(',jk,')  = ', fq4 
    3228                               IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', fprotf 
    3229                               IF (lwp) write (numout,*) '------------------------------' 
    3230                               IF (lwp) write (numout,*) 'IN   C(',jk,')  = ', fq0 
    3231                               IF (lwp) write (numout,*) 'LOST C(',jk,')  = ', freminc * fthk 
    3232                               IF (lwp) write (numout,*) 'OUT  C(',jk,')  = ', fq8 
    3233                               IF (lwp) write (numout,*) 'NEW  C(',jk,')  = ', ftempc * fthk 
    3234                            endif 
    3235 # endif 
    3236                         else 
    3237                         fq1      = fq0 * exp(-(fthk / xfastc))       !! how much organic C leaves this box        (mol) 
    3238                         freminc  = (fq0 - fq1) / fthk                !! C remineralisation in this box            (mol) 
    3239                         ffastc(ji,jj)  = fq1 
    3240                      endif 
    3241                      !! 
    3242                      !! === organic nitrogen === 
    3243                      fq0      = ffastn(ji,jj)                        !! how much organic N enters this box        (mol) 
    3244                      if (iball.eq.1) then 
    3245                         fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic N   (non-dim) 
    3246                         fq6      = (fq0 * fq5)                       !! how much organic N is unprotected         (mol) 
    3247                         fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected N leaves this box    (mol) 
    3248                         fq8      = (fq7 + (fq0 * fprotf))            !! how much total N leaves this box          (mol) 
    3249                         freminn  = (fq0 - fq8) / fthk                !! N remineralisation in this box            (mol) 
    3250                         ffastn(ji,jj)  = fq8 
    3251 # if defined key_debug_medusa 
    3252                         !! report in/out/remin fluxes of carbon for this level 
    3253                         if (idf.eq.1.AND.idfval.eq.1) then 
    3254                            IF (lwp) write (numout,*) '------------------------------' 
    3255                            IF (lwp) write (numout,*) 'totalN(',jk,')  = ', fq1 
    3256                            IF (lwp) write (numout,*) 'prtctN(',jk,')  = ', fq4 
    3257                            IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', fprotf 
    3258                            IF (lwp) write (numout,*) '------------------------------' 
    3259                            if (freminn < 0.0) then 
    3260                               IF (lwp) write (numout,*) '** FREMIN ERROR **' 
    3261                            endif 
    3262                            IF (lwp) write (numout,*) 'IN   N(',jk,')  = ', fq0 
    3263                            IF (lwp) write (numout,*) 'LOST N(',jk,')  = ', freminn * fthk 
    3264                            IF (lwp) write (numout,*) 'OUT  N(',jk,')  = ', fq8 
    3265                            IF (lwp) write (numout,*) 'NEW  N(',jk,')  = ', ftempn * fthk 
    3266                         endif 
    3267 # endif 
    3268                      else 
    3269                         fq1      = fq0 * exp(-(fthk / xfastc))       !! how much organic N leaves this box        (mol) 
    3270                         freminn  = (fq0 - fq1) / fthk                !! N remineralisation in this box            (mol) 
    3271                         ffastn(ji,jj)  = fq1 
    3272                      endif 
    3273                      !! 
    3274                      !! === organic iron === 
    3275                      fq0      = ffastfe(ji,jj)                       !! how much organic Fe enters this box       (mol) 
    3276                      if (iball.eq.1) then 
    3277                         fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic Fe  (non-dim) 
    3278                         fq6      = (fq0 * fq5)                       !! how much organic Fe is unprotected        (mol) 
    3279                         fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected Fe leaves this box   (mol) 
    3280                         fq8      = (fq7 + (fq0 * fprotf))            !! how much total Fe leaves this box         (mol)             
    3281                         freminfe = (fq0 - fq8) / fthk                !! Fe remineralisation in this box           (mol) 
    3282                         ffastfe(ji,jj) = fq8 
    3283                      else 
    3284                         fq1      = fq0 * exp(-(fthk / xfastc))       !! how much total Fe leaves this box         (mol)       
    3285                         freminfe = (fq0 - fq1) / fthk                !! Fe remineralisation in this box           (mol) 
    3286                         ffastfe(ji,jj) = fq1 
    3287                      endif 
    3288                      !! 
    3289                      !! === biogenic silicon === 
    3290                      fq0      = ffastsi(ji,jj)                       !! how much  opal centers this box           (mol)  
    3291                      fq1      = fq0 * exp(-(fthk / xfastsi))         !! how much  opal leaves this box            (mol) 
    3292                      freminsi = (fq0 - fq1) / fthk                   !! Si remineralisation in this box           (mol) 
    3293                      ffastsi(ji,jj) = fq1 
    3294                      !! 
    3295                      !! === biogenic calcium carbonate === 
    3296                      fq0      = ffastca(ji,jj)                       !! how much CaCO3 enters this box            (mol) 
    3297                      if (fdep.le.fccd_dep) then 
    3298                         !! whole grid cell above CCD 
    3299                         fq1      = fq0                               !! above lysocline, no Ca dissolves          (mol) 
    3300                         freminca = 0.0                               !! above lysocline, no Ca dissolves          (mol) 
    3301                         fccd(ji,jj) = real(jk)                       !! which is the last level above the CCD?    (#) 
    3302                      elseif (fdep.ge.fccd_dep) then 
    3303                         !! whole grid cell below CCD 
    3304                         fq1      = fq0 * exp(-(fthk / xfastca))      !! how much CaCO3 leaves this box            (mol) 
    3305                         freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol) 
    3306                      else 
    3307                         !! partial grid cell below CCD 
    3308                         fq2      = fdep1 - fccd_dep                  !! amount of grid cell below CCD             (m) 
    3309                         fq1      = fq0 * exp(-(fq2 / xfastca))       !! how much CaCO3 leaves this box            (mol) 
    3310                         freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol) 
    3311                      endif 
    3312                      ffastca(ji,jj) = fq1  
    3313                   else 
    3314                      !! this is BELOW THE LAST OCEAN BOX (do nothing) 
    3315                      freminc  = 0.0 
    3316                      freminn  = 0.0 
    3317                      freminfe = 0.0 
    3318                      freminsi = 0.0 
    3319                      freminca = 0.0               
    3320                   endif 
    3321  
    3322                elseif (jexport.eq.2.or.jexport.eq.3) then 
    3323                   if (jexport.eq.2) then 
    3324                      !!====================================================================== 
    3325                      !! MARTIN ET AL. (1987) SUBMODEL 
    3326                      !!====================================================================== 
    3327                      !!  
    3328                      !!---------------------------------------------------------------------- 
    3329                      !! This submodel uses the classic Martin et al. (1987) curve 
    3330                      !! to determine the attenuation of fast-sinking detritus down 
    3331                      !! the water column.  All three organic elements, C, N and Fe, 
    3332                      !! are handled identically, and their quantities in sinking 
    3333                      !! particles attenuate according to a power relationship 
    3334                      !! governed by parameter "b".  This is assigned a canonical  
    3335                      !! value of -0.858.  Biogenic opal and calcium carbonate are 
    3336                      !! attentuated using the same function as in the ballast 
    3337                      !! submodel 
    3338                      !!---------------------------------------------------------------------- 
    3339                      !! 
    3340                      fb_val = -0.858 
    3341                   elseif (jexport.eq.3) then 
    3342                      !!====================================================================== 
    3343                      !! HENSON ET AL. (2011) SUBMODEL 
    3344                      !!====================================================================== 
    3345                      !! 
    3346                      !!---------------------------------------------------------------------- 
    3347                      !! This submodel reconfigures the Martin et al. (1987) curve by 
    3348                      !! allowing the "b" value to vary geographically.  Its value is 
    3349                      !! set, following Henson et al. (2011), as a function of local 
    3350                      !! sea surface temperature: 
    3351                      !!   b = -1.06 + (0.024 * SST) 
    3352                      !! This means that remineralisation length scales are longer in 
    3353                      !! warm, tropical areas and shorter in cold, polar areas.  This 
    3354                      !! does seem back-to-front (i.e. one would expect GREATER 
    3355                      !! remineralisation in warmer waters), but is an outcome of  
    3356                      !! analysis of sediment trap data, and it may reflect details 
    3357                      !! of ecosystem structure that pertain to particle production 
    3358                      !! rather than simply Q10. 
    3359                      !!---------------------------------------------------------------------- 
    3360                      !! 
    3361                      fl_sst = tsn(ji,jj,1,jp_tem) 
    3362                      fb_val = -1.06 + (0.024 * fl_sst) 
    3363                   endif 
    3364                   !!    
    3365                   if (jk.eq.1) then 
    3366                      !! this is the SURFACE OCEAN BOX (no remineralisation) 
    3367                      !! 
    3368                      freminc  = 0.0 
    3369                      freminn  = 0.0 
    3370                      freminfe = 0.0 
    3371                      freminsi = 0.0 
    3372                      freminca = 0.0 
    3373                   elseif (jk.le.jmbathy) then 
    3374                      !! this is an OCEAN BOX (remineralise some material) 
    3375                      !! 
    3376                      !! === organic carbon === 
    3377                      fq0      = ffastc(ji,jj)                        !! how much organic C enters this box        (mol) 
    3378                      fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic C leaves this box        (mol) 
    3379                      freminc  = (fq0 - fq1) / fthk                   !! C remineralisation in this box            (mol) 
    3380                      ffastc(ji,jj)  = fq1 
    3381                      !! 
    3382                      !! === organic nitrogen === 
    3383                      fq0      = ffastn(ji,jj)                        !! how much organic N enters this box        (mol) 
    3384                      fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic N leaves this box        (mol) 
    3385                      freminn  = (fq0 - fq1) / fthk                   !! N remineralisation in this box            (mol) 
    3386                      ffastn(ji,jj)  = fq1 
    3387                      !! 
    3388                      !! === organic iron === 
    3389                      fq0      = ffastfe(ji,jj)                       !! how much organic Fe enters this box       (mol) 
    3390                      fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic Fe leaves this box       (mol) 
    3391                      freminfe = (fq0 - fq1) / fthk                   !! Fe remineralisation in this box           (mol) 
    3392                      ffastfe(ji,jj) = fq1 
    3393                      !! 
    3394                      !! === biogenic silicon === 
    3395                      fq0      = ffastsi(ji,jj)                       !! how much  opal centers this box           (mol)  
    3396                      fq1      = fq0 * exp(-(fthk / xfastsi))         !! how much  opal leaves this box            (mol) 
    3397                      freminsi = (fq0 - fq1) / fthk                   !! Si remineralisation in this box           (mol) 
    3398                      ffastsi(ji,jj) = fq1 
    3399                      !! 
    3400                      !! === biogenic calcium carbonate === 
    3401                      fq0      = ffastca(ji,jj)                       !! how much CaCO3 enters this box            (mol) 
    3402                      if (fdep.le.ocal_ccd(ji,jj)) then 
    3403                         !! whole grid cell above CCD 
    3404                         fq1      = fq0                               !! above lysocline, no Ca dissolves          (mol) 
    3405                         freminca = 0.0                               !! above lysocline, no Ca dissolves          (mol) 
    3406                         fccd(ji,jj) = real(jk)                       !! which is the last level above the CCD?    (#) 
    3407                      elseif (fdep.ge.ocal_ccd(ji,jj)) then 
    3408                         !! whole grid cell below CCD 
    3409                         fq1      = fq0 * exp(-(fthk / xfastca))      !! how much CaCO3 leaves this box            (mol) 
    3410                         freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol) 
    3411                      else 
    3412                         !! partial grid cell below CCD 
    3413                         fq2      = fdep1 - ocal_ccd(ji,jj)           !! amount of grid cell below CCD             (m) 
    3414                         fq1      = fq0 * exp(-(fq2 / xfastca))       !! how much CaCO3 leaves this box            (mol) 
    3415                         freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol) 
    3416                      endif 
    3417                      ffastca(ji,jj) = fq1  
    3418                   else 
    3419                      !! this is BELOW THE LAST OCEAN BOX (do nothing) 
    3420                      freminc  = 0.0 
    3421                      freminn  = 0.0 
    3422                      freminfe = 0.0 
    3423                      freminsi = 0.0 
    3424                      freminca = 0.0               
    3425                   endif 
    3426  
    3427                endif 
    3428  
    3429                !!---------------------------------------------------------------------- 
    3430                !! Fast-sinking detritus fluxes, pt. 2: UPDATE FAST FLUXES 
    3431                !! here locally calculated additions to the fast-sinking flux are added 
    3432                !! to the total fast-sinking flux; this is done here such that material 
    3433                !! produced in a particular layer is only remineralised below this 
    3434                !! layer 
    3435                !!---------------------------------------------------------------------- 
    3436                !! 
    3437                !! add sinking material generated in this layer to running totals 
    3438                !! 
    3439                !! === organic carbon ===                          (diatom and mesozooplankton mortality) 
    3440                ffastc(ji,jj)  = ffastc(ji,jj)  + (ftempc  * fthk) 
    3441                !! 
    3442                !! === organic nitrogen ===                        (diatom and mesozooplankton mortality) 
    3443                ffastn(ji,jj)  = ffastn(ji,jj)  + (ftempn  * fthk) 
    3444                !! 
    3445                !! === organic iron ===                            (diatom and mesozooplankton mortality) 
    3446                ffastfe(ji,jj) = ffastfe(ji,jj) + (ftempfe * fthk) 
    3447                !! 
    3448                !! === biogenic silicon ===                        (diatom mortality and grazed diatoms) 
    3449                ffastsi(ji,jj) = ffastsi(ji,jj) + (ftempsi * fthk) 
    3450                !! 
    3451                !! === biogenic calcium carbonate ===              (latitudinally-based fraction of total primary production) 
    3452                ffastca(ji,jj) = ffastca(ji,jj) + (ftempca * fthk) 
    3453  
    3454                !!---------------------------------------------------------------------- 
    3455                !! Fast-sinking detritus fluxes, pt. 3: SEAFLOOR 
    3456                !! remineralise all remaining fast-sinking detritus to dissolved 
    3457                !! nutrients; the sedimentation fluxes calculated here allow the 
    3458                !! separation of what's remineralised sinking through the final 
    3459                !! ocean box from that which is added to the final box by the 
    3460                !! remineralisation of material that reaches the seafloor (i.e. 
    3461                !! the model assumes that *all* material that hits the seafloor 
    3462                !! is remineralised and that none is permanently buried; hey, 
    3463                !! this is a giant GCM model that can't be run for long enough 
    3464                !! to deal with burial fluxes!) 
    3465                !! 
    3466                !! in a change to this process, in part so that MEDUSA behaves 
    3467                !! a little more like ERSEM et al., fast-sinking detritus (N, Fe 
    3468                !! and C) is converted to slow sinking detritus at the seafloor 
    3469                !! instead of being remineralised; the rationale is that in 
    3470                !! shallower shelf regions (... that are not fully mixed!) this 
    3471                !! allows the detrital material to return slowly to dissolved  
    3472                !! nutrient rather than instantaneously as now; the alternative 
    3473                !! would be to explicitly handle seafloor organic material - a 
    3474                !! headache I don't wish to experience at this point; note that 
    3475                !! fast-sinking Si and Ca detritus is just remineralised as  
    3476                !! per usual 
    3477                !!  
    3478                !! AXY (13/01/12) 
    3479                !! in a further change to this process, again so that MEDUSA is 
    3480                !! a little more like ERSEM et al., material that reaches the 
    3481                !! seafloor can now be added to sediment pools and stored for 
    3482                !! slow release; there are new 2D arrays for organic nitrogen, 
    3483                !! iron and carbon and inorganic silicon and carbon that allow 
    3484                !! fast and slow detritus that reaches the seafloor to be held 
    3485                !! and released back to the water column more slowly; these arrays 
    3486                !! are transferred via the tracer restart files between repeat 
    3487                !! submissions of the model 
    3488                !!---------------------------------------------------------------------- 
    3489                !!  
    3490                ffast2slowc  = 0.0 
    3491                ffast2slown  = 0.0 
    3492                ffast2slowfe = 0.0 
    3493                !! 
    3494                if (jk.eq.jmbathy) then 
    3495                   !! this is the BOTTOM OCEAN BOX (remineralise everything) 
    3496                   !! 
    3497                   !! AXY (17/01/12): tweaked to include benthos pools 
    3498                   !!  
    3499                   !! === organic carbon === 
    3500                   if (jfdfate.eq.0 .and. jorgben.eq.0) then 
    3501                      freminc  = freminc + (ffastc(ji,jj) / fthk)    !! C remineralisation in this box            (mol/m3) 
    3502                   elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 
    3503                      ffast2slowc = ffastc(ji,jj) / fthk             !! fast C -> slow C                          (mol/m3) 
    3504                      fslowc      = fslowc + ffast2slowc 
    3505                   elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 
    3506                      f_fbenin_c(ji,jj)  = ffastc(ji,jj)             !! fast C -> benthic C                       (mol/m2) 
    3507                   endif 
    3508                   fsedc(ji,jj)   = ffastc(ji,jj)                          !! record seafloor C                         (mol/m2) 
    3509                   ffastc(ji,jj)  = 0.0 
    3510                   !! 
    3511                   !! === organic nitrogen === 
    3512                   if (jfdfate.eq.0 .and. jorgben.eq.0) then 
    3513                      freminn  = freminn + (ffastn(ji,jj) / fthk)    !! N remineralisation in this box            (mol/m3) 
    3514                   elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 
    3515                      ffast2slown = ffastn(ji,jj) / fthk             !! fast N -> slow N                          (mol/m3) 
    3516                      fslown      = fslown + ffast2slown 
    3517                   elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 
    3518                      f_fbenin_n(ji,jj)  = ffastn(ji,jj)             !! fast N -> benthic N                       (mol/m2) 
    3519                   endif 
    3520                   fsedn(ji,jj)   = ffastn(ji,jj)                          !! record seafloor N                         (mol/m2) 
    3521                   ffastn(ji,jj)  = 0.0 
    3522                   !! 
    3523                   !! === organic iron === 
    3524                   if (jfdfate.eq.0 .and. jorgben.eq.0) then 
    3525                      freminfe = freminfe + (ffastfe(ji,jj) / fthk)  !! Fe remineralisation in this box           (mol/m3) 
    3526                   elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 
    3527                      ffast2slowfe = ffastn(ji,jj) / fthk            !! fast Fe -> slow Fe                        (mol/m3) 
    3528                   elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 
    3529                      f_fbenin_fe(ji,jj) = ffastfe(ji,jj)            !! fast Fe -> benthic Fe                     (mol/m2) 
    3530                   endif 
    3531                   fsedfe(ji,jj)  = ffastfe(ji,jj)                         !! record seafloor Fe                        (mol/m2) 
    3532                   ffastfe(ji,jj) = 0.0 
    3533                   !! 
    3534                   !! === biogenic silicon === 
    3535                   if (jinorgben.eq.0) then 
    3536                      freminsi = freminsi + (ffastsi(ji,jj) / fthk)  !! Si remineralisation in this box           (mol/m3) 
    3537                   elseif (jinorgben.eq.1) then 
    3538                      f_fbenin_si(ji,jj) = ffastsi(ji,jj)            !! fast Si -> benthic Si                     (mol/m2) 
    3539                   endif 
    3540                   fsedsi(ji,jj)   = ffastsi(ji,jj)                         !! record seafloor Si                        (mol/m2) 
    3541                   ffastsi(ji,jj) = 0.0 
    3542                   !! 
    3543                   !! === biogenic calcium carbonate === 
    3544                   if (jinorgben.eq.0) then 
    3545                      freminca = freminca + (ffastca(ji,jj) / fthk)  !! Ca remineralisation in this box           (mol/m3)  
    3546                   elseif (jinorgben.eq.1) then 
    3547                      f_fbenin_ca(ji,jj) = ffastca(ji,jj)            !! fast Ca -> benthic Ca                     (mol/m2) 
    3548                   endif 
    3549                   fsedca(ji,jj)   = ffastca(ji,jj)                         !! record seafloor Ca                        (mol/m2) 
    3550                   ffastca(ji,jj) = 0.0 
    3551                endif 
    3552  
    3553 # if defined key_debug_medusa 
    3554                if (idf.eq.1) then 
    3555                   !!---------------------------------------------------------------------- 
    3556                   !! Integrate total fast detritus remineralisation 
    3557                   !!---------------------------------------------------------------------- 
    3558                   !! 
    3559                   fofd_n(ji,jj)  = fofd_n(ji,jj)  + (freminn  * fthk) 
    3560                   fofd_si(ji,jj) = fofd_si(ji,jj) + (freminsi * fthk) 
    3561                   fofd_fe(ji,jj) = fofd_fe(ji,jj) + (freminfe * fthk) 
    3562 #  if defined key_roam 
    3563                   fofd_c(ji,jj)  = fofd_c(ji,jj)  + (freminc  * fthk) 
    3564 #  endif 
    3565                endif 
    3566 # endif 
    3567  
    3568                !!---------------------------------------------------------------------- 
    3569                !! Sort out remineralisation tally of fast-sinking detritus 
    3570                !!---------------------------------------------------------------------- 
    3571                !! 
    3572                !! update fast-sinking regeneration arrays 
    3573                fregenfast(ji,jj)   = fregenfast(ji,jj)   + (freminn  * fthk) 
    3574                fregenfastsi(ji,jj) = fregenfastsi(ji,jj) + (freminsi * fthk) 
    3575 # if defined key_roam 
    3576                fregenfastc(ji,jj)  = fregenfastc(ji,jj)  + (freminc  * fthk) 
    3577 # endif 
    3578  
    3579                !!---------------------------------------------------------------------- 
    3580                !! Benthic remineralisation fluxes 
    3581                !!---------------------------------------------------------------------- 
    3582                !! 
    3583                if (jk.eq.jmbathy) then 
    3584                   !! 
    3585                   !! organic components 
    3586                   if (jorgben.eq.1) then 
    3587                      f_benout_n(ji,jj)  = xsedn  * zn_sed_n(ji,jj) 
    3588                      f_benout_fe(ji,jj) = xsedfe * zn_sed_fe(ji,jj) 
    3589                      f_benout_c(ji,jj)  = xsedc  * zn_sed_c(ji,jj) 
    3590                   endif 
    3591                   !! 
    3592                   !! inorganic components 
    3593                   if (jinorgben.eq.1) then 
    3594                      f_benout_si(ji,jj) = xsedsi * zn_sed_si(ji,jj) 
    3595                      f_benout_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj) 
    3596                      !! 
    3597                      !! account for CaCO3 that dissolves when it shouldn't 
    3598                      if ( fdep .le. fccd_dep ) then 
    3599                         f_benout_lyso_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj) 
    3600                      endif 
    3601                   endif 
    3602                endif 
    3603                CALL flush(numout) 
    3604  
    3605                !!====================================================================== 
    3606                !! LOCAL GRID CELL TRENDS 
    3607                !!====================================================================== 
    3608                !! 
    3609                !!---------------------------------------------------------------------- 
    3610                !! Determination of trends 
    3611                !!---------------------------------------------------------------------- 
    3612                !! 
    3613                !!---------------------------------------------------------------------- 
    3614                !! chlorophyll 
    3615                btra(jpchn) = b0 * ( & 
    3616                  + ((frn * fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2) * (fthetan / xxi) ) 
    3617                btra(jpchd) = b0 * ( & 
    3618                  + ((frd * fprd * zphd) - fgmepd - fdpd - fdpd2) * (fthetad / xxi) ) 
    3619                !! 
    3620                !!---------------------------------------------------------------------- 
    3621                !! phytoplankton 
    3622                btra(jpphn) = b0 * ( & 
    3623                  + (fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2 ) 
    3624                btra(jpphd) = b0 * ( & 
    3625                  + (fprd * zphd) - fgmepd - fdpd - fdpd2 ) 
    3626                btra(jppds) = b0 * ( & 
    3627                  + (fprds * zpds) - fgmepds - fdpds - fsdiss - fdpds2 ) 
    3628                !! 
    3629                !!---------------------------------------------------------------------- 
    3630                !! zooplankton 
    3631                btra(jpzmi) = b0 * ( & 
    3632                  + fmigrow - fgmezmi - fdzmi - fdzmi2 ) 
    3633                btra(jpzme) = b0 * ( & 
    3634                  + fmegrow - fdzme - fdzme2 ) 
    3635                !! 
    3636                !!---------------------------------------------------------------------- 
    3637                !! detritus 
    3638                btra(jpdet) = b0 * ( & 
    3639                  + fdpn + ((1.0 - xfdfrac1) * fdpd)              &  ! mort. losses 
    3640                  + fdzmi + ((1.0 - xfdfrac2) * fdzme)            &  ! mort. losses 
    3641                  + ((1.0 - xbetan) * (finmi + finme))            &  ! assim. inefficiency 
    3642                  - fgmid - fgmed - fdd                           &  ! grazing and remin. 
    3643                  + ffast2slown )                                    ! seafloor fast->slow 
    3644                !! 
    3645                !!---------------------------------------------------------------------- 
    3646                !! dissolved inorganic nitrogen nutrient 
    3647                fn_cons = 0.0  & 
    3648                  - (fprn * zphn) - (fprd * zphd)                    ! primary production 
    3649                fn_prod = 0.0  & 
    3650                  + (xphi * (fgmipn + fgmid))                     &  ! messy feeding remin. 
    3651                  + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed))  &  ! messy feeding remin. 
    3652                  + fmiexcr + fmeexcr + fdd + freminn             &  ! excretion and remin. 
    3653                  + fdpn2 + fdpd2 + fdzmi2 + fdzme2                  ! metab. losses 
    3654                !!  
    3655                !! riverine flux 
    3656                if ( jriver_n .gt. 0 ) then 
    3657                   f_riv_loc_n = f_riv_n(ji,jj) * friver_dep(jk,jmbathy) / fthk 
    3658                   fn_prod = fn_prod + f_riv_loc_n 
    3659                endif 
    3660                !!   
    3661                !! benthic remineralisation 
    3662                if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 
    3663                   fn_prod = fn_prod + (f_benout_n(ji,jj) / fthk) 
    3664                endif 
    3665                !! 
    3666                btra(jpdin) = b0 * ( & 
    3667                  fn_prod + fn_cons ) 
    3668                !! 
    3669                fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved nitrogen 
    3670                  fn_cons ) ) 
    3671                fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fthk * (  &  ! production of dissolved nitrogen 
    3672                  fn_prod ) ) 
    3673                !! 
    3674                !!---------------------------------------------------------------------- 
    3675                !! dissolved silicic acid nutrient 
    3676                fs_cons = 0.0  & 
    3677                  - (fprds * zpds)                                   ! opal production 
    3678                fs_prod = 0.0  & 
    3679                  + fsdiss                                        &  ! opal dissolution 
    3680                  + ((1.0 - xfdfrac1) * fdpds)                    &  ! mort. loss 
    3681                  + ((1.0 - xfdfrac3) * fgmepds)                  &  ! egestion of grazed Si 
    3682                  + freminsi + fdpds2                                ! fast diss. and metab. losses 
    3683                !!  
    3684                !! riverine flux 
    3685                if ( jriver_si .gt. 0 ) then 
    3686                   f_riv_loc_si = f_riv_si(ji,jj) * friver_dep(jk,jmbathy) / fthk 
    3687                   fs_prod = fs_prod + f_riv_loc_si 
    3688                endif 
    3689                !!   
    3690                !! benthic remineralisation 
    3691                if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 
    3692                   fs_prod = fs_prod + (f_benout_si(ji,jj) / fthk) 
    3693                endif 
    3694                !! 
    3695                btra(jpsil) = b0 * ( & 
    3696                  fs_prod + fs_cons ) 
    3697                !! 
    3698                fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved silicon 
    3699                  fs_cons ) ) 
    3700                fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fthk * (  &  ! production of dissolved silicon 
    3701                  fs_prod ) ) 
    3702                !! 
    3703                !!---------------------------------------------------------------------- 
    3704                !! dissolved "iron" nutrient 
    3705                btra(jpfer) = b0 * ( & 
    3706                + (xrfn * btra(jpdin)) + ffetop + ffebot - ffescav ) 
    3707  
    3708 # if defined key_roam 
    3709                !! 
    3710                !!---------------------------------------------------------------------- 
    3711                !! AXY (26/11/08): implicit detrital carbon change 
    3712                btra(jpdtc) = b0 * ( & 
    3713                  + (xthetapn * fdpn) + ((1.0 - xfdfrac1) * (xthetapd * fdpd))      &  ! mort. losses 
    3714                  + (xthetazmi * fdzmi) + ((1.0 - xfdfrac2) * (xthetazme * fdzme))  &  ! mort. losses 
    3715                  + ((1.0 - xbetac) * (ficmi + ficme))                              &  ! assim. inefficiency 
    3716                  - fgmidc - fgmedc - fddc                                          &  ! grazing and remin. 
    3717                  + ffast2slowc )                                                      ! seafloor fast->slow 
    3718                !! 
    3719                !!---------------------------------------------------------------------- 
    3720                !! dissolved inorganic carbon 
    3721                fc_cons = 0.0  & 
    3722                  - (xthetapn * fprn * zphn) - (xthetapd * fprd * zphd)                ! primary production 
    3723                fc_prod = 0.0  & 
    3724                  + (xthetapn * xphi * fgmipn) + (xphi * fgmidc)                    &  ! messy feeding remin 
    3725                  + (xthetapn * xphi * fgmepn) + (xthetapd * xphi * fgmepd)         &  ! messy feeding remin 
    3726                  + (xthetazmi * xphi * fgmezmi) + (xphi * fgmedc)                  &  ! messy feeding remin 
    3727                  + fmiresp + fmeresp + fddc + freminc + (xthetapn * fdpn2)         &  ! resp., remin., losses 
    3728                  + (xthetapd * fdpd2) + (xthetazmi * fdzmi2)                       &  ! losses 
    3729                  + (xthetazme * fdzme2)                                               ! losses 
    3730                !!  
    3731                !! riverine flux 
    3732                if ( jriver_c .gt. 0 ) then 
    3733                   f_riv_loc_c = f_riv_c(ji,jj) * friver_dep(jk,jmbathy) / fthk 
    3734                   fc_prod = fc_prod + f_riv_loc_c 
    3735                endif 
    3736                !!   
    3737                !! benthic remineralisation 
    3738                if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 
    3739                   fc_prod = fc_prod + (f_benout_c(ji,jj) / fthk) 
    3740                endif 
    3741                if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 
    3742                   fc_prod = fc_prod + (f_benout_ca(ji,jj) / fthk) 
    3743                endif 
    3744                !! 
    3745                !! community respiration (does not include CaCO3 terms - obviously!) 
    3746                fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod 
    3747                !! 
    3748                !! CaCO3 
    3749                fc_prod = fc_prod - ftempca + freminca 
    3750                !!  
    3751                !! riverine flux 
    3752                if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then 
    3753                   fc_prod = fc_prod + f_riv_c(ji,jj) 
    3754                endif 
    3755                !! 
    3756                btra(jpdic) = b0 * ( & 
    3757                  fc_prod + fc_cons ) 
    3758                !! 
    3759                fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved carbon 
    3760                  fc_cons ) ) 
    3761                fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fthk * (  &  ! production of dissolved carbon 
    3762                  fc_prod ) ) 
    3763                !! 
    3764                !!---------------------------------------------------------------------- 
    3765                !! alkalinity 
    3766                fa_prod = 0.0  & 
    3767                  + (2.0 * freminca)                                                   ! CaCO3 dissolution 
    3768                fa_cons = 0.0  & 
    3769                  - (2.0 * ftempca)                                                    ! CaCO3 production 
    3770                !!  
    3771                !! riverine flux 
    3772                if ( jriver_alk .gt. 0 ) then 
    3773                   f_riv_loc_alk = f_riv_alk(ji,jj) * friver_dep(jk,jmbathy) / fthk 
    3774                   fa_prod = fa_prod + f_riv_loc_alk 
    3775                endif 
    3776                !!   
    3777                !! benthic remineralisation 
    3778                if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 
    3779                   fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) / fthk) 
    3780                endif 
    3781                !! 
    3782                btra(jpalk) = b0 * ( & 
    3783                  fa_prod + fa_cons ) 
    3784                !! 
    3785                !!---------------------------------------------------------------------- 
    3786                !! oxygen (has protection at low O2 concentrations; OCMIP-2 style) 
    3787                fo2_prod = 0.0 & 
    3788                  + (xthetanit * fprn * zphn)                                      & ! Pn primary production, N 
    3789                  + (xthetanit * fprd * zphd)                                      & ! Pd primary production, N 
    3790                  + (xthetarem * xthetapn * fprn * zphn)                           & ! Pn primary production, C 
    3791                  + (xthetarem * xthetapd * fprd * zphd)                             ! Pd primary production, C 
    3792                fo2_ncons = 0.0 & 
    3793                  - (xthetanit * xphi * fgmipn)                                    & ! Pn messy feeding remin., N 
    3794                  - (xthetanit * xphi * fgmid)                                     & ! D  messy feeding remin., N 
    3795                  - (xthetanit * xphi * fgmepn)                                    & ! Pn messy feeding remin., N 
    3796                  - (xthetanit * xphi * fgmepd)                                    & ! Pd messy feeding remin., N 
    3797                  - (xthetanit * xphi * fgmezmi)                                   & ! Zi messy feeding remin., N 
    3798                  - (xthetanit * xphi * fgmed)                                     & ! D  messy feeding remin., N 
    3799                  - (xthetanit * fmiexcr)                                          & ! microzoo excretion, N 
    3800                  - (xthetanit * fmeexcr)                                          & ! mesozoo  excretion, N 
    3801                  - (xthetanit * fdd)                                              & ! slow detritus remin., N  
    3802                  - (xthetanit * freminn)                                          & ! fast detritus remin., N 
    3803                  - (xthetanit * fdpn2)                                            & ! Pn  losses, N 
    3804                  - (xthetanit * fdpd2)                                            & ! Pd  losses, N 
    3805                  - (xthetanit * fdzmi2)                                           & ! Zmi losses, N 
    3806                  - (xthetanit * fdzme2)                                             ! Zme losses, N 
    3807                !!   
    3808                !! benthic remineralisation 
    3809                if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 
    3810                   fo2_ncons = fo2_ncons - (xthetanit * f_benout_n(ji,jj) / fthk) 
    3811                endif 
    3812                fo2_ccons = 0.0 & 
    3813                  - (xthetarem * xthetapn * xphi * fgmipn)                         & ! Pn messy feeding remin., C 
    3814                  - (xthetarem * xphi * fgmidc)                                    & ! D  messy feeding remin., C 
    3815                  - (xthetarem * xthetapn * xphi * fgmepn)                         & ! Pn messy feeding remin., C 
    3816                  - (xthetarem * xthetapd * xphi * fgmepd)                         & ! Pd messy feeding remin., C 
    3817                  - (xthetarem * xthetazmi * xphi * fgmezmi)                       & ! Zi messy feeding remin., C 
    3818                  - (xthetarem * xphi * fgmedc)                                    & ! D  messy feeding remin., C 
    3819                  - (xthetarem * fmiresp)                                          & ! microzoo respiration, C 
    3820                  - (xthetarem * fmeresp)                                          & ! mesozoo  respiration, C 
    3821                  - (xthetarem * fddc)                                             & ! slow detritus remin., C 
    3822                  - (xthetarem * freminc)                                          & ! fast detritus remin., C 
    3823                  - (xthetarem * xthetapn * fdpn2)                                 & ! Pn  losses, C 
    3824                  - (xthetarem * xthetapd * fdpd2)                                 & ! Pd  losses, C 
    3825                  - (xthetarem * xthetazmi * fdzmi2)                               & ! Zmi losses, C 
    3826                  - (xthetarem * xthetazme * fdzme2)                                 ! Zme losses, C 
    3827                !!   
    3828                !! benthic remineralisation 
    3829                if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 
    3830                   fo2_ccons = fo2_ccons - (xthetarem * f_benout_c(ji,jj) / fthk) 
    3831                endif 
    3832                fo2_cons = fo2_ncons + fo2_ccons 
    3833                !! 
    3834                !! is this a suboxic zone? 
    3835                if (zoxy.lt.xo2min) then  ! deficient O2; production fluxes only 
    3836                   btra(jpoxy) = b0 * ( & 
    3837                     fo2_prod ) 
    3838                   foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod ) 
    3839                   foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fthk * fo2_cons ) 
    3840                else                      ! sufficient O2; production + consumption fluxes 
    3841                   btra(jpoxy) = b0 * ( & 
    3842                     fo2_prod + fo2_cons ) 
    3843                   foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod ) 
    3844                   foxy_cons(ji,jj) = foxy_cons(ji,jj) + ( fthk * fo2_cons ) 
    3845                endif 
    3846                !! 
    3847                !! air-sea fluxes (if this is the surface box) 
    3848                if (jk.eq.1) then 
    3849                   !! 
    3850                   !! CO2 flux 
    3851                   btra(jpdic) = btra(jpdic) + (b0 * f_co2flux) 
    3852                   !! 
    3853                   !! O2 flux (mol/m3/s -> mmol/m3/d) 
    3854                   btra(jpoxy) = btra(jpoxy) + (b0 * f_o2flux) 
    3855                endif 
    3856 # endif 
    3857  
    3858 # if defined key_debug_medusa 
    3859                !! report state variable fluxes (not including fast-sinking detritus) 
    3860                if (idf.eq.1.AND.idfval.eq.1) then 
    3861                   IF (lwp) write (numout,*) '------------------------------' 
    3862                   IF (lwp) write (numout,*) 'btra(jpchn)(',jk,')  = ', btra(jpchn) 
    3863                   IF (lwp) write (numout,*) 'btra(jpchd)(',jk,')  = ', btra(jpchd) 
    3864                   IF (lwp) write (numout,*) 'btra(jpphn)(',jk,')  = ', btra(jpphn) 
    3865                   IF (lwp) write (numout,*) 'btra(jpphd)(',jk,')  = ', btra(jpphd) 
    3866                   IF (lwp) write (numout,*) 'btra(jppds)(',jk,')  = ', btra(jppds) 
    3867                   IF (lwp) write (numout,*) 'btra(jpzmi)(',jk,')  = ', btra(jpzmi) 
    3868                   IF (lwp) write (numout,*) 'btra(jpzme)(',jk,')  = ', btra(jpzme) 
    3869                   IF (lwp) write (numout,*) 'btra(jpdet)(',jk,')  = ', btra(jpdet) 
    3870                   IF (lwp) write (numout,*) 'btra(jpdin)(',jk,')  = ', btra(jpdin) 
    3871                   IF (lwp) write (numout,*) 'btra(jpsil)(',jk,')  = ', btra(jpsil) 
    3872                   IF (lwp) write (numout,*) 'btra(jpfer)(',jk,')  = ', btra(jpfer) 
    3873 #  if defined key_roam 
    3874                   IF (lwp) write (numout,*) 'btra(jpdtc)(',jk,')  = ', btra(jpdtc) 
    3875                   IF (lwp) write (numout,*) 'btra(jpdic)(',jk,')  = ', btra(jpdic) 
    3876                   IF (lwp) write (numout,*) 'btra(jpalk)(',jk,')  = ', btra(jpalk) 
    3877                   IF (lwp) write (numout,*) 'btra(jpoxy)(',jk,')  = ', btra(jpoxy) 
    3878 #  endif 
    3879                endif 
    3880 # endif 
    3881  
    3882                !!---------------------------------------------------------------------- 
    3883                !! Integrate calculated fluxes for mass balance 
    3884                !!---------------------------------------------------------------------- 
    3885                !! 
    3886                !! === nitrogen === 
    3887                fflx_n(ji,jj)  = fflx_n(ji,jj)  + & 
    3888                   fthk * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin) ) 
    3889                !! === silicon === 
    3890                fflx_si(ji,jj) = fflx_si(ji,jj) + & 
    3891                   fthk * ( btra(jppds) + btra(jpsil) ) 
    3892                !! === iron === 
    3893                fflx_fe(ji,jj) = fflx_fe(ji,jj) + & 
    3894                   fthk * ( ( xrfn * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet)) ) + btra(jpfer) ) 
    3895 # if defined key_roam 
    3896                !! === carbon === 
    3897                fflx_c(ji,jj)  = fflx_c(ji,jj)  + & 
    3898                   fthk * ( (xthetapn * btra(jpphn)) + (xthetapd * btra(jpphd)) + & 
    3899                   (xthetazmi * btra(jpzmi)) + (xthetazme * btra(jpzme)) + btra(jpdtc) + btra(jpdic) ) 
    3900                !! === alkalinity === 
    3901                fflx_a(ji,jj)  = fflx_a(ji,jj)  + & 
    3902                   fthk * ( btra(jpalk) ) 
    3903                !! === oxygen === 
    3904                fflx_o2(ji,jj) = fflx_o2(ji,jj) + & 
    3905                   fthk * ( btra(jpoxy) ) 
    3906 # endif 
    3907  
    3908                !!---------------------------------------------------------------------- 
    3909                !! Apply calculated tracer fluxes 
    3910                !!---------------------------------------------------------------------- 
    3911                !! 
    3912                !! units: [unit of tracer] per second (fluxes are calculated above per day) 
    3913                !! 
    3914                ibio_switch = 1 
    3915 # if defined key_gulf_finland 
    3916                !! AXY (17/05/13): fudge in a Gulf of Finland correction; uses longitude- 
    3917                !!                 latitude range to establish if this is a Gulf of Finland  
    3918                !!                 grid cell; if so, then BGC fluxes are ignored (though  
    3919                !!                 still calculated); for reference, this is meant to be a  
    3920                !!                 temporary fix to see if all of my problems can be done  
    3921                !!                 away with if I switch off BGC fluxes in the Gulf of  
    3922                !!                 Finland, which currently appears the source of trouble 
    3923                if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and. & 
    3924                   &   gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then 
    3925                   ibio_switch = 0 
    3926                endif 
    3927 # endif                
    3928                if (ibio_switch.eq.1) then 
    3929                   tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) + (btra(jpchn) / 86400.) 
    3930                   tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) + (btra(jpchd) / 86400.) 
    3931                   tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) + (btra(jpphn) / 86400.) 
    3932                   tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) + (btra(jpphd) / 86400.) 
    3933                   tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) + (btra(jppds) / 86400.) 
    3934                   tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) + (btra(jpzmi) / 86400.) 
    3935                   tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) + (btra(jpzme) / 86400.) 
    3936                   tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + (btra(jpdet) / 86400.) 
    3937                   tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) + (btra(jpdin) / 86400.) 
    3938                   tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + (btra(jpsil) / 86400.) 
    3939                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + (btra(jpfer) / 86400.) 
    3940 # if defined key_roam 
    3941                   tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + (btra(jpdtc) / 86400.) 
    3942                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + (btra(jpdic) / 86400.) 
    3943                   tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) + (btra(jpalk) / 86400.) 
    3944                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + (btra(jpoxy) / 86400.) 
    3945 # endif 
    3946                endif                
    3947  
    3948                !! AXY (18/11/16): CMIP6 diagnostics 
    3949                IF( med_diag%FBDDTALK%dgsave )  THEN 
    3950                   fbddtalk(ji,jj)  =  fbddtalk(ji,jj)  + (btra(jpalk) * fthk) 
    3951                ENDIF 
    3952                IF( med_diag%FBDDTDIC%dgsave )  THEN 
    3953                   fbddtdic(ji,jj)  =  fbddtdic(ji,jj)  + (btra(jpdic) * fthk) 
    3954                ENDIF 
    3955                IF( med_diag%FBDDTDIFE%dgsave ) THEN 
    3956                   fbddtdife(ji,jj) =  fbddtdife(ji,jj) + (btra(jpfer) * fthk) 
    3957                ENDIF 
    3958                IF( med_diag%FBDDTDIN%dgsave )  THEN 
    3959                   fbddtdin(ji,jj)  =  fbddtdin(ji,jj)  + (btra(jpdin) * fthk) 
    3960                ENDIF 
    3961                IF( med_diag%FBDDTDISI%dgsave ) THEN 
    3962                   fbddtdisi(ji,jj) =  fbddtdisi(ji,jj) + (btra(jpsil) * fthk) 
    3963                ENDIF 
    3964           !! 
    3965                IF( med_diag%BDDTALK3%dgsave )  THEN 
    3966                   bddtalk3(ji,jj,jk)  =  btra(jpalk) 
    3967                ENDIF 
    3968                IF( med_diag%BDDTDIC3%dgsave )  THEN 
    3969                   bddtdic3(ji,jj,jk)  =  btra(jpdic) 
    3970                ENDIF 
    3971                IF( med_diag%BDDTDIFE3%dgsave ) THEN 
    3972                   bddtdife3(ji,jj,jk) =  btra(jpfer) 
    3973                ENDIF 
    3974                IF( med_diag%BDDTDIN3%dgsave )  THEN 
    3975                   bddtdin3(ji,jj,jk)  =  btra(jpdin) 
    3976                ENDIF 
    3977                IF( med_diag%BDDTDISI3%dgsave ) THEN 
    3978                   bddtdisi3(ji,jj,jk) =  btra(jpsil) 
    3979                ENDIF 
    3980  
    3981 #   if defined key_debug_medusa 
    3982                IF (lwp) write (numout,*) '------' 
    3983                IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations' 
    3984                IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs' 
    3985                      CALL flush(numout) 
    3986 #   endif 
    3987  
    3988 # if defined key_axy_nancheck 
    3989                !!---------------------------------------------------------------------- 
    3990                !! Check calculated tracer fluxes 
    3991                !!---------------------------------------------------------------------- 
    3992                !! 
    3993                DO jn = 1,jptra 
    3994                   fq0 = btra(jn) 
    3995                   !! AXY (30/01/14): "isnan" problem on HECTOR 
    3996                   !! if (fq0 /= fq0 ) then 
    3997                   if ( ieee_is_nan( fq0 ) ) then 
    3998                      !! there's a NaN here 
    3999                      if (lwp) write(numout,*) 'NAN detected in btra(', ji, ',', & 
    4000                      & jj, ',', jk, ',', jn, ') at time', kt 
    4001            CALL ctl_stop( 'trcbio_medusa, NAN in btra field' ) 
    4002                   endif 
    4003                ENDDO 
    4004                DO jn = 1,jptra 
    4005                   fq0 = tra(ji,jj,jk,jn) 
    4006                   !! AXY (30/01/14): "isnan" problem on HECTOR 
    4007                   !! if (fq0 /= fq0 ) then 
    4008                   if ( ieee_is_nan( fq0 ) ) then 
    4009                      !! there's a NaN here 
    4010                      if (lwp) write(numout,*) 'NAN detected in tra(', ji, ',', & 
    4011                      & jj, ',', jk, ',', jn, ') at time', kt 
    4012               CALL ctl_stop( 'trcbio_medusa, NAN in tra field' ) 
    4013                   endif 
    4014                ENDDO 
    4015                CALL flush(numout) 
    4016 # endif 
    4017  
    4018                !!---------------------------------------------------------------------- 
    4019                !! Check model conservation 
    4020                !! these terms merely sum up the tendency terms of the relevant 
    4021                !! state variables, which should sum to zero; the iron cycle is 
    4022                !! complicated by fluxes that add (aeolian deposition and seafloor 
    4023                !! remineralisation) and remove (scavenging) dissolved iron from 
    4024                !! the model (i.e. the sum of iron fluxes is unlikely to be zero) 
    4025                !!---------------------------------------------------------------------- 
    4026                !! 
    4027                !! fnit0 = btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin)  ! + ftempn 
    4028                !! fsil0 = btra(jppds) + btra(jpsil)                              ! + ftempsi 
    4029                !! ffer0 = (xrfn * fnit0) + btra(jpfer) 
    4030 # if defined key_roam 
    4031                !! fcar0 = 0. 
    4032                !! falk0 = 0. 
    4033                !! foxy0 = 0. 
    4034 # endif 
    4035                !! 
    4036                !! if (kt/240*240.eq.kt) then 
    4037                !!    if (ji.eq.2.and.jj.eq.2.and.jk.eq.1) then 
    4038                !!       IF (lwp) write (*,*) '*******!MEDUSA Conservation!*******',kt 
    4039 # if defined key_roam 
    4040                !!       IF (lwp) write (*,*) fnit0,fsil0,ffer0,fcar0,falk0,foxy0 
    4041 # else 
    4042                !!       IF (lwp) write (*,*) fnit0,fsil0,ffer0 
    4043 # endif 
    4044                !!    endif 
    4045                !! endif      
    4046  
    4047 # if defined key_trc_diabio 
    4048                !!====================================================================== 
    4049                !! LOCAL GRID CELL DIAGNOSTICS 
    4050                !!====================================================================== 
    4051                !! 
    4052                !!---------------------------------------------------------------------- 
    4053                !! Full diagnostics key_trc_diabio: 
    4054                !! LOBSTER and PISCES support full diagnistics option key_trc_diabio     
    4055                !! which gives an option of FULL output of biological sourses and sinks. 
    4056                !! I cannot see any reason for doing this. If needed, it can be done 
    4057                !! as shown below. 
    4058                !!---------------------------------------------------------------------- 
    4059                !! 
    4060                IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio' 
    4061                !!               trbio(ji,jj,jk, 1) = fprn 
    4062 # endif 
    4063  
    4064                IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
    4065          !!---------------------------------------------------------------------- 
    4066          !! Add in XML diagnostics stuff 
    4067          !!---------------------------------------------------------------------- 
    4068          !! 
    4069          !! ** 2D diagnostics 
    4070 #   if defined key_debug_medusa 
    4071                   IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk loop' 
    4072                   CALL flush(numout) 
    4073 #   endif 
    4074                   IF ( med_diag%PRN%dgsave ) THEN 
    4075                       fprn2d(ji,jj) = fprn2d(ji,jj) + (fprn  * zphn * fthk)  
    4076                   ENDIF 
    4077                   IF ( med_diag%MPN%dgsave ) THEN 
    4078                       fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn         * fthk) 
    4079                   ENDIF 
    4080                   IF ( med_diag%PRD%dgsave ) THEN 
    4081                       fprd2d(ji,jj) = fprd2d(ji,jj) + (fprd  * zphd * fthk) 
    4082                   ENDIF 
    4083                   IF( med_diag%MPD%dgsave ) THEN 
    4084                       fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd         * fthk)  
    4085                   ENDIF 
    4086                   !  IF( med_diag%DSED%dgsave ) THEN 
    4087                   !      CALL iom_put( "DSED"  , ftot_n ) 
    4088                   !  ENDIF 
    4089                   IF( med_diag%OPAL%dgsave ) THEN 
    4090                       fprds2d(ji,jj) = fprds2d(ji,jj) + (fprds * zpds * fthk)  
    4091                   ENDIF 
    4092                   IF( med_diag%OPALDISS%dgsave ) THEN 
    4093                       fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss  * fthk)   
    4094                   ENDIF 
    4095                   IF( med_diag%GMIPn%dgsave ) THEN 
    4096                       fgmipn2d(ji,jj) = fgmipn2d(ji,jj) + (fgmipn  * fthk)  
    4097                   ENDIF 
    4098                   IF( med_diag%GMID%dgsave ) THEN 
    4099                       fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid   * fthk)  
    4100                   ENDIF 
    4101                   IF( med_diag%MZMI%dgsave ) THEN 
    4102                       fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi   * fthk)  
    4103                   ENDIF 
    4104                   IF( med_diag%GMEPN%dgsave ) THEN 
    4105                       fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn  * fthk) 
    4106                   ENDIF 
    4107                   IF( med_diag%GMEPD%dgsave ) THEN 
    4108                       fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd  * fthk)  
    4109                   ENDIF 
    4110                   IF( med_diag%GMEZMI%dgsave ) THEN 
    4111                       fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) + (fgmezmi * fthk)  
    4112                   ENDIF 
    4113                   IF( med_diag%GMED%dgsave ) THEN 
    4114                       fgmed2d(ji,jj) = fgmed2d(ji,jj) + (fgmed   * fthk)  
    4115                   ENDIF 
    4116                   IF( med_diag%MZME%dgsave ) THEN 
    4117                       fdzme2d(ji,jj) = fdzme2d(ji,jj) + (fdzme   * fthk)  
    4118                   ENDIF 
    4119                   !  IF( med_diag%DEXP%dgsave ) THEN 
    4120                   !      CALL iom_put( "DEXP"  , ftot_n ) 
    4121                   !  ENDIF 
    4122                   IF( med_diag%DETN%dgsave ) THEN 
    4123                       fslown2d(ji,jj) = fslown2d(ji,jj) + (fslown  * fthk)   
    4124                   ENDIF 
    4125                   IF( med_diag%MDET%dgsave ) THEN 
    4126                       fdd2d(ji,jj) = fdd2d(ji,jj) + (fdd     * fthk)  
    4127                   ENDIF 
    4128                   IF( med_diag%AEOLIAN%dgsave ) THEN 
    4129                       ffetop2d(ji,jj) = ffetop2d(ji,jj) + (ffetop  * fthk)  
    4130                   ENDIF 
    4131                   IF( med_diag%BENTHIC%dgsave ) THEN 
    4132                       ffebot2d(ji,jj) = ffebot2d(ji,jj) + (ffebot  * fthk)  
    4133                   ENDIF 
    4134                   IF( med_diag%SCAVENGE%dgsave ) THEN 
    4135                       ffescav2d(ji,jj) = ffescav2d(ji,jj) + (ffescav * fthk)   
    4136                   ENDIF 
    4137                   IF( med_diag%PN_JLIM%dgsave ) THEN 
    4138                       ! fjln2d(ji,jj) = fjln2d(ji,jj) + (fjln  * zphn * fthk)  
    4139                       fjln2d(ji,jj) = fjln2d(ji,jj) + (fjlim_pn * zphn * fthk)  
    4140                   ENDIF 
    4141                   IF( med_diag%PN_NLIM%dgsave ) THEN 
    4142                       fnln2d(ji,jj) = fnln2d(ji,jj) + (fnln  * zphn * fthk)  
    4143                   ENDIF 
    4144                   IF( med_diag%PN_FELIM%dgsave ) THEN 
    4145                       ffln2d(ji,jj) = ffln2d(ji,jj) + (ffln  * zphn * fthk)  
    4146                   ENDIF 
    4147                   IF( med_diag%PD_JLIM%dgsave ) THEN 
    4148                       ! fjld2d(ji,jj) = fjld2d(ji,jj) + (fjld  * zphd * fthk)  
    4149                       fjld2d(ji,jj) = fjld2d(ji,jj) + (fjlim_pd * zphd * fthk)  
    4150                   ENDIF 
    4151                   IF( med_diag%PD_NLIM%dgsave ) THEN 
    4152                       fnld2d(ji,jj) = fnld2d(ji,jj) + (fnld  * zphd * fthk)  
    4153                   ENDIF 
    4154                   IF( med_diag%PD_FELIM%dgsave ) THEN 
    4155                       ffld2d(ji,jj) = ffld2d(ji,jj) + (ffld  * zphd * fthk)  
    4156                   ENDIF 
    4157                   IF( med_diag%PD_SILIM%dgsave ) THEN 
    4158                       fsld2d2(ji,jj) = fsld2d2(ji,jj) + (fsld2 * zphd * fthk)  
    4159                   ENDIF 
    4160                   IF( med_diag%PDSILIM2%dgsave ) THEN 
    4161                       fsld2d(ji,jj) = fsld2d(ji,jj) + (fsld  * zphd * fthk) 
    4162                   ENDIF 
    4163                   !!  
    4164                   IF( med_diag%TOTREG_N%dgsave ) THEN 
    4165                       fregen2d(ji,jj) = fregen2d(ji,jj) + fregen 
    4166                   ENDIF 
    4167                   IF( med_diag%TOTRG_SI%dgsave ) THEN 
    4168                       fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi 
    4169                   ENDIF 
    4170                   !!  
    4171                   IF( med_diag%FASTN%dgsave ) THEN 
    4172                       ftempn2d(ji,jj) = ftempn2d(ji,jj) + (ftempn  * fthk) 
    4173                   ENDIF 
    4174                   IF( med_diag%FASTSI%dgsave ) THEN 
    4175                       ftempsi2d(ji,jj) = ftempsi2d(ji,jj) + (ftempsi * fthk) 
    4176                   ENDIF 
    4177                   IF( med_diag%FASTFE%dgsave ) THEN 
    4178                       ftempfe2d(ji,jj) =ftempfe2d(ji,jj)  + (ftempfe * fthk)   
    4179                   ENDIF 
    4180                   IF( med_diag%FASTC%dgsave ) THEN 
    4181                       ftempc2d(ji,jj) = ftempc2d(ji,jj) + (ftempc  * fthk) 
    4182                   ENDIF 
    4183                   IF( med_diag%FASTCA%dgsave ) THEN 
    4184                       ftempca2d(ji,jj) = ftempca2d(ji,jj) + (ftempca * fthk) 
    4185                   ENDIF 
    4186                   !!  
    4187                   IF( med_diag%REMINN%dgsave ) THEN 
    4188                       freminn2d(ji,jj) = freminn2d(ji,jj) + (freminn  * fthk) 
    4189                   ENDIF 
    4190                   IF( med_diag%REMINSI%dgsave ) THEN 
    4191                       freminsi2d(ji,jj) = freminsi2d(ji,jj) + (freminsi * fthk) 
    4192                   ENDIF 
    4193                   IF( med_diag%REMINFE%dgsave ) THEN 
    4194                       freminfe2d(ji,jj)= freminfe2d(ji,jj) + (freminfe * fthk)  
    4195                   ENDIF 
    4196                   IF( med_diag%REMINC%dgsave ) THEN 
    4197                       freminc2d(ji,jj) = freminc2d(ji,jj) + (freminc  * fthk)  
    4198                   ENDIF 
    4199                   IF( med_diag%REMINCA%dgsave ) THEN 
    4200                       freminca2d(ji,jj) = freminca2d(ji,jj) + (freminca * fthk)  
    4201                   ENDIF 
    4202                   !! 
    4203 # if defined key_roam 
    4204                   !! 
    4205                   !! AXY (09/11/16): CMIP6 diagnostics 
    4206                   IF( med_diag%FD_NIT3%dgsave ) THEN 
    4207                      fd_nit3(ji,jj,jk) = ffastn(ji,jj) 
    4208                   ENDIF 
    4209                   IF( med_diag%FD_SIL3%dgsave ) THEN 
    4210                      fd_sil3(ji,jj,jk) = ffastsi(ji,jj) 
    4211                   ENDIF 
    4212                   IF( med_diag%FD_CAR3%dgsave ) THEN 
    4213                      fd_car3(ji,jj,jk) = ffastc(ji,jj) 
    4214                   ENDIF 
    4215                   IF( med_diag%FD_CAL3%dgsave ) THEN 
    4216                      fd_cal3(ji,jj,jk) = ffastca(ji,jj) 
    4217                   ENDIF 
    4218                   !! 
    4219                   IF (jk.eq.i0100) THEN 
    4220                      IF( med_diag%RR_0100%dgsave ) THEN 
    4221                         ffastca2d(ji,jj) =   & 
    4222                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    4223                      ENDIF                      
    4224                   ELSE IF (jk.eq.i0500) THEN  
    4225                      IF( med_diag%RR_0500%dgsave ) THEN 
    4226                         ffastca2d(ji,jj) =   & 
    4227                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    4228                      ENDIF                         
    4229                   ELSE IF (jk.eq.i1000) THEN 
    4230                      IF( med_diag%RR_1000%dgsave ) THEN 
    4231                         ffastca2d(ji,jj) =   & 
    4232                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    4233                      ENDIF 
    4234                   ELSE IF (jk.eq.jmbathy) THEN 
    4235                      IF( med_diag%IBEN_N%dgsave ) THEN 
    4236                         iben_n2d(ji,jj) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj) 
    4237                      ENDIF 
    4238                      IF( med_diag%IBEN_FE%dgsave ) THEN 
    4239                         iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 
    4240                      ENDIF 
    4241                      IF( med_diag%IBEN_C%dgsave ) THEN 
    4242                         iben_c2d(ji,jj) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj) 
    4243                      ENDIF 
    4244                      IF( med_diag%IBEN_SI%dgsave ) THEN 
    4245                         iben_si2d(ji,jj) = f_fbenin_si(ji,jj) 
    4246                      ENDIF 
    4247                      IF( med_diag%IBEN_CA%dgsave ) THEN 
    4248                         iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj) 
    4249                      ENDIF 
    4250                      IF( med_diag%OBEN_N%dgsave ) THEN 
    4251                         oben_n2d(ji,jj) = f_benout_n(ji,jj) 
    4252                      ENDIF 
    4253                      IF( med_diag%OBEN_FE%dgsave ) THEN 
    4254                         oben_fe2d(ji,jj) = f_benout_fe(ji,jj) 
    4255                      ENDIF 
    4256                      IF( med_diag%OBEN_C%dgsave ) THEN 
    4257                         oben_c2d(ji,jj) = f_benout_c(ji,jj) 
    4258                      ENDIF 
    4259                      IF( med_diag%OBEN_SI%dgsave ) THEN 
    4260                         oben_si2d(ji,jj) = f_benout_si(ji,jj) 
    4261                      ENDIF 
    4262                      IF( med_diag%OBEN_CA%dgsave ) THEN 
    4263                         oben_ca2d(ji,jj) = f_benout_ca(ji,jj) 
    4264                      ENDIF 
    4265                      IF( med_diag%SFR_OCAL%dgsave ) THEN 
    4266                         sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk) 
    4267                      ENDIF 
    4268                      IF( med_diag%SFR_OARG%dgsave ) THEN 
    4269                         sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk) 
    4270                      ENDIF 
    4271                      IF( med_diag%LYSO_CA%dgsave ) THEN 
    4272                         lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj) 
    4273                      ENDIF 
    4274                   ENDIF 
    4275                   !! end bathy-1 diags 
    4276                   !! 
    4277                   IF( med_diag%RIV_N%dgsave ) THEN 
    4278                      rivn2d(ji,jj) = rivn2d(ji,jj) +  (f_riv_loc_n * fthk) 
    4279                   ENDIF 
    4280                   IF( med_diag%RIV_SI%dgsave ) THEN 
    4281                      rivsi2d(ji,jj) = rivsi2d(ji,jj) +  (f_riv_loc_si * fthk) 
    4282                   ENDIF 
    4283                   IF( med_diag%RIV_C%dgsave ) THEN 
    4284                      rivc2d(ji,jj) = rivc2d(ji,jj) +  (f_riv_loc_c * fthk) 
    4285                   ENDIF 
    4286                   IF( med_diag%RIV_ALK%dgsave ) THEN 
    4287                      rivalk2d(ji,jj) = rivalk2d(ji,jj) +  (f_riv_loc_alk * fthk) 
    4288                   ENDIF 
    4289                   IF( med_diag%DETC%dgsave ) THEN 
    4290                      fslowc2d(ji,jj) = fslowc2d(ji,jj) + (fslowc  * fthk)    
    4291                   ENDIF 
    4292                   !!  
    4293                   !!               
    4294                   !! 
    4295                   IF( med_diag%PN_LLOSS%dgsave ) THEN 
    4296                      fdpn22d(ji,jj) = fdpn22d(ji,jj) + (fdpn2  * fthk) 
    4297                   ENDIF 
    4298                   IF( med_diag%PD_LLOSS%dgsave ) THEN 
    4299                      fdpd22d(ji,jj) = fdpd22d(ji,jj) + (fdpd2  * fthk) 
    4300                   ENDIF 
    4301                   IF( med_diag%ZI_LLOSS%dgsave ) THEN 
    4302                      fdzmi22d(ji,jj) = fdzmi22d(ji,jj) + (fdzmi2 * fthk) 
    4303                   ENDIF 
    4304                   IF( med_diag%ZE_LLOSS%dgsave ) THEN 
    4305                      fdzme22d(ji,jj) = fdzme22d(ji,jj) + (fdzme2 * fthk) 
    4306                   ENDIF 
    4307                   IF( med_diag%ZI_MES_N%dgsave ) THEN 
    4308                      zimesn2d(ji,jj) = zimesn2d(ji,jj) +  & 
    4309                      (xphi * (fgmipn + fgmid) * fthk) 
    4310                   ENDIF 
    4311                   IF( med_diag%ZI_MES_D%dgsave ) THEN 
    4312                      zimesd2d(ji,jj) = zimesd2d(ji,jj) + &  
    4313                      ((1. - xbetan) * finmi * fthk) 
    4314                   ENDIF 
    4315                   IF( med_diag%ZI_MES_C%dgsave ) THEN 
    4316                      zimesc2d(ji,jj) = zimesc2d(ji,jj) + & 
    4317                      (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk) 
    4318                   ENDIF 
    4319                   IF( med_diag%ZI_MESDC%dgsave ) THEN 
    4320                      zimesdc2d(ji,jj) = zimesdc2d(ji,jj) + & 
    4321                      ((1. - xbetac) * ficmi * fthk) 
    4322                   ENDIF 
    4323                   IF( med_diag%ZI_EXCR%dgsave ) THEN 
    4324                      ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +  (fmiexcr * fthk) 
    4325                   ENDIF 
    4326                   IF( med_diag%ZI_RESP%dgsave ) THEN 
    4327                      ziresp2d(ji,jj) = ziresp2d(ji,jj) +  (fmiresp * fthk) 
    4328                   ENDIF 
    4329                   IF( med_diag%ZI_GROW%dgsave ) THEN 
    4330                      zigrow2d(ji,jj) = zigrow2d(ji,jj) + (fmigrow * fthk) 
    4331                   ENDIF 
    4332                   IF( med_diag%ZE_MES_N%dgsave ) THEN 
    4333                      zemesn2d(ji,jj) = zemesn2d(ji,jj) + & 
    4334                      (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk) 
    4335                   ENDIF 
    4336                   IF( med_diag%ZE_MES_D%dgsave ) THEN 
    4337                      zemesd2d(ji,jj) = zemesd2d(ji,jj) + & 
    4338                      ((1. - xbetan) * finme * fthk) 
    4339                   ENDIF 
    4340                   IF( med_diag%ZE_MES_C%dgsave ) THEN 
    4341                      zemesc2d(ji,jj) = zemesc2d(ji,jj) +                         &  
    4342                      (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) +  & 
    4343                      (xthetazmi * fgmezmi) + fgmedc) * fthk) 
    4344                   ENDIF 
    4345                   IF( med_diag%ZE_MESDC%dgsave ) THEN 
    4346                      zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +  & 
    4347                      ((1. - xbetac) * ficme * fthk) 
    4348                   ENDIF 
    4349                   IF( med_diag%ZE_EXCR%dgsave ) THEN 
    4350                      zeexcr2d(ji,jj) = zeexcr2d(ji,jj) + (fmeexcr * fthk) 
    4351                   ENDIF 
    4352                   IF( med_diag%ZE_RESP%dgsave ) THEN 
    4353                      zeresp2d(ji,jj) = zeresp2d(ji,jj) + (fmeresp * fthk) 
    4354                   ENDIF 
    4355                   IF( med_diag%ZE_GROW%dgsave ) THEN 
    4356                      zegrow2d(ji,jj) = zegrow2d(ji,jj) + (fmegrow * fthk) 
    4357                   ENDIF 
    4358                   IF( med_diag%MDETC%dgsave ) THEN 
    4359                      mdetc2d(ji,jj) = mdetc2d(ji,jj) + (fddc * fthk) 
    4360                   ENDIF 
    4361                   IF( med_diag%GMIDC%dgsave ) THEN 
    4362                      gmidc2d(ji,jj) = gmidc2d(ji,jj) + (fgmidc * fthk) 
    4363                   ENDIF 
    4364                   IF( med_diag%GMEDC%dgsave ) THEN 
    4365                      gmedc2d(ji,jj) = gmedc2d(ji,jj) + (fgmedc  * fthk) 
    4366                   ENDIF 
    4367                   !! 
    4368 # endif                    
    4369                   !! 
    4370                   !! ** 3D diagnostics 
    4371                   IF( med_diag%TPP3%dgsave ) THEN 
    4372                      tpp3d(ji,jj,jk) =  (fprn * zphn) + (fprd * zphd) 
    4373                      !CALL iom_put( "TPP3"  , tpp3d ) 
    4374                   ENDIF 
    4375                   IF( med_diag%TPPD3%dgsave ) THEN 
    4376                      tppd3(ji,jj,jk) =  (fprd * zphd) 
    4377                   ENDIF 
    4378                    
    4379                   IF( med_diag%REMIN3N%dgsave ) THEN 
    4380                      remin3dn(ji,jj,jk) = fregen + (freminn * fthk) !! remineralisation 
    4381                      !CALL iom_put( "REMIN3N"  , remin3dn ) 
    4382                   ENDIF 
    4383                   !! IF( med_diag%PH3%dgsave ) THEN 
    4384                   !!     CALL iom_put( "PH3"  , f3_pH ) 
    4385                   !! ENDIF 
    4386                   !! IF( med_diag%OM_CAL3%dgsave ) THEN 
    4387                   !!     CALL iom_put( "OM_CAL3"  , f3_omcal ) 
    4388                   !! ENDIF 
    4389         !!  
    4390         !! AXY (09/11/16): CMIP6 diagnostics 
    4391         IF ( med_diag%DCALC3%dgsave   ) THEN 
    4392                      dcalc3(ji,jj,jk) = freminca 
    4393                   ENDIF 
    4394         IF ( med_diag%FEDISS3%dgsave  ) THEN 
    4395                      fediss3(ji,jj,jk) = ffetop 
    4396                   ENDIF 
    4397         IF ( med_diag%FESCAV3%dgsave  ) THEN 
    4398                      fescav3(ji,jj,jk) = ffescav 
    4399                   ENDIF 
    4400         IF ( med_diag%MIGRAZP3%dgsave ) THEN 
    4401                      migrazp3(ji,jj,jk) = fgmipn * xthetapn 
    4402                   ENDIF 
    4403         IF ( med_diag%MIGRAZD3%dgsave ) THEN 
    4404                      migrazd3(ji,jj,jk) = fgmidc 
    4405                   ENDIF 
    4406         IF ( med_diag%MEGRAZP3%dgsave ) THEN 
    4407                      megrazp3(ji,jj,jk) = (fgmepn * xthetapn) + (fgmepd * xthetapd) 
    4408                   ENDIF 
    4409         IF ( med_diag%MEGRAZD3%dgsave ) THEN 
    4410                      megrazd3(ji,jj,jk) = fgmedc 
    4411                   ENDIF 
    4412         IF ( med_diag%MEGRAZZ3%dgsave ) THEN 
    4413                      megrazz3(ji,jj,jk) = (fgmezmi * xthetazmi) 
    4414                   ENDIF 
    4415         IF ( med_diag%PBSI3%dgsave    ) THEN 
    4416                      pbsi3(ji,jj,jk)    = (fprds * zpds) 
    4417                   ENDIF 
    4418         IF ( med_diag%PCAL3%dgsave    ) THEN 
    4419                      pcal3(ji,jj,jk)    = ftempca 
    4420                   ENDIF 
    4421         IF ( med_diag%REMOC3%dgsave   ) THEN 
    4422                      remoc3(ji,jj,jk)   = freminc 
    4423                   ENDIF 
    4424         IF ( med_diag%PNLIMJ3%dgsave  ) THEN 
    4425                      ! pnlimj3(ji,jj,jk)  = fjln 
    4426                      pnlimj3(ji,jj,jk)  = fjlim_pn 
    4427                   ENDIF 
    4428         IF ( med_diag%PNLIMN3%dgsave  ) THEN 
    4429                      pnlimn3(ji,jj,jk)  = fnln 
    4430                   ENDIF 
    4431         IF ( med_diag%PNLIMFE3%dgsave ) THEN 
    4432                      pnlimfe3(ji,jj,jk) = ffln 
    4433                   ENDIF 
    4434         IF ( med_diag%PDLIMJ3%dgsave  ) THEN 
    4435                      ! pdlimj3(ji,jj,jk)  = fjld 
    4436                      pdlimj3(ji,jj,jk)  = fjlim_pd 
    4437                   ENDIF 
    4438         IF ( med_diag%PDLIMN3%dgsave  ) THEN 
    4439                      pdlimn3(ji,jj,jk)  = fnld 
    4440                   ENDIF 
    4441         IF ( med_diag%PDLIMFE3%dgsave ) THEN 
    4442                      pdlimfe3(ji,jj,jk) = ffld 
    4443                   ENDIF 
    4444         IF ( med_diag%PDLIMSI3%dgsave ) THEN 
    4445                      pdlimsi3(ji,jj,jk) = fsld2 
    4446                   ENDIF 
    4447                   !! 
    4448                   !! ** Without using iom_use 
    4449                ELSE IF( ln_diatrc ) THEN 
    4450 #   if defined key_debug_medusa 
    4451                   IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc' 
    4452                   CALL flush(numout) 
    4453 #   endif 
    4454                   !!---------------------------------------------------------------------- 
    4455                   !! Prepare 2D diagnostics 
    4456                   !!---------------------------------------------------------------------- 
    4457                   !! 
    4458                   !! if ((kt / 240*240).eq.kt) then 
    4459                   !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt 
    4460                   !! endif      
    4461                   trc2d(ji,jj,1)  =  ftot_n(ji,jj)                             !! nitrogen inventory 
    4462                   trc2d(ji,jj,2)  =  ftot_si(ji,jj)                            !! silicon  inventory 
    4463                   trc2d(ji,jj,3)  =  ftot_fe(ji,jj)                            !! iron     inventory 
    4464                   trc2d(ji,jj,4)  = trc2d(ji,jj,4)  + (fprn  * zphn * fthk)    !! non-diatom production 
    4465                   trc2d(ji,jj,5)  = trc2d(ji,jj,5)  + (fdpn         * fthk)    !! non-diatom non-grazing losses 
    4466                   trc2d(ji,jj,6)  = trc2d(ji,jj,6)  + (fprd  * zphd * fthk)    !! diatom production 
    4467                   trc2d(ji,jj,7)  = trc2d(ji,jj,7)  + (fdpd         * fthk)    !! diatom non-grazing losses 
    4468                   !! diagnostic field  8 is (ostensibly) supplied by trcsed.F             
    4469                   trc2d(ji,jj,9)  = trc2d(ji,jj,9)  + (fprds * zpds * fthk)    !! diatom silicon production 
    4470                   trc2d(ji,jj,10) = trc2d(ji,jj,10) + (fsdiss  * fthk)         !! diatom silicon dissolution 
    4471                   trc2d(ji,jj,11) = trc2d(ji,jj,11) + (fgmipn  * fthk)         !! microzoo grazing on non-diatoms 
    4472                   trc2d(ji,jj,12) = trc2d(ji,jj,12) + (fgmid   * fthk)         !! microzoo grazing on detrital nitrogen 
    4473                   trc2d(ji,jj,13) = trc2d(ji,jj,13) + (fdzmi   * fthk)         !! microzoo non-grazing losses 
    4474                   trc2d(ji,jj,14) = trc2d(ji,jj,14) + (fgmepn  * fthk)         !! mesozoo  grazing on non-diatoms 
    4475                   trc2d(ji,jj,15) = trc2d(ji,jj,15) + (fgmepd  * fthk)         !! mesozoo  grazing on diatoms 
    4476                   trc2d(ji,jj,16) = trc2d(ji,jj,16) + (fgmezmi * fthk)         !! mesozoo  grazing on microzoo 
    4477                   trc2d(ji,jj,17) = trc2d(ji,jj,17) + (fgmed   * fthk)         !! mesozoo  grazing on detrital nitrogen 
    4478                   trc2d(ji,jj,18) = trc2d(ji,jj,18) + (fdzme   * fthk)         !! mesozoo  non-grazing losses 
    4479                   !! diagnostic field 19 is (ostensibly) supplied by trcexp.F 
    4480                   trc2d(ji,jj,20) = trc2d(ji,jj,20) + (fslown  * fthk)         !! slow sinking detritus N production 
    4481                   trc2d(ji,jj,21) = trc2d(ji,jj,21) + (fdd     * fthk)         !! detrital remineralisation 
    4482                   trc2d(ji,jj,22) = trc2d(ji,jj,22) + (ffetop  * fthk)         !! aeolian  iron addition 
    4483                   trc2d(ji,jj,23) = trc2d(ji,jj,23) + (ffebot  * fthk)         !! seafloor iron addition 
    4484                   trc2d(ji,jj,24) = trc2d(ji,jj,24) + (ffescav * fthk)         !! "free" iron scavenging 
    4485                   trc2d(ji,jj,25) = trc2d(ji,jj,25) + (fjlim_pn * zphn * fthk) !! non-diatom J  limitation term  
    4486                   trc2d(ji,jj,26) = trc2d(ji,jj,26) + (fnln  * zphn * fthk)    !! non-diatom N  limitation term  
    4487                   trc2d(ji,jj,27) = trc2d(ji,jj,27) + (ffln  * zphn * fthk)    !! non-diatom Fe limitation term  
    4488                   trc2d(ji,jj,28) = trc2d(ji,jj,28) + (fjlim_pd * zphd * fthk) !! diatom     J  limitation term  
    4489                   trc2d(ji,jj,29) = trc2d(ji,jj,29) + (fnld  * zphd * fthk)    !! diatom     N  limitation term  
    4490                   trc2d(ji,jj,30) = trc2d(ji,jj,30) + (ffld  * zphd * fthk)    !! diatom     Fe limitation term  
    4491                   trc2d(ji,jj,31) = trc2d(ji,jj,31) + (fsld2 * zphd * fthk)    !! diatom     Si limitation term  
    4492                   trc2d(ji,jj,32) = trc2d(ji,jj,32) + (fsld  * zphd * fthk)    !! diatom     Si uptake limitation term 
    4493                   if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux(ji,jj)         !! slow detritus flux at  100 m 
    4494                   if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux(ji,jj)         !! slow detritus flux at  200 m 
    4495                   if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux(ji,jj)         !! slow detritus flux at  500 m 
    4496                   if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux(ji,jj)         !! slow detritus flux at 1000 m 
    4497                   trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen                   !! non-fast N  full column regeneration 
    4498                   trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi                 !! non-fast Si full column regeneration 
    4499                   if (jk.eq.i0100) trc2d(ji,jj,39) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  100 m 
    4500                   if (jk.eq.i0200) trc2d(ji,jj,40) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  200 m 
    4501                   if (jk.eq.i0500) trc2d(ji,jj,41) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  500 m 
    4502                   if (jk.eq.i1000) trc2d(ji,jj,42) = trc2d(ji,jj,37)           !! non-fast N  regeneration to 1000 m 
    4503                   trc2d(ji,jj,43) = trc2d(ji,jj,43) + (ftempn  * fthk)         !! fast sinking detritus N production 
    4504                   trc2d(ji,jj,44) = trc2d(ji,jj,44) + (ftempsi * fthk)         !! fast sinking detritus Si production 
    4505                   trc2d(ji,jj,45) = trc2d(ji,jj,45) + (ftempfe * fthk)         !! fast sinking detritus Fe production 
    4506                   trc2d(ji,jj,46) = trc2d(ji,jj,46) + (ftempc  * fthk)         !! fast sinking detritus C production 
    4507                   trc2d(ji,jj,47) = trc2d(ji,jj,47) + (ftempca * fthk)         !! fast sinking detritus CaCO3 production 
    4508                   if (jk.eq.i0100) trc2d(ji,jj,48) = ffastn(ji,jj)             !! fast detritus N  flux at  100 m 
    4509                   if (jk.eq.i0200) trc2d(ji,jj,49) = ffastn(ji,jj)             !! fast detritus N  flux at  200 m 
    4510                   if (jk.eq.i0500) trc2d(ji,jj,50) = ffastn(ji,jj)             !! fast detritus N  flux at  500 m 
    4511                   if (jk.eq.i1000) trc2d(ji,jj,51) = ffastn(ji,jj)             !! fast detritus N  flux at 1000 m 
    4512                   if (jk.eq.i0100) trc2d(ji,jj,52) = fregenfast(ji,jj)         !! N  regeneration to  100 m 
    4513                   if (jk.eq.i0200) trc2d(ji,jj,53) = fregenfast(ji,jj)         !! N  regeneration to  200 m 
    4514                   if (jk.eq.i0500) trc2d(ji,jj,54) = fregenfast(ji,jj)         !! N  regeneration to  500 m 
    4515                   if (jk.eq.i1000) trc2d(ji,jj,55) = fregenfast(ji,jj)         !! N  regeneration to 1000 m 
    4516                   if (jk.eq.i0100) trc2d(ji,jj,56) = ffastsi(ji,jj)            !! fast detritus Si flux at  100 m 
    4517                   if (jk.eq.i0200) trc2d(ji,jj,57) = ffastsi(ji,jj)            !! fast detritus Si flux at  200 m 
    4518                   if (jk.eq.i0500) trc2d(ji,jj,58) = ffastsi(ji,jj)            !! fast detritus Si flux at  500 m 
    4519                   if (jk.eq.i1000) trc2d(ji,jj,59) = ffastsi(ji,jj)            !! fast detritus Si flux at 1000 m 
    4520                   if (jk.eq.i0100) trc2d(ji,jj,60) = fregenfastsi(ji,jj)       !! Si regeneration to  100 m 
    4521                   if (jk.eq.i0200) trc2d(ji,jj,61) = fregenfastsi(ji,jj)       !! Si regeneration to  200 m 
    4522                   if (jk.eq.i0500) trc2d(ji,jj,62) = fregenfastsi(ji,jj)       !! Si regeneration to  500 m 
    4523                   if (jk.eq.i1000) trc2d(ji,jj,63) = fregenfastsi(ji,jj)       !! Si regeneration to 1000 m 
    4524                   trc2d(ji,jj,64) = trc2d(ji,jj,64) + (freminn  * fthk)        !! sum of fast-sinking N  fluxes 
    4525                   trc2d(ji,jj,65) = trc2d(ji,jj,65) + (freminsi * fthk)        !! sum of fast-sinking Si fluxes 
    4526                   trc2d(ji,jj,66) = trc2d(ji,jj,66) + (freminfe * fthk)        !! sum of fast-sinking Fe fluxes 
    4527                   trc2d(ji,jj,67) = trc2d(ji,jj,67) + (freminc  * fthk)        !! sum of fast-sinking C  fluxes 
    4528                   trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca * fthk)        !! sum of fast-sinking Ca fluxes 
    4529                   if (jk.eq.jmbathy) then 
    4530                      trc2d(ji,jj,69) = fsedn(ji,jj)                                   !! N  sedimentation flux                                   
    4531                      trc2d(ji,jj,70) = fsedsi(ji,jj)                                  !! Si sedimentation flux 
    4532                      trc2d(ji,jj,71) = fsedfe(ji,jj)                                  !! Fe sedimentation flux 
    4533                      trc2d(ji,jj,72) = fsedc(ji,jj)                                   !! C  sedimentation flux 
    4534                      trc2d(ji,jj,73) = fsedca(ji,jj)                                  !! Ca sedimentation flux 
    4535                   endif 
    4536                   if (jk.eq.1)  trc2d(ji,jj,74) = qsr(ji,jj) 
    4537                   if (jk.eq.1)  trc2d(ji,jj,75) = xpar(ji,jj,jk) 
    4538                   !! if (jk.eq.1)  trc2d(ji,jj,75) = real(iters) 
    4539                   !! diagnostic fields 76 to 80 calculated below 
    4540                   trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)           !! mixed layer non-diatom production 
    4541                   trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)           !! mixed layer     diatom production 
    4542 # if defined key_gulf_finland 
    4543                   if (jk.eq.1)  trc2d(ji,jj,83) = real(ibio_switch)            !! Gulf of Finland check 
    4544 # else 
    4545                   trc2d(ji,jj,83) = ocal_ccd(ji,jj)                            !! calcite CCD depth 
    4546 # endif 
    4547                   trc2d(ji,jj,84) = fccd(ji,jj)                                !! last model level above calcite CCD depth 
    4548                   if (jk.eq.1)     trc2d(ji,jj,85) = xFree(ji,jj)              !! surface "free" iron 
    4549                   if (jk.eq.i0200) trc2d(ji,jj,86) = xFree(ji,jj)              !! "free" iron at  100 m 
    4550                   if (jk.eq.i0200) trc2d(ji,jj,87) = xFree(ji,jj)              !! "free" iron at  200 m 
    4551                   if (jk.eq.i0500) trc2d(ji,jj,88) = xFree(ji,jj)              !! "free" iron at  500 m 
    4552                   if (jk.eq.i1000) trc2d(ji,jj,89) = xFree(ji,jj)              !! "free" iron at 1000 m 
    4553                   !! AXY (27/06/12): extract "euphotic depth" 
    4554                   if (jk.eq.1)     trc2d(ji,jj,90) = xze(ji,jj) 
    4555                   !!  
    4556 # if defined key_roam 
    4557                   !! ROAM provisionally has access to a further 20 2D diagnostics 
    4558                   if (jk .eq. 1) then 
    4559                      trc2d(ji,jj,91)  = trc2d(ji,jj,91)  + f_wind              !! surface wind 
    4560                      trc2d(ji,jj,92)  = trc2d(ji,jj,92)  + f_pco2atm           !! atmospheric pCO2 
    4561                      trc2d(ji,jj,93)  = trc2d(ji,jj,93)  + f_ph                !! ocean pH 
    4562                      trc2d(ji,jj,94)  = trc2d(ji,jj,94)  + f_pco2w             !! ocean pCO2 
    4563                      trc2d(ji,jj,95)  = trc2d(ji,jj,95)  + f_h2co3             !! ocean H2CO3 conc. 
    4564                      trc2d(ji,jj,96)  = trc2d(ji,jj,96)  + f_hco3              !! ocean HCO3 conc. 
    4565                      trc2d(ji,jj,97)  = trc2d(ji,jj,97)  + f_co3               !! ocean CO3 conc. 
    4566                      trc2d(ji,jj,98)  = trc2d(ji,jj,98)  + f_co2flux           !! air-sea CO2 flux 
    4567                      trc2d(ji,jj,99)  = trc2d(ji,jj,99)  + f_omcal(ji,jj)      !! ocean omega calcite  
    4568                      trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj)      !! ocean omega aragonite 
    4569                      trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC              !! ocean TDIC 
    4570                      trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK              !! ocean TALK 
    4571                      trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660             !! surface kw660 
    4572                      trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0               !! surface pressure 
    4573                      trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux            !! air-sea O2 flux 
    4574                      trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat             !! ocean O2 saturation 
    4575                      trc2d(ji,jj,107) = f2_ccd_cal(ji,jj)                      !! depth calcite CCD 
    4576                      trc2d(ji,jj,108) = f2_ccd_arg(ji,jj)                      !! depth aragonite CCD 
    4577                   endif 
    4578                   if (jk .eq. jmbathy) then 
    4579                      trc2d(ji,jj,109) = f3_omcal(ji,jj,jk)                     !! seafloor omega calcite 
    4580                      trc2d(ji,jj,110) = f3_omarg(ji,jj,jk)                     !! seafloor omega aragonite 
    4581                   endif 
    4582                   !! diagnostic fields 111 to 117 calculated below 
    4583                   if (jk.eq.i0100) trc2d(ji,jj,118) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  100 m 
    4584                   if (jk.eq.i0500) trc2d(ji,jj,119) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  500 m 
    4585                   if (jk.eq.i1000) trc2d(ji,jj,120) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at 1000 m 
    4586                   !! AXY (18/01/12): benthic flux diagnostics 
    4587                   if (jk.eq.jmbathy) then 
    4588                      trc2d(ji,jj,121) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj) 
    4589                      trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 
    4590                      trc2d(ji,jj,123) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj) 
    4591                      trc2d(ji,jj,124) = f_fbenin_si(ji,jj) 
    4592                      trc2d(ji,jj,125) = f_fbenin_ca(ji,jj) 
    4593                      trc2d(ji,jj,126) = f_benout_n(ji,jj) 
    4594                      trc2d(ji,jj,127) = f_benout_fe(ji,jj) 
    4595                      trc2d(ji,jj,128) = f_benout_c(ji,jj) 
    4596                      trc2d(ji,jj,129) = f_benout_si(ji,jj) 
    4597                      trc2d(ji,jj,130) = f_benout_ca(ji,jj) 
    4598                   endif 
    4599                   !! diagnostics fields 131 to 135 calculated below 
    4600                   trc2d(ji,jj,136) = f_runoff(ji,jj) 
    4601                   !! AXY (19/07/12): amended to allow for riverine nutrient addition below surface 
    4602                   trc2d(ji,jj,137) = trc2d(ji,jj,137) + (f_riv_loc_n * fthk) 
    4603                   trc2d(ji,jj,138) = trc2d(ji,jj,138) + (f_riv_loc_si * fthk) 
    4604                   trc2d(ji,jj,139) = trc2d(ji,jj,139) + (f_riv_loc_c * fthk) 
    4605                   trc2d(ji,jj,140) = trc2d(ji,jj,140) + (f_riv_loc_alk * fthk) 
    4606                   trc2d(ji,jj,141) = trc2d(ji,jj,141) + (fslowc  * fthk)       !! slow sinking detritus C production 
    4607                   if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux(ji,jj)        !! slow detritus flux at  100 m 
    4608                   if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux(ji,jj)        !! slow detritus flux at  200 m 
    4609                   if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux(ji,jj)        !! slow detritus flux at  500 m 
    4610                   if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux(ji,jj)        !! slow detritus flux at 1000 m 
    4611                   trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)        !! carbon     inventory 
    4612                   trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)        !! alkalinity inventory 
    4613                   trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)       !! oxygen     inventory 
    4614                   if (jk.eq.jmbathy) then 
    4615                      trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj) 
    4616                   endif 
    4617                   trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fthk                  !! community respiration 
    4618         !! 
    4619         !! AXY (14/02/14): a Valentines Day gift to BASIN - a shedload of new 
    4620                   !!                 diagnostics that they'll most likely never need! 
    4621                   !!                 (actually, as with all such gifts, I'm giving them 
    4622                   !!                 some things I'd like myself!) 
    4623                   !!  
    4624                   !! ---------------------------------------------------------------------- 
    4625                   !! linear losses 
    4626                   !! non-diatom 
    4627                   trc2d(ji,jj,151) = trc2d(ji,jj,151) + (fdpn2  * fthk) 
    4628                   !! diatom 
    4629                   trc2d(ji,jj,152) = trc2d(ji,jj,152) + (fdpd2  * fthk) 
    4630                   !! microzooplankton 
    4631                   trc2d(ji,jj,153) = trc2d(ji,jj,153) + (fdzmi2 * fthk) 
    4632                   !! mesozooplankton 
    4633                   trc2d(ji,jj,154) = trc2d(ji,jj,154) + (fdzme2 * fthk) 
    4634                   !! ---------------------------------------------------------------------- 
    4635                   !! microzooplankton grazing 
    4636                   !! microzooplankton messy -> N 
    4637                   trc2d(ji,jj,155) = trc2d(ji,jj,155) + (xphi * (fgmipn + fgmid) * fthk) 
    4638                   !! microzooplankton messy -> D 
    4639                   trc2d(ji,jj,156) = trc2d(ji,jj,156) + ((1. - xbetan) * finmi * fthk) 
    4640                   !! microzooplankton messy -> DIC 
    4641                   trc2d(ji,jj,157) = trc2d(ji,jj,157) + (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk) 
    4642                   !! microzooplankton messy -> Dc 
    4643                   trc2d(ji,jj,158) = trc2d(ji,jj,158) + ((1. - xbetac) * ficmi * fthk) 
    4644                   !! microzooplankton excretion 
    4645                   trc2d(ji,jj,159) = trc2d(ji,jj,159) + (fmiexcr * fthk) 
    4646                   !! microzooplankton respiration 
    4647                   trc2d(ji,jj,160) = trc2d(ji,jj,160) + (fmiresp * fthk) 
    4648                   !! microzooplankton growth 
    4649                   trc2d(ji,jj,161) = trc2d(ji,jj,161) + (fmigrow * fthk) 
    4650                   !! ---------------------------------------------------------------------- 
    4651                   !! mesozooplankton grazing 
    4652                   !! mesozooplankton messy -> N 
    4653                   trc2d(ji,jj,162) = trc2d(ji,jj,162) + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk) 
    4654                   !! mesozooplankton messy -> D 
    4655                   trc2d(ji,jj,163) = trc2d(ji,jj,163) + ((1. - xbetan) * finme * fthk) 
    4656                   !! mesozooplankton messy -> DIC 
    4657                   trc2d(ji,jj,164) = trc2d(ji,jj,164) + (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 
    4658                   &                  (xthetazmi * fgmezmi) + fgmedc) * fthk) 
    4659                   !! mesozooplankton messy -> Dc 
    4660                   trc2d(ji,jj,165) = trc2d(ji,jj,165) + ((1. - xbetac) * ficme * fthk) 
    4661                   !! mesozooplankton excretion 
    4662                   trc2d(ji,jj,166) = trc2d(ji,jj,166) + (fmeexcr * fthk) 
    4663                   !! mesozooplankton respiration 
    4664                   trc2d(ji,jj,167) = trc2d(ji,jj,167) + (fmeresp * fthk) 
    4665                   !! mesozooplankton growth 
    4666                   trc2d(ji,jj,168) = trc2d(ji,jj,168) + (fmegrow * fthk) 
    4667                   !! ---------------------------------------------------------------------- 
    4668                   !! miscellaneous 
    4669                   trc2d(ji,jj,169) = trc2d(ji,jj,169) + (fddc    * fthk) !! detrital C remineralisation 
    4670                   trc2d(ji,jj,170) = trc2d(ji,jj,170) + (fgmidc  * fthk) !! microzoo grazing on detrital carbon 
    4671                   trc2d(ji,jj,171) = trc2d(ji,jj,171) + (fgmedc  * fthk) !! mesozoo  grazing on detrital carbon 
    4672                   !! 
    4673                   !! ---------------------------------------------------------------------- 
    4674         !! 
    4675         !! AXY (23/10/14): extract primary production related surface fields to 
    4676         !!                 deal with diel cycle issues; hijacking BASIN 150m 
    4677         !!                 diagnostics to do so (see commented out diagnostics 
    4678         !!                 below this section) 
    4679         !! 
    4680         !! extract fields at surface 
    4681        !! if (jk .eq. 1) then 
    4682                  !!    trc2d(ji,jj,172) = zchn              !! Pn chlorophyll 
    4683                  !!    trc2d(ji,jj,173) = zphn              !! Pn biomass 
    4684                  !!    trc2d(ji,jj,174) = fjln              !! Pn J-term 
    4685                  !!    trc2d(ji,jj,175) = (fprn * zphn)     !! Pn PP 
    4686                  !!    trc2d(ji,jj,176) = zchd              !! Pd chlorophyll 
    4687                  !!    trc2d(ji,jj,177) = zphd              !! Pd biomass 
    4688                  !!    trc2d(ji,jj,178) = fjld              !! Pd J-term 
    4689                  !!    trc2d(ji,jj,179) = xpar(ji,jj,jk)    !! Pd PP 
    4690                  !!    trc2d(ji,jj,180) = loc_T             !! local temperature 
    4691                  !! endif 
    4692        !! !! 
    4693        !! !! extract fields at 50m (actually 44-50m) 
    4694        !! if (jk .eq. 18) then 
    4695                  !!    trc2d(ji,jj,181) = zchn              !! Pn chlorophyll 
    4696                  !!    trc2d(ji,jj,182) = zphn              !! Pn biomass 
    4697                  !!    trc2d(ji,jj,183) = fjln              !! Pn J-term 
    4698                  !!    trc2d(ji,jj,184) = (fprn * zphn)     !! Pn PP 
    4699                  !!    trc2d(ji,jj,185) = zchd              !! Pd chlorophyll 
    4700                  !!    trc2d(ji,jj,186) = zphd              !! Pd biomass 
    4701                  !!    trc2d(ji,jj,187) = fjld              !! Pd J-term 
    4702                  !!    trc2d(ji,jj,188) = xpar(ji,jj,jk)    !! Pd PP 
    4703                  !!    trc2d(ji,jj,189) = loc_T             !! local temperature 
    4704                  !! endif 
    4705        !! !! 
    4706        !! !! extract fields at 100m 
    4707        !! if (jk .eq. i0100) then 
    4708                  !!    trc2d(ji,jj,190) = zchn              !! Pn chlorophyll 
    4709                  !!    trc2d(ji,jj,191) = zphn              !! Pn biomass 
    4710                  !!    trc2d(ji,jj,192) = fjln              !! Pn J-term 
    4711                  !!    trc2d(ji,jj,193) = (fprn * zphn)     !! Pn PP 
    4712                  !!    trc2d(ji,jj,194) = zchd              !! Pd chlorophyll 
    4713                  !!    trc2d(ji,jj,195) = zphd              !! Pd biomass 
    4714                  !!    trc2d(ji,jj,196) = fjld              !! Pd J-term 
    4715                  !!    trc2d(ji,jj,197) = xpar(ji,jj,jk)    !! Pd PP 
    4716                  !!    trc2d(ji,jj,198) = loc_T             !! local temperature 
    4717                  !! endif 
    4718                  !! 
    4719                   !! extract relevant BASIN fields at 150m 
    4720                   if (jk .eq. i0150) then 
    4721                      trc2d(ji,jj,172) = trc2d(ji,jj,4)    !! Pn PP 
    4722                      trc2d(ji,jj,173) = trc2d(ji,jj,151)  !! Pn linear loss 
    4723                      trc2d(ji,jj,174) = trc2d(ji,jj,5)    !! Pn non-linear loss 
    4724                      trc2d(ji,jj,175) = trc2d(ji,jj,11)   !! Pn grazing to Zmi 
    4725                      trc2d(ji,jj,176) = trc2d(ji,jj,14)   !! Pn grazing to Zme 
    4726                      trc2d(ji,jj,177) = trc2d(ji,jj,6)    !! Pd PP 
    4727                      trc2d(ji,jj,178) = trc2d(ji,jj,152)  !! Pd linear loss 
    4728                      trc2d(ji,jj,179) = trc2d(ji,jj,7)    !! Pd non-linear loss 
    4729                      trc2d(ji,jj,180) = trc2d(ji,jj,15)   !! Pd grazing to Zme 
    4730                      trc2d(ji,jj,181) = trc2d(ji,jj,12)   !! Zmi grazing on D 
    4731                      trc2d(ji,jj,182) = trc2d(ji,jj,170)  !! Zmi grazing on Dc 
    4732                      trc2d(ji,jj,183) = trc2d(ji,jj,155)  !! Zmi messy feeding loss to N 
    4733                      trc2d(ji,jj,184) = trc2d(ji,jj,156)  !! Zmi messy feeding loss to D 
    4734                      trc2d(ji,jj,185) = trc2d(ji,jj,157)  !! Zmi messy feeding loss to DIC 
    4735                      trc2d(ji,jj,186) = trc2d(ji,jj,158)  !! Zmi messy feeding loss to Dc 
    4736                      trc2d(ji,jj,187) = trc2d(ji,jj,159)  !! Zmi excretion 
    4737                      trc2d(ji,jj,188) = trc2d(ji,jj,160)  !! Zmi respiration 
    4738                      trc2d(ji,jj,189) = trc2d(ji,jj,161)  !! Zmi growth 
    4739                      trc2d(ji,jj,190) = trc2d(ji,jj,153)  !! Zmi linear loss 
    4740                      trc2d(ji,jj,191) = trc2d(ji,jj,13)   !! Zmi non-linear loss 
    4741                      trc2d(ji,jj,192) = trc2d(ji,jj,16)   !! Zmi grazing to Zme 
    4742                      trc2d(ji,jj,193) = trc2d(ji,jj,17)   !! Zme grazing on D 
    4743                      trc2d(ji,jj,194) = trc2d(ji,jj,171)  !! Zme grazing on Dc 
    4744                      trc2d(ji,jj,195) = trc2d(ji,jj,162)  !! Zme messy feeding loss to N 
    4745                      trc2d(ji,jj,196) = trc2d(ji,jj,163)  !! Zme messy feeding loss to D 
    4746                      trc2d(ji,jj,197) = trc2d(ji,jj,164)  !! Zme messy feeding loss to DIC 
    4747                      trc2d(ji,jj,198) = trc2d(ji,jj,165)  !! Zme messy feeding loss to Dc 
    4748                      trc2d(ji,jj,199) = trc2d(ji,jj,166)  !! Zme excretion 
    4749                      trc2d(ji,jj,200) = trc2d(ji,jj,167)  !! Zme respiration 
    4750                      trc2d(ji,jj,201) = trc2d(ji,jj,168)  !! Zme growth 
    4751                      trc2d(ji,jj,202) = trc2d(ji,jj,154)  !! Zme linear loss 
    4752                      trc2d(ji,jj,203) = trc2d(ji,jj,18)   !! Zme non-linear loss 
    4753                      trc2d(ji,jj,204) = trc2d(ji,jj,20)   !! Slow detritus production, N 
    4754                      trc2d(ji,jj,205) = trc2d(ji,jj,21)   !! Slow detritus remineralisation, N 
    4755                      trc2d(ji,jj,206) = trc2d(ji,jj,141)  !! Slow detritus production, C 
    4756                      trc2d(ji,jj,207) = trc2d(ji,jj,169)  !! Slow detritus remineralisation, C 
    4757                      trc2d(ji,jj,208) = trc2d(ji,jj,43)   !! Fast detritus production, N 
    4758                      trc2d(ji,jj,209) = trc2d(ji,jj,21)   !! Fast detritus remineralisation, N 
    4759                      trc2d(ji,jj,210) = trc2d(ji,jj,64)   !! Fast detritus production, C 
    4760                      trc2d(ji,jj,211) = trc2d(ji,jj,67)   !! Fast detritus remineralisation, C 
    4761                      trc2d(ji,jj,212) = trc2d(ji,jj,150)  !! Community respiration 
    4762                      trc2d(ji,jj,213) = fslownflux(ji,jj) !! Slow detritus N flux at 150 m 
    4763                      trc2d(ji,jj,214) = fslowcflux(ji,jj) !! Slow detritus C flux at 150 m 
    4764                      trc2d(ji,jj,215) = ffastn(ji,jj)     !! Fast detritus N flux at 150 m 
    4765                      trc2d(ji,jj,216) = ffastc(ji,jj)     !! Fast detritus C flux at 150 m 
    4766                   endif 
    4767                   !!  
    4768                   !! Jpalm (11-08-2014) 
    4769                   !! Add UKESM1 diagnoatics  
    4770                   !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
    4771                   if ((jk .eq. 1) .and.( jdms.eq.1)) then 
    4772                      trc2d(ji,jj,221) = dms_surf          !! DMS surface concentration  
    4773                      !! AXY (13/03/15): add in other DMS estimates 
    4774                      trc2d(ji,jj,222) = dms_andr          !! DMS surface concentration  
    4775                      trc2d(ji,jj,223) = dms_simo          !! DMS surface concentration  
    4776                      trc2d(ji,jj,224) = dms_aran          !! DMS surface concentration  
    4777                      trc2d(ji,jj,225) = dms_hall          !! DMS surface concentration  
    4778                   endif 
    4779 # endif 
    4780                   !! other possible future diagnostics include: 
    4781                   !!   - integrated tracer values (esp. biological) 
    4782                   !!   - mixed layer tracer values 
    4783                   !!   - sub-surface chlorophyll maxima (plus depth) 
    4784                   !!   - different mixed layer depth criteria (T, sigma, var. sigma) 
    4785  
    4786                   !!---------------------------------------------------------------------- 
    4787                   !! Prepare 3D diagnostics 
    4788                   !!---------------------------------------------------------------------- 
    4789                   !! 
    4790                   trc3d(ji,jj,jk,1)  = ((fprn + fprd) * zphn)     !! primary production   
    4791                   trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj) !! detrital flux 
    4792                   trc3d(ji,jj,jk,3)  = fregen + (freminn * fthk)  !! remineralisation 
    4793 # if defined key_roam 
    4794                   trc3d(ji,jj,jk,4)  = f3_pH(ji,jj,jk)            !! pH 
    4795                   trc3d(ji,jj,jk,5)  = f3_omcal(ji,jj,jk)         !! omega calcite 
    4796 # else 
    4797                   trc3d(ji,jj,jk,4)  = ffastsi(ji,jj)             !! fast Si flux 
    4798 # endif 
    4799              ENDIF   ! end of ln_diatrc option 
    4800              !! CLOSE wet point IF..THEN loop 
    4801             endif 
    4802          !! CLOSE horizontal loops 
    4803          ENDDO 
    4804          ENDDO 
    4805          !! 
    4806              IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
    4807                  !! first - 2D diag implemented  
    4808                  !!         on every K level 
    4809                  !!----------------------------------------- 
    4810                  !!  -- 
    4811                  !!second - 2d specific k level diags 
    4812                  !! 
    4813                  !!----------------------------------------- 
    4814                  IF (jk.eq.1) THEN 
    4815 #   if defined key_debug_medusa 
    4816                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1' 
    4817                      CALL flush(numout) 
    4818 #   endif             
    4819                      !! JPALM -- 02-06-2017 -- 
    4820                      !! add Chl surf coupling 
    4821                      !! no need to output, just pass to cpl var 
    4822                      IF (lk_oasis) THEN 
    4823                           zn_chl_srf(:,:) = (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6  !! surf Chl in Kg-chl/m3 as needed for cpl 
    4824                          chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling Chl 
    4825                      END IF 
    4826                      IF( med_diag%MED_QSR%dgsave ) THEN 
    4827                          CALL iom_put( "MED_QSR"  , qsr ) ! 
    4828                      ENDIF 
    4829                      IF( med_diag%MED_XPAR%dgsave ) THEN 
    4830                          CALL iom_put( "MED_XPAR"  , xpar(:,:,jk) ) ! 
    4831                      ENDIF        
    4832                      IF( med_diag%OCAL_CCD%dgsave ) THEN 
    4833                          CALL iom_put( "OCAL_CCD"  , ocal_ccd ) ! 
    4834                      ENDIF 
    4835                      IF( med_diag%FE_0000%dgsave ) THEN 
    4836                          CALL iom_put( "FE_0000"  , xFree ) ! 
    4837                      ENDIF                      
    4838                      IF( med_diag%MED_XZE%dgsave ) THEN 
    4839                          CALL iom_put( "MED_XZE"  , xze ) ! 
    4840                      ENDIF  
    4841 # if defined key_roam                      
    4842                      IF( med_diag%WIND%dgsave ) THEN 
    4843                          CALL iom_put( "WIND"  , wndm ) 
    4844                      ENDIF 
    4845                      IF( med_diag%ATM_PCO2%dgsave ) THEN 
    4846                          CALL iom_put( "ATM_PCO2"  , f_pco2a2d ) 
    4847                          CALL wrk_dealloc( jpi, jpj,    f_pco2a2d  ) 
    4848                      ENDIF 
    4849                      IF( med_diag%OCN_PH%dgsave ) THEN 
    4850                          zw2d(:,:) = f3_pH(:,:,jk) 
    4851                          CALL iom_put( "OCN_PH"  , zw2d ) 
    4852                      ENDIF 
    4853                      IF( med_diag%OCN_PCO2%dgsave ) THEN 
    4854                         CALL iom_put( "OCN_PCO2"  , f_pco2w2d ) 
    4855                         CALL wrk_dealloc( jpi, jpj,   f_pco2w2d   ) 
    4856                      ENDIF 
    4857                      IF( med_diag%OCNH2CO3%dgsave ) THEN 
    4858                          zw2d(:,:) = f3_h2co3(:,:,jk) 
    4859                          CALL iom_put( "OCNH2CO3"  , zw2d ) 
    4860                      ENDIF 
    4861                      IF( med_diag%OCN_HCO3%dgsave ) THEN 
    4862                          zw2d(:,:) = f3_hco3(:,:,jk) 
    4863                          CALL iom_put( "OCN_HCO3"  , zw2d ) 
    4864                      ENDIF 
    4865                      IF( med_diag%OCN_CO3%dgsave ) THEN 
    4866                          zw2d(:,:) = f3_co3(:,:,jk) 
    4867                          CALL iom_put( "OCN_CO3"  , zw2d ) 
    4868                      ENDIF 
    4869                      IF( med_diag%CO2FLUX%dgsave ) THEN 
    4870                         CALL iom_put( "CO2FLUX"  , f_co2flux2d ) 
    4871                         CALL wrk_dealloc( jpi, jpj,   f_co2flux2d   ) 
    4872                      ENDIF 
    4873                      !!  
    4874                      !! AXY (10/11/16): repeat CO2 flux diagnostic in UKMO/CMIP6 units; this 
    4875                      !!                 both outputs the CO2 flux in specified units and 
    4876                      !!                 sends the resulting field to the coupler 
    4877                      !! JPALM (17/11/16): put CO2 flux (fgco2) alloc/unalloc/pass to zn  
    4878                      !!                 out of diag list request  
    4879                      CALL lbc_lnk( fgco2(:,:),'T',1. ) 
    4880                      IF( med_diag%FGCO2%dgsave ) THEN 
    4881                          CALL iom_put( "FGCO2"  , fgco2 ) 
    4882                      ENDIF 
    4883                      !! JPALM (17/11/16): should mv this fgco2 part  
    4884                      !!                   out of lk_iomput loop 
    4885                      zb_co2_flx = zn_co2_flx 
    4886                      zn_co2_flx = fgco2 
    4887                      IF (lk_oasis) THEN 
    4888                         CO2Flux_out_cpl = zn_co2_flx 
    4889                      ENDIF 
    4890                      CALL wrk_dealloc( jpi, jpj,   fgco2   ) 
    4891                      !! --- 
    4892                      IF( med_diag%OM_CAL%dgsave ) THEN 
    4893                          CALL iom_put( "OM_CAL"  , f_omcal ) 
    4894                      ENDIF 
    4895                      IF( med_diag%OM_ARG%dgsave ) THEN 
    4896                          CALL iom_put( "OM_ARG"  , f_omarg ) 
    4897                      ENDIF 
    4898                      IF( med_diag%TCO2%dgsave ) THEN 
    4899                          CALL iom_put( "TCO2"  , f_TDIC2d ) 
    4900                          CALL wrk_dealloc( jpi, jpj,   f_TDIC2d   ) 
    4901                      ENDIF 
    4902                      IF( med_diag%TALK%dgsave ) THEN 
    4903                          CALL iom_put( "TALK"  , f_TALK2d ) 
    4904                          CALL wrk_dealloc( jpi, jpj,    f_TALK2d  ) 
    4905                      ENDIF 
    4906                      IF( med_diag%KW660%dgsave ) THEN 
    4907                          CALL iom_put( "KW660"  , f_kw6602d ) 
    4908                          CALL wrk_dealloc( jpi, jpj,   f_kw6602d   ) 
    4909                      ENDIF 
    4910                      IF( med_diag%ATM_PP0%dgsave ) THEN 
    4911                          CALL iom_put( "ATM_PP0"  , f_pp02d ) 
    4912                          CALL wrk_dealloc( jpi, jpj,    f_pp02d  ) 
    4913                      ENDIF 
    4914                      IF( med_diag%O2FLUX%dgsave ) THEN 
    4915                          CALL iom_put( "O2FLUX"  , f_o2flux2d ) 
    4916                          CALL wrk_dealloc( jpi, jpj,   f_o2flux2d   ) 
    4917                      ENDIF 
    4918                      IF( med_diag%O2SAT%dgsave ) THEN 
    4919                          CALL iom_put( "O2SAT"  , f_o2sat2d ) 
    4920                          CALL wrk_dealloc( jpi, jpj,  f_o2sat2d    ) 
    4921                      ENDIF 
    4922                      IF( med_diag%CAL_CCD%dgsave ) THEN 
    4923                          CALL iom_put( "CAL_CCD"  , f2_ccd_cal ) 
    4924                      ENDIF 
    4925                      IF( med_diag%ARG_CCD%dgsave ) THEN 
    4926                          CALL iom_put( "ARG_CCD"  , f2_ccd_arg ) 
    4927                      ENDIF 
    4928                      IF (jdms .eq. 1) THEN 
    4929                        IF( med_diag%DMS_SURF%dgsave ) THEN 
    4930                          CALL lbc_lnk(dms_surf2d(:,:),'T',1. ) 
    4931                          CALL iom_put( "DMS_SURF"  , dms_surf2d ) 
    4932                          zb_dms_srf = zn_dms_srf 
    4933                          zn_dms_srf = dms_surf2d 
    4934                          IF (lk_oasis) THEN 
    4935                             DMS_out_cpl = zn_dms_srf 
    4936                          ENDIF 
    4937                          CALL wrk_dealloc( jpi, jpj,   dms_surf2d   )  
    4938                        ENDIF 
    4939                        IF( med_diag%DMS_ANDR%dgsave ) THEN 
    4940                          CALL iom_put( "DMS_ANDR"  , dms_andr2d ) 
    4941                          CALL wrk_dealloc( jpi, jpj,   dms_andr2d   ) 
    4942                        ENDIF 
    4943                        IF( med_diag%DMS_SIMO%dgsave ) THEN 
    4944                          CALL iom_put( "DMS_SIMO"  , dms_simo2d ) 
    4945                          CALL wrk_dealloc( jpi, jpj,    dms_simo2d  ) 
    4946                        ENDIF 
    4947                        IF( med_diag%DMS_ARAN%dgsave ) THEN 
    4948                          CALL iom_put( "DMS_ARAN"  , dms_aran2d ) 
    4949                          CALL wrk_dealloc( jpi, jpj,   dms_aran2d   ) 
    4950                        ENDIF 
    4951                        IF( med_diag%DMS_HALL%dgsave ) THEN 
    4952                          CALL iom_put( "DMS_HALL"  , dms_hall2d ) 
    4953                          CALL wrk_dealloc( jpi, jpj,   dms_hall2d   ) 
    4954                        ENDIF 
    4955                        IF( med_diag%DMS_ANDM%dgsave ) THEN 
    4956                          CALL iom_put( "DMS_ANDM"  , dms_andm2d ) 
    4957                          CALL wrk_dealloc( jpi, jpj,   dms_andm2d   ) 
    4958                        ENDIF 
    4959                      ENDIF 
    4960                      !! AXY (24/11/16): extra MOCSY diagnostics 
    4961                      IF( med_diag%ATM_XCO2%dgsave ) THEN 
    4962                         CALL iom_put( "ATM_XCO2"  ,   f_xco2a_2d      ) 
    4963                         CALL wrk_dealloc( jpi, jpj,   f_xco2a_2d      ) 
    4964                      ENDIF 
    4965                      IF( med_diag%OCN_FCO2%dgsave ) THEN 
    4966                         CALL iom_put( "OCN_FCO2"  ,   f_fco2w_2d      ) 
    4967                         CALL wrk_dealloc( jpi, jpj,   f_fco2w_2d      ) 
    4968                      ENDIF 
    4969                      IF( med_diag%ATM_FCO2%dgsave ) THEN 
    4970                         CALL iom_put( "ATM_FCO2"  ,   f_fco2a_2d      ) 
    4971                         CALL wrk_dealloc( jpi, jpj,   f_fco2a_2d      ) 
    4972                      ENDIF 
    4973                      IF( med_diag%OCN_RHOSW%dgsave ) THEN 
    4974                         CALL iom_put( "OCN_RHOSW"  ,  f_ocnrhosw_2d   ) 
    4975                         CALL wrk_dealloc( jpi, jpj,   f_ocnrhosw_2d   ) 
    4976                      ENDIF 
    4977                      IF( med_diag%OCN_SCHCO2%dgsave ) THEN 
    4978                         CALL iom_put( "OCN_SCHCO2"  , f_ocnschco2_2d  ) 
    4979                         CALL wrk_dealloc( jpi, jpj,   f_ocnschco2_2d  ) 
    4980                      ENDIF 
    4981                      IF( med_diag%OCN_KWCO2%dgsave ) THEN 
    4982                         CALL iom_put( "OCN_KWCO2"  ,  f_ocnkwco2_2d   ) 
    4983                         CALL wrk_dealloc( jpi, jpj,   f_ocnkwco2_2d   ) 
    4984                      ENDIF 
    4985                      IF( med_diag%OCN_K0%dgsave ) THEN 
    4986                         CALL iom_put( "OCN_K0"  ,     f_ocnk0_2d      ) 
    4987                         CALL wrk_dealloc( jpi, jpj,   f_ocnk0_2d      ) 
    4988                      ENDIF 
    4989                      IF( med_diag%CO2STARAIR%dgsave ) THEN 
    4990                         CALL iom_put( "CO2STARAIR"  , f_co2starair_2d ) 
    4991                         CALL wrk_dealloc( jpi, jpj,   f_co2starair_2d ) 
    4992                      ENDIF 
    4993                      IF( med_diag%OCN_DPCO2%dgsave ) THEN 
    4994                         CALL iom_put( "OCN_DPCO2"  ,  f_ocndpco2_2d   ) 
    4995                         CALL wrk_dealloc( jpi, jpj,   f_ocndpco2_2d   ) 
    4996                      ENDIF 
    4997 # endif                      
    4998                  ELSE IF (jk.eq.i0100) THEN  
    4999 #   if defined key_debug_medusa 
    5000                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 100' 
    5001                      CALL flush(numout) 
    5002 #   endif 
    5003                      IF( med_diag%SDT__100%dgsave ) THEN 
    5004                         zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    5005                         CALL iom_put( "SDT__100"  , zw2d ) 
    5006                      ENDIF 
    5007                      IF( med_diag%REG__100%dgsave ) THEN 
    5008                         CALL iom_put( "REG__100"  , fregen2d ) 
    5009                      ENDIF 
    5010                      IF( med_diag%FDT__100%dgsave ) THEN 
    5011                         CALL iom_put( "FDT__100"  , ffastn ) 
    5012                      ENDIF            
    5013                      IF( med_diag%RG__100F%dgsave ) THEN 
    5014                         CALL iom_put( "RG__100F"  , fregenfast ) 
    5015                      ENDIF 
    5016                      IF( med_diag%FDS__100%dgsave ) THEN 
    5017                         CALL iom_put( "FDS__100"  , ffastsi ) 
    5018                      ENDIF          
    5019                      IF( med_diag%RGS_100F%dgsave ) THEN 
    5020                         CALL iom_put( "RGS_100F"  , fregenfastsi ) 
    5021                      ENDIF 
    5022                      IF( med_diag%FE_0100%dgsave ) THEN 
    5023                         CALL iom_put( "FE_0100"  , xFree ) 
    5024                      ENDIF 
    5025 # if defined key_roam                      
    5026                      IF( med_diag%RR_0100%dgsave ) THEN 
    5027                         CALL iom_put( "RR_0100"  , ffastca2d ) 
    5028                      ENDIF                      
    5029                      IF( med_diag%SDC__100%dgsave ) THEN 
    5030                         zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 
    5031                         CALL iom_put( "SDC__100"  , zw2d ) 
    5032                      ENDIF                   
    5033                      IF( med_diag%epC100%dgsave    ) THEN 
    5034                         zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk) 
    5035                         CALL iom_put( "epC100"    , zw2d ) 
    5036                      ENDIF          
    5037                      IF( med_diag%epCALC100%dgsave ) THEN 
    5038                         CALL iom_put( "epCALC100" , ffastca ) 
    5039                      ENDIF          
    5040                      IF( med_diag%epN100%dgsave    ) THEN 
    5041                         zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk) 
    5042                         CALL iom_put( "epN100"    , zw2d ) 
    5043                      ENDIF          
    5044                      IF( med_diag%epSI100%dgsave   ) THEN 
    5045                         CALL iom_put( "epSI100"   , ffastsi ) 
    5046                      ENDIF          
    5047                  ELSE IF (jk.eq.i0150) THEN 
    5048 #   if defined key_debug_medusa 
    5049                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 150' 
    5050                      CALL flush(numout) 
    5051 #   endif 
    5052 # endif                      
    5053                  ELSE IF (jk.eq.i0200) THEN 
    5054 #   if defined key_debug_medusa 
    5055                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 200' 
    5056                      CALL flush(numout) 
    5057 #   endif 
    5058                      IF( med_diag%SDT__200%dgsave ) THEN 
    5059                         zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    5060                         CALL iom_put( "SDT__200"  , zw2d ) 
    5061                      ENDIF 
    5062                      IF( med_diag%REG__200%dgsave ) THEN 
    5063                         CALL iom_put( "REG__200"  , fregen2d ) 
    5064                      ENDIF 
    5065                      IF( med_diag%FDT__200%dgsave ) THEN 
    5066                         CALL iom_put( "FDT__200"  , ffastn ) 
    5067                      ENDIF 
    5068                      IF( med_diag%RG__200F%dgsave ) THEN 
    5069                         CALL iom_put( "RG__200F"  , fregenfast ) 
    5070                      ENDIF 
    5071                      IF( med_diag%FDS__200%dgsave ) THEN 
    5072                         CALL iom_put( "FDS__200"  , ffastsi ) 
    5073                      ENDIF 
    5074                      IF( med_diag%RGS_200F%dgsave ) THEN 
    5075                         CALL iom_put( "RGS_200F"  , fregenfastsi ) 
    5076                      ENDIF 
    5077                      IF( med_diag%FE_0200%dgsave ) THEN 
    5078                         CALL iom_put( "FE_0200"   , xFree ) 
    5079                      ENDIF 
    5080 # if defined key_roam                      
    5081                      IF( med_diag%SDC__200%dgsave ) THEN 
    5082                         zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 
    5083                         CALL iom_put( "SDC__200"  , zw2d ) 
    5084                      ENDIF 
    5085 # endif                      
    5086                  ELSE IF (jk.eq.i0500) THEN 
    5087 #   if defined key_debug_medusa 
    5088                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 500' 
    5089                      CALL flush(numout) 
    5090 #   endif 
    5091                      IF( med_diag%SDT__500%dgsave ) THEN 
    5092                         zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    5093                         CALL iom_put( "SDT__500"  , zw2d ) 
    5094                      ENDIF 
    5095                      IF( med_diag%REG__500%dgsave ) THEN 
    5096                         CALL iom_put( "REG__500"  , fregen2d ) 
    5097                      ENDIF       
    5098                      IF( med_diag%FDT__500%dgsave ) THEN 
    5099                         CALL iom_put( "FDT__500"  , ffastn ) 
    5100                      ENDIF 
    5101                      IF( med_diag%RG__500F%dgsave ) THEN 
    5102                         CALL iom_put( "RG__500F"  , fregenfast ) 
    5103                      ENDIF 
    5104                      IF( med_diag%FDS__500%dgsave ) THEN 
    5105                         CALL iom_put( "FDS__500"  , ffastsi ) 
    5106                      ENDIF 
    5107                      IF( med_diag%RGS_500F%dgsave ) THEN 
    5108                         CALL iom_put( "RGS_500F"  , fregenfastsi ) 
    5109                      ENDIF 
    5110                      IF( med_diag%FE_0500%dgsave ) THEN 
    5111                         CALL iom_put( "FE_0500"  , xFree ) 
    5112                      ENDIF 
    5113 # if defined key_roam                      
    5114                      IF( med_diag%RR_0500%dgsave ) THEN 
    5115                         CALL iom_put( "RR_0500"  , ffastca2d ) 
    5116                      ENDIF 
    5117                      IF( med_diag%SDC__500%dgsave ) THEN 
    5118                         zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 
    5119                         CALL iom_put( "SDC__500"  , zw2d ) 
    5120                      ENDIF   
    5121 # endif                       
    5122                  ELSE IF (jk.eq.i1000) THEN 
    5123 #   if defined key_debug_medusa 
    5124                      IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1000' 
    5125                      CALL flush(numout) 
    5126 #   endif 
    5127                      IF( med_diag%SDT_1000%dgsave ) THEN 
    5128                         zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    5129                         CALL iom_put( "SDT_1000"  , zw2d ) 
    5130                      ENDIF 
    5131                      IF( med_diag%REG_1000%dgsave ) THEN 
    5132                         CALL iom_put( "REG_1000"  , fregen2d ) 
    5133                      ENDIF   
    5134                      IF( med_diag%FDT_1000%dgsave ) THEN 
    5135                         CALL iom_put( "FDT_1000"  , ffastn ) 
    5136                      ENDIF 
    5137                      IF( med_diag%RG_1000F%dgsave ) THEN 
    5138                         CALL iom_put( "RG_1000F"  , fregenfast ) 
    5139                      ENDIF 
    5140                      IF( med_diag%FDS_1000%dgsave ) THEN 
    5141                         CALL iom_put( "FDS_1000"  , ffastsi ) 
    5142                      ENDIF 
    5143                      IF( med_diag%RGS1000F%dgsave ) THEN 
    5144                         CALL iom_put( "RGS1000F"  , fregenfastsi ) 
    5145                      ENDIF 
    5146                      IF( med_diag%FE_1000%dgsave ) THEN 
    5147                         CALL iom_put( "FE_1000"  , xFree ) 
    5148                      ENDIF 
    5149 # if defined key_roam                      
    5150                      IF( med_diag%RR_1000%dgsave ) THEN 
    5151                         CALL iom_put( "RR_1000"  , ffastca2d ) 
    5152                         CALL wrk_dealloc( jpi, jpj,  ffastca2d    ) 
    5153                      ENDIF 
    5154                      IF( med_diag%SDC_1000%dgsave ) THEN 
    5155                         zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 
    5156                         CALL iom_put( "SDC_1000"  , zw2d ) 
    5157                      ENDIF  
    5158 # endif                       
    5159                  ENDIF 
    5160                  !! to do on every k loop : 
    5161                  IF( med_diag%DETFLUX3%dgsave ) THEN 
    5162                       detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) !! detrital flux 
    5163                       !CALL iom_put( "DETFLUX3"  , ftot_n ) 
    5164                  ENDIF 
    5165 # if defined key_roam                      
    5166                  IF( med_diag%EXPC3%dgsave ) THEN 
    5167                     expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk) 
    5168                  ENDIF           
    5169                  IF( med_diag%EXPN3%dgsave ) THEN 
    5170                     expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) 
    5171                  ENDIF           
    5172 # endif           
    5173               ENDIF 
    5174       !! CLOSE vertical loop 
    5175       ENDDO 
    5176  
    5177       !!---------------------------------------------------------------------- 
    5178       !! Process benthic in/out fluxes 
    5179       !! These can be handled outside of the 3D calculations since the 
    5180       !! benthic pools (and fluxes) are 2D in nature; this code is 
    5181       !! (shamelessly) borrowed from corresponding code in the LOBSTER 
    5182       !! model 
    5183       !!---------------------------------------------------------------------- 
    5184       !! 
    5185       !! IF(lwp) WRITE(numout,*) 'AXY: rdt = ', rdt 
    5186       if (jorgben.eq.1) then 
    5187          za_sed_n(:,:)  = zn_sed_n(:,:)  + &  
    5188          &                ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * (rdt / 86400.) 
    5189          zn_sed_n(:,:)  = za_sed_n(:,:) 
    5190          !! 
    5191          za_sed_fe(:,:) = zn_sed_fe(:,:) + & 
    5192          &                ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * (rdt / 86400.) 
    5193          zn_sed_fe(:,:) = za_sed_fe(:,:) 
    5194          !! 
    5195          za_sed_c(:,:)  = zn_sed_c(:,:)  + & 
    5196          &                ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * (rdt / 86400.) 
    5197          zn_sed_c(:,:)  = za_sed_c(:,:) 
    5198       endif 
    5199       if (jinorgben.eq.1) then 
    5200          za_sed_si(:,:) = zn_sed_si(:,:) + &  
    5201          &                ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * (rdt / 86400.) 
    5202          zn_sed_si(:,:) = za_sed_si(:,:) 
    5203          !! 
    5204          za_sed_ca(:,:) = zn_sed_ca(:,:) + & 
    5205          &                ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * (rdt / 86400.) 
    5206          zn_sed_ca(:,:) = za_sed_ca(:,:) 
    5207       endif 
    5208       IF( ln_diatrc ) THEN 
    5209          DO jj = 2,jpjm1 
    5210             DO ji = 2,jpim1 
    5211                trc2d(ji,jj,131) = za_sed_n(ji,jj) 
    5212                trc2d(ji,jj,132) = za_sed_fe(ji,jj) 
    5213                trc2d(ji,jj,133) = za_sed_c(ji,jj) 
    5214                trc2d(ji,jj,134) = za_sed_si(ji,jj) 
    5215                trc2d(ji,jj,135) = za_sed_ca(ji,jj) 
    5216             ENDDO 
    5217          ENDDO 
    5218          !! AXY (07/07/15): temporary hijacking 
    5219 # if defined key_roam 
    5220   !!       trc2d(:,:,126) = zn_dms_chn(:,:) 
    5221   !!       trc2d(:,:,127) = zn_dms_chd(:,:) 
    5222   !!       trc2d(:,:,128) = zn_dms_mld(:,:) 
    5223   !!       trc2d(:,:,129) = zn_dms_qsr(:,:) 
    5224   !!       trc2d(:,:,130) = zn_dms_din(:,:) 
    5225 # endif 
    5226       ENDIF  
    5227       !! 
    5228       if (ibenthic.eq.2) then 
    5229          !! The code below (in this if ... then ... endif loop) is 
    5230          !! effectively commented out because it does not work as  
    5231          !! anticipated; it can be deleted at a later date 
    5232          if (jorgben.eq.1) then 
    5233             za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt 
    5234             za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt 
    5235             za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt 
    5236          endif 
    5237          if (jinorgben.eq.1) then 
    5238             za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 
    5239             za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 
    5240          endif 
    5241          !! 
    5242          !! Leap-frog scheme - only in explicit case, otherwise the time stepping 
    5243          !! is already being done in trczdf 
    5244          !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    5245          !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
    5246          !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
    5247          !!    if (jorgben.eq.1) then 
    5248          !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  ) 
    5249          !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 
    5250          !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  ) 
    5251          !!    endif 
    5252          !!    if (jinorgben.eq.1) then 
    5253          !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 
    5254          !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 
    5255          !!    endif 
    5256          !! ENDIF 
    5257          !!  
    5258          !! Time filter and swap of arrays 
    5259          IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN ! centred or tvd scheme 
    5260             IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
    5261                if (jorgben.eq.1) then 
    5262                   zb_sed_n(:,:)  = zn_sed_n(:,:) 
    5263                   zn_sed_n(:,:)  = za_sed_n(:,:) 
    5264                   za_sed_n(:,:)  = 0.0 
    5265                   !! 
    5266                   zb_sed_fe(:,:) = zn_sed_fe(:,:) 
    5267                   zn_sed_fe(:,:) = za_sed_fe(:,:) 
    5268                   za_sed_fe(:,:) = 0.0 
    5269                   !! 
    5270                   zb_sed_c(:,:)  = zn_sed_c(:,:) 
    5271                   zn_sed_c(:,:)  = za_sed_c(:,:) 
    5272                   za_sed_c(:,:)  = 0.0 
    5273                endif 
    5274                if (jinorgben.eq.1) then 
    5275                   zb_sed_si(:,:) = zn_sed_si(:,:) 
    5276                   zn_sed_si(:,:) = za_sed_si(:,:) 
    5277                   za_sed_si(:,:) = 0.0 
    5278                   !! 
    5279                   zb_sed_ca(:,:) = zn_sed_ca(:,:) 
    5280                   zn_sed_ca(:,:) = za_sed_ca(:,:) 
    5281                   za_sed_ca(:,:) = 0.0 
    5282                endif 
    5283             ELSE 
    5284                if (jorgben.eq.1) then 
    5285                   zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) ) 
    5286                   zn_sed_n(:,:)  = za_sed_n(:,:) 
    5287                   za_sed_n(:,:)  = 0.0 
    5288                   !! 
    5289                   zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:)) 
    5290                   zn_sed_fe(:,:) = za_sed_fe(:,:) 
    5291                   za_sed_fe(:,:) = 0.0 
    5292                   !! 
    5293                   zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) ) 
    5294                   zn_sed_c(:,:)  = za_sed_c(:,:) 
    5295                   za_sed_c(:,:)  = 0.0 
    5296                endif 
    5297                if (jinorgben.eq.1) then 
    5298                   zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:)) 
    5299                   zn_sed_si(:,:) = za_sed_si(:,:) 
    5300                   za_sed_si(:,:) = 0.0 
    5301                   !! 
    5302                   zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:)) 
    5303                   zn_sed_ca(:,:) = za_sed_ca(:,:) 
    5304                   za_sed_ca(:,:) = 0.0 
    5305                endif 
    5306             ENDIF 
    5307          ELSE                   !  case of smolar scheme or muscl 
    5308             if (jorgben.eq.1) then 
    5309                zb_sed_n(:,:)  = za_sed_n(:,:) 
    5310                zn_sed_n(:,:)  = za_sed_n(:,:) 
    5311                za_sed_n(:,:)  = 0.0 
    5312                !! 
    5313                zb_sed_fe(:,:) = za_sed_fe(:,:) 
    5314                zn_sed_fe(:,:) = za_sed_fe(:,:) 
    5315                za_sed_fe(:,:) = 0.0 
    5316                !! 
    5317                zb_sed_c(:,:)  = za_sed_c(:,:) 
    5318                zn_sed_c(:,:)  = za_sed_c(:,:) 
    5319                za_sed_c(:,:)  = 0.0 
    5320             endif 
    5321             if (jinorgben.eq.1) then 
    5322                zb_sed_si(:,:) = za_sed_si(:,:) 
    5323                zn_sed_si(:,:) = za_sed_si(:,:) 
    5324                za_sed_si(:,:) = 0.0 
    5325                !! 
    5326                zb_sed_ca(:,:) = za_sed_ca(:,:) 
    5327                zn_sed_ca(:,:) = za_sed_ca(:,:) 
    5328                za_sed_ca(:,:) = 0.0 
    5329             endif 
    5330          ENDIF 
    5331       endif 
    5332        
    5333       IF( ln_diatrc ) THEN 
    5334          !!---------------------------------------------------------------------- 
    5335          !! Output several accumulated diagnostics 
    5336          !!   - biomass-average phytoplankton limitation terms 
    5337          !!   - integrated tendency terms 
    5338          !!---------------------------------------------------------------------- 
    5339          !!  
    5340          DO jj = 2,jpjm1 
    5341             DO ji = 2,jpim1 
    5342                !! non-diatom phytoplankton limitations 
    5343                trc2d(ji,jj,25)  = trc2d(ji,jj,25) / MAX(ftot_pn(ji,jj), rsmall) 
    5344                trc2d(ji,jj,26)  = trc2d(ji,jj,26) / MAX(ftot_pn(ji,jj), rsmall) 
    5345                trc2d(ji,jj,27)  = trc2d(ji,jj,27) / MAX(ftot_pn(ji,jj), rsmall) 
    5346                !! diatom phytoplankton limitations 
    5347                trc2d(ji,jj,28)  = trc2d(ji,jj,28) / MAX(ftot_pd(ji,jj), rsmall) 
    5348                trc2d(ji,jj,29)  = trc2d(ji,jj,29) / MAX(ftot_pd(ji,jj), rsmall) 
    5349                trc2d(ji,jj,30)  = trc2d(ji,jj,30) / MAX(ftot_pd(ji,jj), rsmall) 
    5350                trc2d(ji,jj,31)  = trc2d(ji,jj,31) / MAX(ftot_pd(ji,jj), rsmall) 
    5351                trc2d(ji,jj,32)  = trc2d(ji,jj,32) / MAX(ftot_pd(ji,jj), rsmall) 
    5352                !! tendency terms 
    5353                trc2d(ji,jj,76)  = fflx_n(ji,jj) 
    5354                trc2d(ji,jj,77)  = fflx_si(ji,jj) 
    5355                trc2d(ji,jj,78)  = fflx_fe(ji,jj) 
    5356                !! integrated biomass 
    5357                trc2d(ji,jj,79)  = ftot_pn(ji,jj)       !! integrated non-diatom phytoplankton 
    5358                trc2d(ji,jj,80)  = ftot_pd(ji,jj)       !! integrated diatom phytoplankton 
    5359                trc2d(ji,jj,217) = ftot_zmi(ji,jj)      !! Integrated microzooplankton 
    5360                trc2d(ji,jj,218) = ftot_zme(ji,jj)      !! Integrated mesozooplankton 
    5361                trc2d(ji,jj,219) = ftot_det(ji,jj)      !! Integrated slow detritus, nitrogen 
    5362                trc2d(ji,jj,220) = ftot_dtc(ji,jj)      !! Integrated slow detritus, carbon 
    5363 # if defined key_roam 
    5364                !! the balance of nitrogen production/consumption 
    5365                trc2d(ji,jj,111) = fnit_prod(ji,jj)  !! integrated nitrogen production 
    5366                trc2d(ji,jj,112) = fnit_cons(ji,jj)  !! integrated nitrogen consumption 
    5367                !! the balance of carbon production/consumption 
    5368                trc2d(ji,jj,113) = fcar_prod(ji,jj)  !! integrated carbon production 
    5369                trc2d(ji,jj,114) = fcar_cons(ji,jj)  !! integrated carbon consumption 
    5370                !! the balance of oxygen production/consumption 
    5371                trc2d(ji,jj,115) = foxy_prod(ji,jj)  !! integrated oxygen production 
    5372                trc2d(ji,jj,116) = foxy_cons(ji,jj)  !! integrated oxygen consumption 
    5373                trc2d(ji,jj,117) = foxy_anox(ji,jj)  !! integrated unrealised oxygen consumption 
    5374 # endif 
    5375             ENDDO 
    5376          ENDDO 
    5377           
    5378 # if defined key_roam 
    5379 #  if defined key_axy_nancheck 
    5380          !!---------------------------------------------------------------------- 
    5381          !! Check for NaNs in diagnostic outputs 
    5382          !!---------------------------------------------------------------------- 
    5383          !!  
    5384          !! 2D diagnostics 
    5385          DO jn = 1,150 
    5386             fq0 = SUM(trc2d(:,:,jn)) 
    5387             !! AXY (30/01/14): "isnan" problem on HECTOR 
    5388             !! if (fq0 /= fq0 ) then 
    5389             if ( ieee_is_nan( fq0 ) ) then 
    5390                !! there's a NaN here 
    5391                if (lwp) write(numout,*) 'NAN detected in 2D diagnostic field', jn, 'at time', kt, 'at position:' 
    5392                DO jj = 1,jpj 
    5393                   DO ji = 1,jpi 
    5394                      if ( ieee_is_nan( trc2d(ji,jj,jn) ) ) then 
    5395                         if (lwp) write (numout,'(a,3i6)') 'NAN-CHECK', & 
    5396                         &        ji, jj, jn 
    5397                      endif 
    5398                   ENDDO 
    5399                ENDDO 
    5400           CALL ctl_stop( 'trcbio_medusa, NAN in 2D diagnostic field' ) 
    5401             endif 
    5402          ENDDO 
    5403          !! 
    5404          !! 3D diagnostics 
    5405          DO jn = 1,5 
    5406             fq0 = SUM(trc3d(:,:,:,jn)) 
    5407             !! AXY (30/01/14): "isnan" problem on HECTOR 
    5408             !! if (fq0 /= fq0 ) then 
    5409             if ( ieee_is_nan( fq0 ) ) then 
    5410                !! there's a NaN here 
    5411                if (lwp) write(numout,*) 'NAN detected in 3D diagnostic field', jn, 'at time', kt, 'at position:' 
    5412                DO jk = 1,jpk 
    5413                   DO jj = 1,jpj 
    5414                      DO ji = 1,jpi 
    5415                         if ( ieee_is_nan( trc3d(ji,jj,jk,jn) ) ) then 
    5416                            if (lwp) write (numout,'(a,4i6)') 'NAN-CHECK', & 
    5417                            &        ji, jj, jk, jn 
    5418                         endif 
    5419                      ENDDO 
    5420                   ENDDO 
    5421                ENDDO 
    5422           CALL ctl_stop( 'trcbio_medusa, NAN in 3D diagnostic field' ) 
    5423             endif 
    5424          ENDDO 
    5425     CALL flush(numout) 
    5426 #  endif 
    5427 # endif 
    5428  
    5429          !!---------------------------------------------------------------------- 
    5430          !! Don't know what this does; belongs to someone else ... 
    5431          !!---------------------------------------------------------------------- 
    5432          !!  
    5433          !! Lateral boundary conditions on trc2d 
    5434          DO jn=1,jp_medusa_2d 
    5435              CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 
    5436          ENDDO  
    5437  
    5438          !! Lateral boundary conditions on trc3d 
    5439          DO jn=1,jp_medusa_3d 
    5440              CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 
    5441          ENDDO  
    5442  
    5443  
    5444 # if defined key_axy_nodiag 
    5445          !!---------------------------------------------------------------------- 
    5446          !! Blank diagnostics as a NaN-trap 
    5447          !!---------------------------------------------------------------------- 
    5448          !!  
    5449          !! blank 2D diagnostic array 
    5450          trc2d(:,:,:) = 0.e0 
    5451          !! 
    5452          !! blank 3D diagnostic array 
    5453          trc3d(:,:,:,:) = 0.e0 
    5454 # endif 
    5455  
    5456  
    5457          !!---------------------------------------------------------------------- 
    5458          !! Add in XML diagnostics stuff 
    5459          !!---------------------------------------------------------------------- 
    5460          !! 
    5461          !! ** 2D diagnostics 
    5462          DO jn=1,jp_medusa_2d 
    5463             CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 
    5464          END DO 
    5465 !! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics 
    5466 !! #  if defined key_roam 
    5467 !!          DO jn=91,jp_medusa_2d 
    5468 !!             CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 
    5469 !!          END DO       
    5470 !! #  endif 
    5471          !! 
    5472          !! ** 3D diagnostics 
    5473          DO jn=1,jp_medusa_3d 
    5474             CALL iom_put(TRIM(ctrc3d(jn)), trc3d(:,:,:,jn)) 
    5475          END DO 
    5476 !! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics 
    5477 !! #  if defined key_roam 
    5478 !!          CALL iom_put(TRIM(ctrc3d(5)), trc3d(:,:,:,5)) 
    5479 !! #  endif 
    5480  
    5481  
    5482       ELSE IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 
    5483          !!!---------------------------------------------------------------------- 
    5484          !! Add very last diag calculations  
    5485          !!!---------------------------------------------------------------------- 
    5486          DO jj = 2,jpjm1 
    5487             DO ji = 2,jpim1 
    5488                !!          
    5489                IF( med_diag%PN_JLIM%dgsave ) THEN 
    5490                   fjln2d(ji,jj) = fjln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall) 
    5491                ENDIF 
    5492                IF( med_diag%PN_NLIM%dgsave ) THEN 
    5493                   fnln2d(ji,jj) = fnln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall) 
    5494                ENDIF 
    5495                IF( med_diag%PN_FELIM%dgsave ) THEN 
    5496                   ffln2d(ji,jj) = ffln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall) 
    5497                ENDIF 
    5498                IF( med_diag%PD_JLIM%dgsave ) THEN 
    5499                   fjld2d(ji,jj) = fjld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall) 
    5500                ENDIF 
    5501                IF( med_diag%PD_NLIM%dgsave ) THEN 
    5502                   fnld2d(ji,jj) = fnld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall) 
    5503                ENDIF 
    5504                IF( med_diag%PD_FELIM%dgsave ) THEN 
    5505                   ffld2d(ji,jj) = ffld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall) 
    5506                ENDIF 
    5507                IF( med_diag%PD_SILIM%dgsave ) THEN 
    5508                   fsld2d2(ji,jj) = fsld2d2(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 
    5509                ENDIF 
    5510                IF( med_diag%PDSILIM2%dgsave ) THEN 
    5511                   fsld2d(ji,jj) = fsld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall) 
     406                  !! set up model tracers 
     407                  !! negative values of state variables are not allowed to 
     408                  !! contribute to the calculated fluxes 
     409                  !! non-diatom chlorophyll 
     410                  zchn(ji,jj) = max(0.,trn(ji,jj,jk,jpchn)) 
     411                  !! diatom chlorophyll 
     412                  zchd(ji,jj) = max(0.,trn(ji,jj,jk,jpchd)) 
     413                  !! non-diatoms 
     414                  zphn(ji,jj) = max(0.,trn(ji,jj,jk,jpphn)) 
     415                  !! diatoms 
     416                  zphd(ji,jj) = max(0.,trn(ji,jj,jk,jpphd)) 
     417                  !! diatom silicon 
     418                  zpds(ji,jj) = max(0.,trn(ji,jj,jk,jppds)) 
     419                  !! AXY (28/01/10): probably need to take account of  
     420                  !! chl/biomass connection 
     421                  if (zchn(ji,jj).eq.0.) zphn(ji,jj) = 0. 
     422                  if (zchd(ji,jj).eq.0.) zphd(ji,jj) = 0. 
     423                  if (zphn(ji,jj).eq.0.) zchn(ji,jj) = 0. 
     424                  if (zphd(ji,jj).eq.0.) zchd(ji,jj) = 0. 
     425             !! AXY (23/01/14): duh - why did I forget diatom silicon? 
     426             if (zpds(ji,jj).eq.0.) zphd(ji,jj) = 0. 
     427             if (zphd(ji,jj).eq.0.) zpds(ji,jj) = 0. 
    5512428               ENDIF 
    5513429            ENDDO 
    5514430         ENDDO 
    5515          !!---------------------------------------------------------------------- 
    5516          !! Add in XML diagnostics stuff 
    5517          !!---------------------------------------------------------------------- 
    5518          !! 
    5519          !! ** 2D diagnostics 
    5520 #   if defined key_debug_medusa 
    5521          IF (lwp) write (numout,*) 'trc_bio_medusa: export all diag.' 
    5522          CALL flush(numout) 
    5523 #   endif 
    5524          IF ( med_diag%INVTN%dgsave ) THEN 
    5525             CALL iom_put( "INVTN"  , ftot_n ) 
     431 
     432         DO jj = 2,jpjm1 
     433            DO ji = 2,jpim1 
     434               if (tmask(ji,jj,jk) == 1) then 
     435                  !! microzooplankton 
     436                  zzmi(ji,jj) = max(0.,trn(ji,jj,jk,jpzmi)) 
     437                  !! mesozooplankton 
     438                  zzme(ji,jj) = max(0.,trn(ji,jj,jk,jpzme)) 
     439                  !! detrital nitrogen 
     440                  zdet(ji,jj) = max(0.,trn(ji,jj,jk,jpdet)) 
     441                  !! dissolved inorganic nitrogen 
     442                  zdin(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) 
     443                  !! dissolved silicic acid 
     444                  zsil(ji,jj) = max(0.,trn(ji,jj,jk,jpsil)) 
     445                  !! dissolved "iron" 
     446                  zfer(ji,jj) = max(0.,trn(ji,jj,jk,jpfer)) 
     447               ENDIF 
     448            ENDDO 
     449         ENDDO 
     450 
     451# if defined key_roam 
     452         DO jj = 2,jpjm1 
     453            DO ji = 2,jpim1 
     454               if (tmask(ji,jj,jk) == 1) then 
     455                  !! detrital carbon 
     456                  zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 
     457                  !! dissolved inorganic carbon 
     458                  zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic)) 
     459                  !! alkalinity 
     460                  zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk)) 
     461                  !! oxygen 
     462                  zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) 
     463#  if defined key_axy_carbchem && defined key_mocsy 
     464                  !! phosphate via DIN and Redfield 
     465                  zpho(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 
     466#  endif 
     467                  !! 
     468                  !! also need physical parameters for gas exchange  
     469                  !! calculations 
     470                  ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 
     471                  zsal(ji,jj) = tsn(ji,jj,jk,jp_sal) 
     472                  !! 
     473             !! AXY (28/02/14): check input fields 
     474                  if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then 
     475                     IF(lwp) WRITE(numout,*)                                 & 
     476                        ' trc_bio_medusa: T WARNING 2D, ',                   & 
     477                        tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem),          & 
     478                        ' at (', ji, ',', jj, ',', jk, ') at time', kt 
     479           IF(lwp) WRITE(numout,*)                                 & 
     480                        ' trc_bio_medusa: T SWITCHING 2D, ',                 & 
     481                        tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 
     482                     !! temperatur 
     483                     ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem) 
     484                  endif 
     485                  if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then 
     486                     IF(lwp) WRITE(numout,*)                                 & 
     487                        ' trc_bio_medusa: S WARNING 2D, ',                   & 
     488                        tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal),          & 
     489                        ' at (', ji, ',', jj, ',', jk, ') at time', kt 
     490                  endif 
     491               ENDIF 
     492            ENDDO 
     493         ENDDO 
     494# else 
     495         DO jj = 2,jpjm1 
     496            DO ji = 2,jpim1 
     497               if (tmask(ji,jj,jk) == 1) then 
     498                  !! implicit detrital carbon 
     499                  zdtc(ji,jj) = zdet(ji,jj) * xthetad 
     500               ENDIF 
     501            ENDDO 
     502         ENDDO 
     503# endif 
     504# if defined key_debug_medusa 
     505         DO jj = 2,jpjm1 
     506            DO ji = 2,jpim1 
     507               if (tmask(ji,jj,jk) == 1) then 
     508                  if (idf.eq.1) then 
     509                     !! AXY (15/01/10) 
     510                     if (trn(ji,jj,jk,jpdin).lt.0.) then 
     511                        IF (lwp) write (numout,*)                            & 
     512                           '------------------------------' 
     513                        IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =',    & 
     514                           trn(ji,jj,jk,jpdin) 
     515                        IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @',    & 
     516                           ji, jj, jk, kt 
     517                     endif 
     518                     if (trn(ji,jj,jk,jpsil).lt.0.) then 
     519                        IF (lwp) write (numout,*)                            & 
     520                           '------------------------------' 
     521                        IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =',    & 
     522                           trn(ji,jj,jk,jpsil) 
     523                        IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @',    & 
     524                           ji, jj, jk, kt 
     525                     endif 
     526#  if defined key_roam 
     527                     if (trn(ji,jj,jk,jpdic).lt.0.) then 
     528                        IF (lwp) write (numout,*)                            & 
     529                           '------------------------------' 
     530                        IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =',    & 
     531                           trn(ji,jj,jk,jpdic) 
     532                        IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @',    & 
     533                           ji, jj, jk, kt 
     534                     endif 
     535                     if (trn(ji,jj,jk,jpalk).lt.0.) then 
     536                        IF (lwp) write (numout,*)                            & 
     537                           '------------------------------' 
     538                        IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =',    & 
     539                           trn(ji,jj,jk,jpalk) 
     540                        IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @',    & 
     541                           ji, jj, jk, kt 
     542                     endif 
     543                     if (trn(ji,jj,jk,jpoxy).lt.0.) then 
     544                        IF (lwp) write (numout,*)                            & 
     545                           '------------------------------' 
     546                        IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =',    & 
     547                           trn(ji,jj,jk,jpoxy) 
     548                        IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @',    & 
     549                           ji, jj, jk, kt 
     550                     endif 
     551#  endif 
     552                  endif 
     553               ENDIF 
     554            ENDDO 
     555         ENDDO 
     556# endif 
     557# if defined key_debug_medusa 
     558! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17 
     559!         if (idf.eq.1.AND.idfval.eq.1) then 
     560!            DO jj = 2,jpjm1 
     561!               DO ji = 2,jpim1 
     562!                  if (tmask(ji,jj,jk) == 1) then 
     563!                     !! report state variable values 
     564!                     IF (lwp) write (numout,*)                               & 
     565!                        '------------------------------' 
     566!                     IF (lwp) write (numout,*) 'fthk(',jk,') = ',            & 
     567!                        fse3t(ji,jj,jk) 
     568!                     IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn(ji,jj) 
     569!                     IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd(ji,jj) 
     570!                     IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds(ji,jj) 
     571!                     IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi(ji,jj) 
     572!                     IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme(ji,jj) 
     573!                     IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet(ji,jj) 
     574!                     IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin(ji,jj) 
     575!                     IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil(ji,jj) 
     576!                     IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer(ji,jj) 
     577#  if defined key_roam 
     578!                     IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc(ji,jj) 
     579!                     IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic(ji,jj) 
     580!                     IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk(ji,jj) 
     581!                     IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy(ji,jj) 
     582#  endif 
     583!                  ENDIF 
     584!               ENDDO 
     585!            ENDDO 
     586!         endif 
     587# endif 
     588 
     589# if defined key_debug_medusa 
     590! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17 
     591!         if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 
     592!            DO jj = 2,jpjm1 
     593!               DO ji = 2,jpim1 
     594!                  if (tmask(ji,jj,jk) == 1) then 
     595!                     IF (lwp) write (numout,*)                               & 
     596!                       '------------------------------' 
     597!                     IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj) 
     598!                  ENDIF 
     599!               ENDDO 
     600!            ENDDO 
     601!         endif 
     602# endif 
     603 
     604         !!--------------------------------------------------------------- 
     605         !! Calculate air-sea gas exchange and river inputs 
     606         !!--------------------------------------------------------------- 
     607         IF ( jk == 1 ) THEN 
     608            CALL air_sea( kt ) 
    5526609         ENDIF 
    5527          IF ( med_diag%INVTSI%dgsave ) THEN 
    5528             CALL iom_put( "INVTSI"  , ftot_si ) 
     610 
     611         !!--------------------------------------------------------------- 
     612         !! Phytoplankton growth, zooplankton grazing and miscellaneous 
     613         !! plankton losses.  
     614         !!--------------------------------------------------------------- 
     615         CALL plankton( jk ) 
     616 
     617         !!--------------------------------------------------------------- 
     618         !! Iron chemistry and scavenging 
     619         !!--------------------------------------------------------------- 
     620         CALL iron_chem_scav( jk ) 
     621 
     622         !!--------------------------------------------------------------- 
     623         !! Detritus processes 
     624         !!--------------------------------------------------------------- 
     625         CALL detritus( jk, iball ) 
     626 
     627         !!--------------------------------------------------------------- 
     628         !! Updating tracers 
     629         !!--------------------------------------------------------------- 
     630         CALL bio_medusa_update( kt, jk ) 
     631 
     632         !!--------------------------------------------------------------- 
     633         !! Diagnostics 
     634         !!--------------------------------------------------------------- 
     635         CALL bio_medusa_diag( jk ) 
     636 
     637         !!------------------------------------------------------- 
     638         !! 2d specific k level diags 
     639         !!------------------------------------------------------- 
     640         IF( lk_iomput ) THEN 
     641            CALL bio_medusa_diag_slice( jk ) 
    5529642         ENDIF 
    5530          IF ( med_diag%INVTFE%dgsave ) THEN 
    5531             CALL iom_put( "INVTFE"  , ftot_fe ) 
    5532          ENDIF                            
    5533          IF ( med_diag%ML_PRN%dgsave ) THEN 
    5534             CALL iom_put( "ML_PRN"  , fprn_ml ) 
    5535          ENDIF 
    5536          IF ( med_diag%ML_PRD%dgsave ) THEN 
    5537             CALL iom_put( "ML_PRD"  , fprd_ml ) 
    5538          ENDIF 
    5539          IF ( med_diag%OCAL_LVL%dgsave ) THEN 
    5540             CALL iom_put( "OCAL_LVL"  , fccd ) 
    5541          ENDIF 
    5542          IF ( med_diag%PN_JLIM%dgsave ) THEN 
    5543             CALL iom_put( "PN_JLIM"  , fjln2d ) 
    5544             CALL wrk_dealloc( jpi, jpj,   fjln2d   ) 
    5545          ENDIF 
    5546          IF ( med_diag%PN_NLIM%dgsave ) THEN 
    5547             CALL iom_put( "PN_NLIM"  , fnln2d ) 
    5548             CALL wrk_dealloc( jpi, jpj,   fnln2d   ) 
    5549          ENDIF 
    5550          IF ( med_diag%PN_FELIM%dgsave ) THEN 
    5551             CALL iom_put( "PN_FELIM"  , ffln2d ) 
    5552             CALL wrk_dealloc( jpi, jpj,   ffln2d   ) 
    5553          ENDIF 
    5554          IF ( med_diag%PD_JLIM%dgsave ) THEN 
    5555             CALL iom_put( "PD_JLIM"  , fjld2d ) 
    5556             CALL wrk_dealloc( jpi, jpj,  fjld2d    ) 
    5557          ENDIF 
    5558          IF ( med_diag%PD_NLIM%dgsave ) THEN 
    5559             CALL iom_put( "PD_NLIM"  , fnld2d ) 
    5560             CALL wrk_dealloc( jpi, jpj,   fnld2d  ) 
    5561          ENDIF 
    5562          IF ( med_diag%PD_FELIM%dgsave ) THEN 
    5563             CALL iom_put( "PD_FELIM"  , ffld2d ) 
    5564             CALL wrk_dealloc( jpi, jpj,  ffld2d    ) 
    5565          ENDIF 
    5566          IF ( med_diag%PD_SILIM%dgsave ) THEN 
    5567             CALL iom_put( "PD_SILIM"  , fsld2d2 ) 
    5568             CALL wrk_dealloc( jpi, jpj,   fsld2d2   ) 
    5569          ENDIF 
    5570          IF ( med_diag%PDSILIM2%dgsave ) THEN 
    5571             CALL iom_put( "PDSILIM2"  , fsld2d ) 
    5572             CALL wrk_dealloc( jpi, jpj,   fsld2d   ) 
    5573          ENDIF 
    5574          IF ( med_diag%INTFLX_N%dgsave ) THEN 
    5575             CALL iom_put( "INTFLX_N"  , fflx_n ) 
    5576          ENDIF 
    5577          IF ( med_diag%INTFLX_SI%dgsave ) THEN 
    5578             CALL iom_put( "INTFLX_SI"  , fflx_si ) 
    5579          ENDIF 
    5580          IF ( med_diag%INTFLX_FE%dgsave ) THEN 
    5581             CALL iom_put( "INTFLX_FE"  , fflx_fe ) 
    5582          ENDIF         
    5583          IF ( med_diag%INT_PN%dgsave ) THEN 
    5584             CALL iom_put( "INT_PN"  , ftot_pn ) 
    5585          ENDIF 
    5586          IF ( med_diag%INT_PD%dgsave ) THEN 
    5587             CALL iom_put( "INT_PD"  , ftot_pd ) 
    5588          ENDIF          
    5589          IF ( med_diag%INT_ZMI%dgsave ) THEN 
    5590             CALL iom_put( "INT_ZMI"  , ftot_zmi ) 
    5591          ENDIF 
    5592          IF ( med_diag%INT_ZME%dgsave ) THEN 
    5593             CALL iom_put( "INT_ZME"  , ftot_zme ) 
    5594          ENDIF 
    5595          IF ( med_diag%INT_DET%dgsave ) THEN 
    5596             CALL iom_put( "INT_DET"  , ftot_det ) 
    5597          ENDIF 
    5598          IF ( med_diag%INT_DTC%dgsave ) THEN 
    5599             CALL iom_put( "INT_DTC"  , ftot_dtc ) 
    5600          ENDIF 
    5601          IF ( med_diag%BEN_N%dgsave ) THEN 
    5602             CALL iom_put( "BEN_N"  , za_sed_n ) 
    5603          ENDIF 
    5604          IF ( med_diag%BEN_FE%dgsave ) THEN 
    5605             CALL iom_put( "BEN_FE"  , za_sed_fe ) 
    5606          ENDIF 
    5607          IF ( med_diag%BEN_C%dgsave ) THEN 
    5608             CALL iom_put( "BEN_C"  , za_sed_c ) 
    5609          ENDIF 
    5610          IF ( med_diag%BEN_SI%dgsave ) THEN 
    5611             CALL iom_put( "BEN_SI"  , za_sed_si ) 
    5612          ENDIF 
    5613          IF ( med_diag%BEN_CA%dgsave ) THEN 
    5614             CALL iom_put( "BEN_CA"  , za_sed_ca ) 
    5615          ENDIF 
    5616          IF ( med_diag%RUNOFF%dgsave ) THEN 
    5617             CALL iom_put( "RUNOFF"  , f_runoff ) 
    5618          ENDIF  
    5619 # if defined key_roam         
    5620          IF ( med_diag%N_PROD%dgsave ) THEN 
    5621             CALL iom_put( "N_PROD"  , fnit_prod ) 
    5622          ENDIF 
    5623          IF ( med_diag%N_CONS%dgsave ) THEN 
    5624             CALL iom_put( "N_CONS"  , fnit_cons ) 
    5625          ENDIF 
    5626          IF ( med_diag%C_PROD%dgsave ) THEN 
    5627             CALL iom_put( "C_PROD"  , fcar_prod ) 
    5628          ENDIF 
    5629          IF ( med_diag%C_CONS%dgsave ) THEN 
    5630             CALL iom_put( "C_CONS"  , fcar_cons ) 
    5631          ENDIF 
    5632          IF ( med_diag%O2_PROD%dgsave ) THEN 
    5633             CALL iom_put( "O2_PROD"  , foxy_prod ) 
    5634          ENDIF 
    5635          IF ( med_diag%O2_CONS%dgsave ) THEN 
    5636             CALL iom_put( "O2_CONS"  , foxy_cons ) 
    5637          ENDIF 
    5638          IF ( med_diag%O2_ANOX%dgsave ) THEN 
    5639             CALL iom_put( "O2_ANOX"  , foxy_anox ) 
    5640          ENDIF 
    5641          IF ( med_diag%INVTC%dgsave ) THEN 
    5642             CALL iom_put( "INVTC"  , ftot_c ) 
    5643          ENDIF 
    5644          IF ( med_diag%INVTALK%dgsave ) THEN 
    5645             CALL iom_put( "INVTALK"  , ftot_a ) 
    5646          ENDIF 
    5647          IF ( med_diag%INVTO2%dgsave ) THEN 
    5648             CALL iom_put( "INVTO2"  , ftot_o2 ) 
    5649          ENDIF 
    5650          IF ( med_diag%COM_RESP%dgsave ) THEN 
    5651             CALL iom_put( "COM_RESP"  , fcomm_resp ) 
    5652          ENDIF          
    5653 # endif       
    5654          !! 
    5655          !! diagnostic filled in the i-j-k main loop 
    5656          !!-------------------------------------------- 
    5657          IF ( med_diag%PRN%dgsave ) THEN 
    5658             CALL iom_put( "PRN"  , fprn2d ) 
    5659             CALL wrk_dealloc( jpi, jpj,   fprn2d   ) 
    5660          ENDIF 
    5661          IF ( med_diag%MPN%dgsave ) THEN 
    5662             CALL iom_put( "MPN"  ,fdpn2d  ) 
    5663             CALL wrk_dealloc( jpi, jpj,    fdpn2d  ) 
    5664          ENDIF 
    5665          IF ( med_diag%PRD%dgsave ) THEN 
    5666             CALL iom_put( "PRD"  ,fprd2d  ) 
    5667             CALL wrk_dealloc( jpi, jpj,   fprd2d  ) 
    5668          ENDIF 
    5669          IF( med_diag%MPD%dgsave ) THEN 
    5670             CALL iom_put( "MPD"  , fdpd2d ) 
    5671             CALL wrk_dealloc( jpi, jpj,    fdpd2d ) 
    5672          ENDIF 
    5673          !  IF( med_diag%DSED%dgsave ) THEN 
    5674          !      CALL iom_put( "DSED"  , ftot_n ) 
    5675          !  ENDIF 
    5676          IF( med_diag%OPAL%dgsave ) THEN 
    5677             CALL iom_put( "OPAL"  , fprds2d ) 
    5678             CALL wrk_dealloc( jpi, jpj,   fprds2d  ) 
    5679          ENDIF 
    5680          IF( med_diag%OPALDISS%dgsave ) THEN 
    5681             CALL iom_put( "OPALDISS"  , fsdiss2d ) 
    5682             CALL wrk_dealloc( jpi, jpj,   fsdiss2d  ) 
    5683          ENDIF 
    5684          IF( med_diag%GMIPn%dgsave ) THEN 
    5685             CALL iom_put( "GMIPn"  , fgmipn2d ) 
    5686             CALL wrk_dealloc( jpi, jpj,   fgmipn2d  ) 
    5687          ENDIF 
    5688          IF( med_diag%GMID%dgsave ) THEN 
    5689             CALL iom_put( "GMID"  , fgmid2d ) 
    5690             CALL wrk_dealloc( jpi, jpj,  fgmid2d  ) 
    5691          ENDIF 
    5692          IF( med_diag%MZMI%dgsave ) THEN 
    5693             CALL iom_put( "MZMI"  , fdzmi2d ) 
    5694             CALL wrk_dealloc( jpi, jpj,   fdzmi2d   ) 
    5695          ENDIF 
    5696          IF( med_diag%GMEPN%dgsave ) THEN 
    5697             CALL iom_put( "GMEPN"  , fgmepn2d ) 
    5698             CALL wrk_dealloc( jpi, jpj,   fgmepn2d  ) 
    5699          ENDIF 
    5700          IF( med_diag%GMEPD%dgsave ) THEN 
    5701             CALL iom_put( "GMEPD"  , fgmepd2d ) 
    5702             CALL wrk_dealloc( jpi, jpj,   fgmepd2d   ) 
    5703          ENDIF 
    5704          IF( med_diag%GMEZMI%dgsave ) THEN 
    5705             CALL iom_put( "GMEZMI"  , fgmezmi2d ) 
    5706             CALL wrk_dealloc( jpi, jpj,   fgmezmi2d   ) 
    5707          ENDIF 
    5708          IF( med_diag%GMED%dgsave ) THEN 
    5709             CALL iom_put( "GMED"  , fgmed2d ) 
    5710             CALL wrk_dealloc( jpi, jpj,    fgmed2d  ) 
    5711          ENDIF 
    5712          IF( med_diag%MZME%dgsave ) THEN 
    5713             CALL iom_put( "MZME"  , fdzme2d ) 
    5714             CALL wrk_dealloc( jpi, jpj,  fdzme2d    ) 
    5715          ENDIF 
    5716          !  IF( med_diag%DEXP%dgsave ) THEN 
    5717          !      CALL iom_put( "DEXP"  , ftot_n ) 
    5718          !  ENDIF 
    5719          IF( med_diag%DETN%dgsave ) THEN 
    5720             CALL iom_put( "DETN"  , fslown2d ) 
    5721             CALL wrk_dealloc( jpi, jpj,  fslown2d    ) 
    5722          ENDIF 
    5723          IF( med_diag%MDET%dgsave ) THEN 
    5724             CALL iom_put( "MDET"  , fdd2d ) 
    5725             CALL wrk_dealloc( jpi, jpj,   fdd2d   ) 
    5726          ENDIF 
    5727          IF( med_diag%AEOLIAN%dgsave ) THEN 
    5728             CALL iom_put( "AEOLIAN"  , ffetop2d ) 
    5729             CALL wrk_dealloc( jpi, jpj,   ffetop2d   ) 
    5730          ENDIF 
    5731          IF( med_diag%BENTHIC%dgsave ) THEN 
    5732             CALL iom_put( "BENTHIC"  , ffebot2d ) 
    5733             CALL wrk_dealloc( jpi, jpj,   ffebot2d   ) 
    5734          ENDIF 
    5735          IF( med_diag%SCAVENGE%dgsave ) THEN 
    5736             CALL iom_put( "SCAVENGE"  , ffescav2d ) 
    5737             CALL wrk_dealloc( jpi, jpj,   ffescav2d  ) 
    5738          ENDIF 
    5739          !!  
    5740          IF( med_diag%TOTREG_N%dgsave ) THEN 
    5741             CALL iom_put( "TOTREG_N"  , fregen2d ) 
    5742             CALL wrk_dealloc( jpi, jpj,   fregen2d   ) 
    5743          ENDIF 
    5744          IF( med_diag%TOTRG_SI%dgsave ) THEN 
    5745             CALL iom_put( "TOTRG_SI"  , fregensi2d ) 
    5746             CALL wrk_dealloc( jpi, jpj,    fregensi2d  ) 
    5747          ENDIF 
    5748          !!  
    5749          IF( med_diag%FASTN%dgsave ) THEN 
    5750             CALL iom_put( "FASTN"  , ftempn2d ) 
    5751             CALL wrk_dealloc( jpi, jpj,   ftempn2d   ) 
    5752          ENDIF 
    5753          IF( med_diag%FASTSI%dgsave ) THEN 
    5754             CALL iom_put( "FASTSI"  , ftempsi2d ) 
    5755             CALL wrk_dealloc( jpi, jpj,   ftempsi2d   ) 
    5756          ENDIF 
    5757          IF( med_diag%FASTFE%dgsave ) THEN 
    5758             CALL iom_put( "FASTFE"  , ftempfe2d ) 
    5759             CALL wrk_dealloc( jpi, jpj,    ftempfe2d  ) 
    5760          ENDIF 
    5761          IF( med_diag%FASTC%dgsave ) THEN 
    5762             CALL iom_put( "FASTC"  , ftempc2d ) 
    5763             CALL wrk_dealloc( jpi, jpj,  ftempc2d    ) 
    5764          ENDIF 
    5765          IF( med_diag%FASTCA%dgsave ) THEN 
    5766             CALL iom_put( "FASTCA"  , ftempca2d ) 
    5767             CALL wrk_dealloc( jpi, jpj,  ftempca2d   ) 
    5768          ENDIF 
    5769          !!  
    5770          IF( med_diag%REMINN%dgsave ) THEN 
    5771             CALL iom_put( "REMINN"  , freminn2d ) 
    5772             CALL wrk_dealloc( jpi, jpj,   freminn2d   ) 
    5773          ENDIF 
    5774          IF( med_diag%REMINSI%dgsave ) THEN 
    5775             CALL iom_put( "REMINSI"  , freminsi2d ) 
    5776             CALL wrk_dealloc( jpi, jpj,   freminsi2d   ) 
    5777          ENDIF 
    5778          IF( med_diag%REMINFE%dgsave ) THEN 
    5779             CALL iom_put( "REMINFE"  , freminfe2d ) 
    5780             CALL wrk_dealloc( jpi, jpj,  freminfe2d    ) 
    5781          ENDIF 
    5782          IF( med_diag%REMINC%dgsave ) THEN 
    5783             CALL iom_put( "REMINC"  , freminc2d ) 
    5784             CALL wrk_dealloc( jpi, jpj,    freminc2d  ) 
    5785          ENDIF 
    5786          IF( med_diag%REMINCA%dgsave ) THEN 
    5787             CALL iom_put( "REMINCA"  , freminca2d ) 
    5788             CALL wrk_dealloc( jpi, jpj,   freminca2d  ) 
    5789          ENDIF 
    5790          IF( med_diag%SEAFLRN%dgsave ) THEN 
    5791             CALL iom_put( "SEAFLRN"  , fsedn ) 
    5792          ENDIF 
    5793          IF( med_diag%SEAFLRSI%dgsave ) THEN 
    5794             CALL iom_put( "SEAFLRSI"  , fsedsi ) 
    5795          ENDIF 
    5796          IF( med_diag%SEAFLRFE%dgsave ) THEN 
    5797             CALL iom_put( "SEAFLRFE"  , fsedfe ) 
    5798          ENDIF 
    5799          IF( med_diag%SEAFLRC%dgsave ) THEN 
    5800             CALL iom_put( "SEAFLRC"  , fsedc ) 
    5801          ENDIF 
    5802          IF( med_diag%SEAFLRCA%dgsave ) THEN 
    5803             CALL iom_put( "SEAFLRCA"  , fsedca ) 
    5804          ENDIF 
    5805          !! 
    5806 # if defined key_roam             
    5807          !! 
    5808          IF( med_diag%RIV_N%dgsave ) THEN 
    5809             CALL iom_put( "RIV_N"  , rivn2d ) 
    5810             CALL wrk_dealloc( jpi, jpj,    rivn2d  ) 
    5811          ENDIF 
    5812          IF( med_diag%RIV_SI%dgsave ) THEN 
    5813             CALL iom_put( "RIV_SI"  , rivsi2d ) 
    5814             CALL wrk_dealloc( jpi, jpj,   rivsi2d   ) 
    5815          ENDIF 
    5816          IF( med_diag%RIV_C%dgsave ) THEN 
    5817             CALL iom_put( "RIV_C"  , rivc2d ) 
    5818             CALL wrk_dealloc( jpi, jpj,    rivc2d  ) 
    5819          ENDIF 
    5820          IF( med_diag%RIV_ALK%dgsave ) THEN 
    5821             CALL iom_put( "RIV_ALK"  , rivalk2d ) 
    5822             CALL wrk_dealloc( jpi, jpj,  rivalk2d    ) 
    5823          ENDIF 
    5824          IF( med_diag%DETC%dgsave ) THEN 
    5825             CALL iom_put( "DETC"  , fslowc2d ) 
    5826             CALL wrk_dealloc( jpi, jpj,   fslowc2d   ) 
    5827          ENDIF 
    5828          !! 
    5829          IF( med_diag%PN_LLOSS%dgsave ) THEN 
    5830             CALL iom_put( "PN_LLOSS"  , fdpn22d ) 
    5831             CALL wrk_dealloc( jpi, jpj,   fdpn22d   ) 
    5832          ENDIF 
    5833          IF( med_diag%PD_LLOSS%dgsave ) THEN 
    5834             CALL iom_put( "PD_LLOSS"  , fdpd22d ) 
    5835             CALL wrk_dealloc( jpi, jpj,   fdpd22d   ) 
    5836          ENDIF 
    5837          IF( med_diag%ZI_LLOSS%dgsave ) THEN 
    5838             CALL iom_put( "ZI_LLOSS"  , fdzmi22d ) 
    5839              CALL wrk_dealloc( jpi, jpj,    fdzmi22d  ) 
    5840           ENDIF 
    5841           IF( med_diag%ZE_LLOSS%dgsave ) THEN 
    5842              CALL iom_put( "ZE_LLOSS"  , fdzme22d ) 
    5843              CALL wrk_dealloc( jpi, jpj,   fdzme22d   ) 
    5844           ENDIF 
    5845           IF( med_diag%ZI_MES_N%dgsave ) THEN 
    5846              CALL iom_put( "ZI_MES_N"  , zimesn2d ) 
    5847              CALL wrk_dealloc( jpi, jpj,    zimesn2d  ) 
    5848           ENDIF 
    5849           IF( med_diag%ZI_MES_D%dgsave ) THEN 
    5850              CALL iom_put( "ZI_MES_D"  , zimesd2d ) 
    5851              CALL wrk_dealloc( jpi, jpj,    zimesd2d  ) 
    5852           ENDIF 
    5853           IF( med_diag%ZI_MES_C%dgsave ) THEN 
    5854              CALL iom_put( "ZI_MES_C"  , zimesc2d ) 
    5855              CALL wrk_dealloc( jpi, jpj,    zimesc2d  ) 
    5856           ENDIF 
    5857           IF( med_diag%ZI_MESDC%dgsave ) THEN 
    5858              CALL iom_put( "ZI_MESDC"  ,zimesdc2d  ) 
    5859              CALL wrk_dealloc( jpi, jpj,    zimesdc2d  ) 
    5860           ENDIF 
    5861           IF( med_diag%ZI_EXCR%dgsave ) THEN 
    5862              CALL iom_put( "ZI_EXCR"  , ziexcr2d ) 
    5863              CALL wrk_dealloc( jpi, jpj,    ziexcr2d ) 
    5864           ENDIF 
    5865           IF( med_diag%ZI_RESP%dgsave ) THEN 
    5866              CALL iom_put( "ZI_RESP"  , ziresp2d ) 
    5867              CALL wrk_dealloc( jpi, jpj,   ziresp2d   ) 
    5868           ENDIF 
    5869           IF( med_diag%ZI_GROW%dgsave ) THEN 
    5870              CALL iom_put( "ZI_GROW"  , zigrow2d ) 
    5871              CALL wrk_dealloc( jpi, jpj,   zigrow2d   ) 
    5872           ENDIF 
    5873           IF( med_diag%ZE_MES_N%dgsave ) THEN 
    5874              CALL iom_put( "ZE_MES_N"  , zemesn2d ) 
    5875              CALL wrk_dealloc( jpi, jpj,    zemesn2d  ) 
    5876           ENDIF 
    5877           IF( med_diag%ZE_MES_D%dgsave ) THEN 
    5878              CALL iom_put( "ZE_MES_D"  , zemesd2d ) 
    5879              CALL wrk_dealloc( jpi, jpj,    zemesd2d  ) 
    5880           ENDIF 
    5881           IF( med_diag%ZE_MES_C%dgsave ) THEN 
    5882              CALL iom_put( "ZE_MES_C"  , zemesc2d ) 
    5883              CALL wrk_dealloc( jpi, jpj,   zemesc2d   ) 
    5884           ENDIF 
    5885           IF( med_diag%ZE_MESDC%dgsave ) THEN 
    5886              CALL iom_put( "ZE_MESDC"  , zemesdc2d ) 
    5887              CALL wrk_dealloc( jpi, jpj,   zemesdc2d   ) 
    5888           ENDIF 
    5889           IF( med_diag%ZE_EXCR%dgsave ) THEN 
    5890              CALL iom_put( "ZE_EXCR"  , zeexcr2d ) 
    5891              CALL wrk_dealloc( jpi, jpj,   zeexcr2d   ) 
    5892           ENDIF 
    5893           IF( med_diag%ZE_RESP%dgsave ) THEN 
    5894              CALL iom_put( "ZE_RESP"  , zeresp2d ) 
    5895              CALL wrk_dealloc( jpi, jpj,    zeresp2d  ) 
    5896           ENDIF 
    5897           IF( med_diag%ZE_GROW%dgsave ) THEN 
    5898              CALL iom_put( "ZE_GROW"  , zegrow2d ) 
    5899              CALL wrk_dealloc( jpi, jpj,   zegrow2d   ) 
    5900           ENDIF 
    5901           IF( med_diag%MDETC%dgsave ) THEN 
    5902              CALL iom_put( "MDETC"  , mdetc2d ) 
    5903              CALL wrk_dealloc( jpi, jpj,   mdetc2d   ) 
    5904           ENDIF 
    5905           IF( med_diag%GMIDC%dgsave ) THEN 
    5906              CALL iom_put( "GMIDC"  , gmidc2d ) 
    5907              CALL wrk_dealloc( jpi, jpj,    gmidc2d  ) 
    5908           ENDIF 
    5909           IF( med_diag%GMEDC%dgsave ) THEN 
    5910              CALL iom_put( "GMEDC"  , gmedc2d ) 
    5911              CALL wrk_dealloc( jpi, jpj,    gmedc2d  ) 
    5912           ENDIF 
    5913           IF( med_diag%IBEN_N%dgsave ) THEN 
    5914              CALL iom_put( "IBEN_N"  , iben_n2d ) 
    5915              CALL wrk_dealloc( jpi, jpj,    iben_n2d  ) 
    5916           ENDIF 
    5917           IF( med_diag%IBEN_FE%dgsave ) THEN 
    5918              CALL iom_put( "IBEN_FE"  , iben_fe2d ) 
    5919              CALL wrk_dealloc( jpi, jpj,   iben_fe2d   ) 
    5920           ENDIF 
    5921           IF( med_diag%IBEN_C%dgsave ) THEN 
    5922              CALL iom_put( "IBEN_C"  , iben_c2d ) 
    5923              CALL wrk_dealloc( jpi, jpj,   iben_c2d   ) 
    5924           ENDIF 
    5925           IF( med_diag%IBEN_SI%dgsave ) THEN 
    5926              CALL iom_put( "IBEN_SI"  , iben_si2d ) 
    5927              CALL wrk_dealloc( jpi, jpj,   iben_si2d   ) 
    5928           ENDIF 
    5929           IF( med_diag%IBEN_CA%dgsave ) THEN 
    5930              CALL iom_put( "IBEN_CA"  , iben_ca2d ) 
    5931              CALL wrk_dealloc( jpi, jpj,   iben_ca2d   ) 
    5932           ENDIF 
    5933           IF( med_diag%OBEN_N%dgsave ) THEN 
    5934              CALL iom_put( "OBEN_N"  , oben_n2d ) 
    5935              CALL wrk_dealloc( jpi, jpj,    oben_n2d  ) 
    5936           ENDIF 
    5937           IF( med_diag%OBEN_FE%dgsave ) THEN 
    5938              CALL iom_put( "OBEN_FE"  , oben_fe2d ) 
    5939              CALL wrk_dealloc( jpi, jpj,    oben_fe2d  ) 
    5940           ENDIF 
    5941           IF( med_diag%OBEN_C%dgsave ) THEN 
    5942              CALL iom_put( "OBEN_C"  , oben_c2d ) 
    5943              CALL wrk_dealloc( jpi, jpj,    oben_c2d  ) 
    5944           ENDIF 
    5945           IF( med_diag%OBEN_SI%dgsave ) THEN 
    5946              CALL iom_put( "OBEN_SI"  , oben_si2d ) 
    5947              CALL wrk_dealloc( jpi, jpj,    oben_si2d  ) 
    5948           ENDIF 
    5949           IF( med_diag%OBEN_CA%dgsave ) THEN 
    5950              CALL iom_put( "OBEN_CA"  , oben_ca2d ) 
    5951              CALL wrk_dealloc( jpi, jpj, oben_ca2d     ) 
    5952           ENDIF 
    5953           IF( med_diag%SFR_OCAL%dgsave ) THEN 
    5954              CALL iom_put( "SFR_OCAL"  , sfr_ocal2d ) 
    5955              CALL wrk_dealloc( jpi, jpj,    sfr_ocal2d  ) 
    5956           ENDIF 
    5957           IF( med_diag%SFR_OARG%dgsave ) THEN 
    5958              CALL iom_put( "SFR_OARG"  , sfr_oarg2d ) 
    5959              CALL wrk_dealloc( jpi, jpj,    sfr_oarg2d  ) 
    5960           ENDIF 
    5961           IF( med_diag%LYSO_CA%dgsave ) THEN 
    5962              CALL iom_put( "LYSO_CA"  , lyso_ca2d ) 
    5963              CALL wrk_dealloc( jpi, jpj,    lyso_ca2d  ) 
    5964           ENDIF 
    5965 # endif                    
    5966           !! 
    5967           !! ** 3D diagnostics 
    5968           IF( med_diag%TPP3%dgsave ) THEN 
    5969              CALL iom_put( "TPP3"  , tpp3d ) 
    5970              CALL wrk_dealloc( jpi, jpj, jpk,   tpp3d  ) 
    5971           ENDIF 
    5972           IF( med_diag%DETFLUX3%dgsave ) THEN 
    5973              CALL iom_put( "DETFLUX3"  , detflux3d ) 
    5974              CALL wrk_dealloc( jpi, jpj, jpk,    detflux3d ) 
    5975           ENDIF 
    5976           IF( med_diag%REMIN3N%dgsave ) THEN 
    5977              CALL iom_put( "REMIN3N"  , remin3dn ) 
    5978              CALL wrk_dealloc( jpi, jpj, jpk,   remin3dn  ) 
    5979           ENDIF 
    5980 # if defined key_roam           
    5981           IF( med_diag%PH3%dgsave ) THEN 
    5982              CALL iom_put( "PH3"  , f3_pH ) 
    5983           ENDIF 
    5984           IF( med_diag%OM_CAL3%dgsave ) THEN 
    5985              CALL iom_put( "OM_CAL3"  , f3_omcal ) 
    5986           ENDIF 
    5987           !! 
    5988           !! AXY (09/11/16): 2D CMIP6 diagnostics 
    5989           IF( med_diag%INTDISSIC%dgsave ) THEN 
    5990              CALL iom_put( "INTDISSIC"  , intdissic ) 
    5991              CALL wrk_dealloc( jpi, jpj, intdissic   ) 
    5992           ENDIF           
    5993           IF( med_diag%INTDISSIN%dgsave ) THEN 
    5994              CALL iom_put( "INTDISSIN"  , intdissin ) 
    5995              CALL wrk_dealloc( jpi, jpj, intdissin   ) 
    5996           ENDIF           
    5997           IF( med_diag%INTDISSISI%dgsave ) THEN 
    5998              CALL iom_put( "INTDISSISI"  , intdissisi ) 
    5999              CALL wrk_dealloc( jpi, jpj, intdissisi  ) 
    6000           ENDIF           
    6001           IF( med_diag%INTTALK%dgsave ) THEN 
    6002              CALL iom_put( "INTTALK"  , inttalk ) 
    6003              CALL wrk_dealloc( jpi, jpj, inttalk     ) 
    6004           ENDIF           
    6005           IF( med_diag%O2min%dgsave ) THEN 
    6006              CALL iom_put( "O2min"  , o2min ) 
    6007              CALL wrk_dealloc( jpi, jpj, o2min       ) 
    6008           ENDIF           
    6009           IF( med_diag%ZO2min%dgsave ) THEN 
    6010              CALL iom_put( "ZO2min"  , zo2min ) 
    6011              CALL wrk_dealloc( jpi, jpj, zo2min      ) 
    6012           ENDIF           
    6013           IF( med_diag%FBDDTALK%dgsave ) THEN 
    6014              CALL iom_put( "FBDDTALK"  , fbddtalk   ) 
    6015              CALL wrk_dealloc( jpi, jpj, fbddtalk   ) 
    6016           ENDIF           
    6017           IF( med_diag%FBDDTDIC%dgsave ) THEN 
    6018              CALL iom_put( "FBDDTDIC"  , fbddtdic   ) 
    6019              CALL wrk_dealloc( jpi, jpj, fbddtdic   ) 
    6020           ENDIF           
    6021           IF( med_diag%FBDDTDIFE%dgsave ) THEN 
    6022              CALL iom_put( "FBDDTDIFE" , fbddtdife  ) 
    6023              CALL wrk_dealloc( jpi, jpj, fbddtdife  ) 
    6024           ENDIF           
    6025           IF( med_diag%FBDDTDIN%dgsave ) THEN 
    6026              CALL iom_put( "FBDDTDIN"  , fbddtdin   ) 
    6027              CALL wrk_dealloc( jpi, jpj, fbddtdin   ) 
    6028           ENDIF           
    6029           IF( med_diag%FBDDTDISI%dgsave ) THEN 
    6030              CALL iom_put( "FBDDTDISI" , fbddtdisi  ) 
    6031              CALL wrk_dealloc( jpi, jpj, fbddtdisi  ) 
    6032           ENDIF     
    6033           !! 
    6034           !! AXY (09/11/16): 3D CMIP6 diagnostics 
    6035           IF( med_diag%TPPD3%dgsave ) THEN 
    6036              CALL iom_put( "TPPD3"     , tppd3 ) 
    6037              CALL wrk_dealloc( jpi, jpj, jpk, tppd3      ) 
    6038           ENDIF           
    6039           IF( med_diag%BDDTALK3%dgsave ) THEN 
    6040              CALL iom_put( "BDDTALK3"  , bddtalk3 ) 
    6041              CALL wrk_dealloc( jpi, jpj, jpk, bddtalk3   ) 
    6042           ENDIF           
    6043           IF( med_diag%BDDTDIC3%dgsave ) THEN 
    6044              CALL iom_put( "BDDTDIC3"  , bddtdic3 ) 
    6045              CALL wrk_dealloc( jpi, jpj, jpk, bddtdic3   ) 
    6046           ENDIF           
    6047           IF( med_diag%BDDTDIFE3%dgsave ) THEN 
    6048              CALL iom_put( "BDDTDIFE3" , bddtdife3 ) 
    6049              CALL wrk_dealloc( jpi, jpj, jpk, bddtdife3  ) 
    6050           ENDIF           
    6051           IF( med_diag%BDDTDIN3%dgsave ) THEN 
    6052              CALL iom_put( "BDDTDIN3"  , bddtdin3 ) 
    6053              CALL wrk_dealloc( jpi, jpj, jpk, bddtdin3   ) 
    6054           ENDIF           
    6055           IF( med_diag%BDDTDISI3%dgsave ) THEN 
    6056              CALL iom_put( "BDDTDISI3" , bddtdisi3 ) 
    6057              CALL wrk_dealloc( jpi, jpj, jpk, bddtdisi3  ) 
    6058           ENDIF     
    6059           IF( med_diag%FD_NIT3%dgsave ) THEN 
    6060              CALL iom_put( "FD_NIT3"  , fd_nit3 ) 
    6061              CALL wrk_dealloc( jpi, jpj, jpk,   fd_nit3  ) 
    6062           ENDIF 
    6063           IF( med_diag%FD_SIL3%dgsave ) THEN 
    6064              CALL iom_put( "FD_SIL3"  , fd_sil3 ) 
    6065              CALL wrk_dealloc( jpi, jpj, jpk,   fd_sil3  ) 
    6066           ENDIF 
    6067           IF( med_diag%FD_CAL3%dgsave ) THEN 
    6068              CALL iom_put( "FD_CAL3"  , fd_cal3 ) 
    6069              CALL wrk_dealloc( jpi, jpj, jpk,   fd_cal3  ) 
    6070           ENDIF 
    6071           IF( med_diag%FD_CAR3%dgsave ) THEN 
    6072              CALL iom_put( "FD_CAR3"  , fd_car3 ) 
    6073              CALL wrk_dealloc( jpi, jpj, jpk,   fd_car3  ) 
    6074           ENDIF 
    6075           IF( med_diag%CO33%dgsave ) THEN 
    6076              CALL iom_put( "CO33"  , f3_co3 ) 
    6077           ENDIF                     
    6078           IF( med_diag%CO3SATARAG3%dgsave ) THEN 
    6079              CALL iom_put( "CO3SATARAG3"  , f3_omarg ) 
    6080           ENDIF                     
    6081           IF( med_diag%CO3SATCALC3%dgsave ) THEN 
    6082              CALL iom_put( "CO3SATCALC3"  , f3_omcal ) 
    6083           ENDIF                     
    6084           IF( med_diag%EXPC3%dgsave ) THEN 
    6085              CALL iom_put( "EXPC3"  , expc3 ) 
    6086              CALL wrk_dealloc( jpi, jpj, jpk, expc3  ) 
    6087           ENDIF                     
    6088           IF( med_diag%EXPN3%dgsave ) THEN 
    6089              CALL iom_put( "EXPN3"  , expn3 ) 
    6090              CALL wrk_dealloc( jpi, jpj, jpk, expn3  ) 
    6091           ENDIF                     
    6092           IF( med_diag%DCALC3%dgsave ) THEN 
    6093              CALL iom_put( "DCALC3"  , dcalc3 ) 
    6094              CALL wrk_dealloc( jpi, jpj, jpk, dcalc3  ) 
    6095           ENDIF                     
    6096           IF( med_diag%FEDISS3%dgsave ) THEN 
    6097              CALL iom_put( "FEDISS3"  , fediss3 ) 
    6098              CALL wrk_dealloc( jpi, jpj, jpk, fediss3  ) 
    6099           ENDIF                     
    6100           IF( med_diag%FESCAV3%dgsave ) THEN 
    6101              CALL iom_put( "FESCAV3"  , fescav3 ) 
    6102              CALL wrk_dealloc( jpi, jpj, jpk, fescav3  ) 
    6103           ENDIF                     
    6104           IF( med_diag%MIGRAZP3%dgsave ) THEN 
    6105              CALL iom_put( "MIGRAZP3"  , migrazp3 ) 
    6106              CALL wrk_dealloc( jpi, jpj, jpk, migrazp3  ) 
    6107           ENDIF                     
    6108           IF( med_diag%MIGRAZD3%dgsave ) THEN 
    6109              CALL iom_put( "MIGRAZD3"  , migrazd3 ) 
    6110              CALL wrk_dealloc( jpi, jpj, jpk, migrazd3  ) 
    6111           ENDIF                     
    6112           IF( med_diag%MEGRAZP3%dgsave ) THEN 
    6113              CALL iom_put( "MEGRAZP3"  , megrazp3 ) 
    6114              CALL wrk_dealloc( jpi, jpj, jpk, megrazp3  ) 
    6115           ENDIF                     
    6116           IF( med_diag%MEGRAZD3%dgsave ) THEN 
    6117              CALL iom_put( "MEGRAZD3"  , megrazd3 ) 
    6118              CALL wrk_dealloc( jpi, jpj, jpk, megrazd3  ) 
    6119           ENDIF                     
    6120           IF( med_diag%MEGRAZZ3%dgsave ) THEN 
    6121              CALL iom_put( "MEGRAZZ3"  , megrazz3 ) 
    6122              CALL wrk_dealloc( jpi, jpj, jpk, megrazz3  ) 
    6123           ENDIF                     
    6124           IF( med_diag%O2SAT3%dgsave ) THEN 
    6125              CALL iom_put( "O2SAT3"  , o2sat3 ) 
    6126              CALL wrk_dealloc( jpi, jpj, jpk, o2sat3 ) 
    6127           ENDIF                     
    6128           IF( med_diag%PBSI3%dgsave ) THEN 
    6129              CALL iom_put( "PBSI3"  , pbsi3 ) 
    6130              CALL wrk_dealloc( jpi, jpj, jpk, pbsi3  ) 
    6131           ENDIF                     
    6132           IF( med_diag%PCAL3%dgsave ) THEN 
    6133              CALL iom_put( "PCAL3"  , pcal3 ) 
    6134              CALL wrk_dealloc( jpi, jpj, jpk, pcal3  ) 
    6135           ENDIF                     
    6136           IF( med_diag%REMOC3%dgsave ) THEN 
    6137              CALL iom_put( "REMOC3"  , remoc3 ) 
    6138              CALL wrk_dealloc( jpi, jpj, jpk, remoc3 ) 
    6139           ENDIF                     
    6140           IF( med_diag%PNLIMJ3%dgsave ) THEN 
    6141              CALL iom_put( "PNLIMJ3" , pnlimj3 ) 
    6142              CALL wrk_dealloc( jpi, jpj, jpk, pnlimj3  ) 
    6143           ENDIF                     
    6144           IF( med_diag%PNLIMN3%dgsave ) THEN 
    6145              CALL iom_put( "PNLIMN3" , pnlimn3 ) 
    6146              CALL wrk_dealloc( jpi, jpj, jpk, pnlimn3  ) 
    6147           ENDIF                     
    6148           IF( med_diag%PNLIMFE3%dgsave ) THEN 
    6149              CALL iom_put( "PNLIMFE3" , pnlimfe3 ) 
    6150              CALL wrk_dealloc( jpi, jpj, jpk, pnlimfe3 ) 
    6151           ENDIF                     
    6152           IF( med_diag%PDLIMJ3%dgsave ) THEN 
    6153              CALL iom_put( "PDLIMJ3" , pdlimj3 ) 
    6154              CALL wrk_dealloc( jpi, jpj, jpk, pdlimj3  ) 
    6155           ENDIF                     
    6156           IF( med_diag%PDLIMN3%dgsave ) THEN 
    6157              CALL iom_put( "PDLIMN3" , pdlimn3 ) 
    6158              CALL wrk_dealloc( jpi, jpj, jpk, pdlimn3  ) 
    6159           ENDIF                     
    6160           IF( med_diag%PDLIMFE3%dgsave ) THEN 
    6161              CALL iom_put( "PDLIMFE3" , pdlimfe3 ) 
    6162              CALL wrk_dealloc( jpi, jpj, jpk, pdlimfe3 ) 
    6163           ENDIF                     
    6164           IF( med_diag%PDLIMSI3%dgsave ) THEN 
    6165              CALL iom_put( "PDLIMSI3" , pdlimsi3 ) 
    6166              CALL wrk_dealloc( jpi, jpj, jpk, pdlimsi3 ) 
    6167           ENDIF                     
    6168            
    6169 # endif          
    6170  
    6171           CALL wrk_dealloc( jpi, jpj,   zw2d   ) 
    6172  
    6173        ENDIF                    ! end of ln_diatrc option 
    6174  
    6175 # if defined key_trc_diabio 
    6176        !! Lateral boundary conditions on trcbio 
    6177        DO jn=1,jp_medusa_trd 
    6178           CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 
    6179        ENDDO  
    6180 # endif 
     643 
     644      !! CLOSE vertical loop 
     645      ENDDO 
     646 
     647      !!------------------------------------------------------------------ 
     648      !! Final calculations for diagnostics 
     649      !!------------------------------------------------------------------ 
     650      CALL bio_medusa_fin( kt ) 
    6181651 
    6182652# if defined key_debug_medusa 
     
    6188658 
    6189659#else 
    6190    !!====================================================================== 
     660   !!===================================================================== 
    6191661   !!  Dummy module :                                   No MEDUSA bio-model 
    6192    !!====================================================================== 
     662   !!===================================================================== 
    6193663CONTAINS 
    6194664   SUBROUTINE trc_bio_medusa( kt )                   ! Empty routine 
     
    6198668#endif  
    6199669 
    6200    !!====================================================================== 
     670   !!===================================================================== 
    6201671END MODULE  trcbio_medusa 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90

    r8131 r8657  
    9393      INTEGER :: jl, jn 
    9494      INTEGER :: ios                 ! Local integer output status for namelist read 
    95       TYPE(DIAG), DIMENSION(jp_medusa_2d)  :: meddia2d 
    96       TYPE(DIAG), DIMENSION(jp_medusa_3d)  :: meddia3d 
    97       TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio 
    9895      CHARACTER(LEN=32)   ::   clname 
    9996      !! 
    100       NAMELIST/nammeddia/ meddia3d, meddia2d     ! additional diagnostics 
    101  
    10297      !!---------------------------------------------------------------------- 
    10398 
     
    126121# if defined key_debug_medusa 
    127122      CALL flush(numout) 
    128 # endif 
    129       ! 
    130 # if defined key_debug_medusa 
    131       IF (lwp) write (numout,*) '------------------------------' 
    132       IF (lwp) write (numout,*) 'Jpalm - debug' 
    133       IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia' 
    134       IF (lwp) write (numout,*) ' ' 
    135       CALL flush(numout) 
    136 # endif 
    137  
    138      IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 
    139          ! 
    140          ! Namelist nammeddia 
    141          ! ------------------- 
    142          REWIND( numnatp_ref )              ! Namelist nammeddia in reference namelist : MEDUSA diagnostics 
    143          READ  ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901) 
    144 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    145  
    146          REWIND( numnatp_cfg )              ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics 
    147          READ  ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 ) 
    148 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
    149          IF(lwm) WRITE ( numonp, nammeddia ) 
    150  
    151 # if defined key_debug_medusa 
    152          IF (lwp) write (numout,*) '------------------------------' 
    153          IF (lwp) write (numout,*) 'Jpalm - debug' 
    154          IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK' 
    155          IF (lwp) write (numout,*) 'Check number of variable in nammeddia:' 
    156          IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d 
    157          IF (lwp) write (numout,*) ' ' 
    158          CALL flush(numout) 
    159 # endif 
    160          DO jl = 1, jp_medusa_2d 
    161             jn = jp_msa0_2d + jl - 1 
    162 # if defined key_debug_medusa 
    163             IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 2D' 
    164             IF (lwp) write (numout,*) jl,'meddia2d-sname: ',meddia2d(jl)%sname  
    165             IF (lwp) write (numout,*) jl,'meddia2d-lname: ',meddia2d(jl)%lname  
    166             IF (lwp) write (numout,*) jl,'meddia2d-units: ',meddia2d(jl)%units  
    167             CALL flush(numout) 
    168 # endif 
    169             ctrc2d(jn) = meddia2d(jl)%sname 
    170             ctrc2l(jn) = meddia2d(jl)%lname 
    171             ctrc2u(jn) = meddia2d(jl)%units 
    172          END DO 
    173  
    174          DO jl = 1, jp_medusa_3d 
    175             jn = jp_msa0_3d + jl - 1 
    176 # if defined key_debug_medusa 
    177             IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 3D' 
    178             IF (lwp) write (numout,*) jl,'meddia3d-sname: ',meddia3d(jl)%sname  
    179             IF (lwp) write (numout,*) jl,'meddia3d-lname: ',meddia3d(jl)%lname 
    180             IF (lwp) write (numout,*) jl,'meddia3d-units: ',meddia3d(jl)%units 
    181             CALL flush(numout) 
    182 # endif 
    183             ctrc3d(jn) = meddia3d(jl)%sname 
    184             ctrc3l(jn) = meddia3d(jl)%lname 
    185             ctrc3u(jn) = meddia3d(jl)%units 
    186          END DO 
    187  
    188          IF(lwp) THEN                   ! control print 
    189 # if defined key_debug_medusa 
    190             IF (lwp) write (numout,*) '------------------------------' 
    191             IF (lwp) write (numout,*) 'Jpalm - debug' 
    192             IF (lwp) write (numout,*) 'Var name assignation OK' 
    193             IF (lwp) write (numout,*) 'next check var names' 
    194             IF (lwp) write (numout,*) ' ' 
    195             CALL flush(numout) 
    196 # endif 
    197             WRITE(numout,*) 
    198             WRITE(numout,*) ' Namelist : natadd' 
    199             DO jl = 1, jp_medusa_3d 
    200                jn = jp_msa0_3d + jl - 1 
    201                WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
    202                  &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
    203             END DO 
    204             WRITE(numout,*) ' ' 
    205  
    206             DO jl = 1, jp_medusa_2d 
    207                jn = jp_msa0_2d + jl - 1 
    208                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    209                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    210             END DO 
    211             WRITE(numout,*) ' ' 
    212          ENDIF 
    213          ! 
    214       ENDIF    
    215          ! 
    216 # if defined key_debug_medusa 
    217             CALL flush(numout) 
    218123# endif 
    219124 
     
    21482053          med_diag%OCN_DPCO2%dgsave = .FALSE. 
    21492054      ENDIF 
    2150       !! 
     2055      !! UKESM additional 
     2056      IF  (iom_use("CHL_MLD")) THEN  
     2057          med_diag%CHL_MLD%dgsave = .TRUE. 
     2058      ELSE  
     2059          med_diag%CHL_MLD%dgsave = .FALSE. 
     2060      ENDIF 
     2061      !! 3D 
    21512062      IF  (iom_use("TPP3")) THEN  
    21522063          med_diag%TPP3%dgsave = .TRUE. 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r8074 r8657  
    4545 
    4646   !! * Module variables 
    47    INTEGER ::                   & 
    48      ryyss,                     &  !: number of seconds per year 
    49      rmtss                         !: number of seconds per month 
     47   !! INTEGER ::                   & 
     48     !! ryyss,                     &  !: number of seconds per year 
     49     !! rmtss                         !: number of seconds per month 
    5050 
    5151   !! AXY (10/02/09) 
     
    123123 
    124124      ! Number of seconds per year and per month 
    125       ryyss = nyear_len(1) * rday 
    126       rmtss = ryyss / raamo 
     125      !! ryyss = nyear_len(1) * rday 
     126      !! rmtss = ryyss / raamo 
    127127 
    128128      !! AXY (20/11/14): alter this to report on first MEDUSA call 
     
    173173               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    174174               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
    175 # if defined key_trc_diabio 
    176                trbio(ji,jj,jk,8) = ztra 
    177 # endif 
    178                IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
    179                      IF( med_diag%DSED%dgsave ) THEN 
    180                          zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
    181                       ENDIF    
    182                ELSE IF( ln_diatrc )  THEN 
    183                     trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
    184                ENDIF     
     175               IF( med_diag%DSED%dgsave ) THEN 
     176                   zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
     177               ENDIF    
    185178                 
    186179            END DO 
     
    188181      END DO 
    189182      ! 
    190 # if defined key_trc_diabio 
    191       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio 
    192 # endif 
    193       IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    194       !! 
    195       IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
    196            IF( med_diag%DSED%dgsave ) THEN 
    197                 CALL iom_put( "DSED"  ,  zw2d) 
    198                 CALL wrk_dealloc( jpi, jpj,    zw2d  ) 
    199             ENDIF 
    200       ELSE IF (lk_iomput .AND. ln_diatrc)  THEN     
    201           CALL iom_put( "DSED",trc2d(:,:,8) ) 
     183      IF( med_diag%DSED%dgsave ) THEN 
     184           CALL iom_put( "DSED"  ,  zw2d) 
     185           CALL wrk_dealloc( jpi, jpj,    zw2d  ) 
    202186      ENDIF 
    203187      !! 
     
    229213               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    230214               tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra 
    231 !! #  if defined key_trc_diabio 
    232 !!                trbio(ji,jj,jk,8) = ztra 
    233 !! #  endif 
    234 !!             IF( ln_diatrc ) & 
    235 !!                &  trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
    236215            END DO 
    237216         END DO 
    238217      END DO 
    239218      ! 
    240 !! #  if defined key_trc_diabio 
    241 !!       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio 
    242 !! #  endif 
    243 !!       IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    244 !! #  if defined key_iomput 
    245 !!       CALL iom_put( "DSED",trc2d(:,:,8) ) 
    246 !! #  endif 
    247219 
    248220# endif 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90

    r8074 r8657  
    88   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA 
    99   !!              -   !  2010-03  (A. Yool) updated for branch inclusion 
     10   !!              -   !  2017-08  (A. Yool) amend for slow detritus bug 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_medusa 
     
    8889#  endif 
    8990       
    90       CALL trc_sed_medusa( kt ) ! sedimentation model 
    91 #  if defined key_debug_medusa 
    92       IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 
    93       CALL flush(numout) 
    94 #  endif 
     91!! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90) 
     92!!       CALL trc_sed_medusa( kt ) ! sedimentation model 
     93!! #  if defined key_debug_medusa 
     94!!       IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 
     95!!       CALL flush(numout) 
     96!! #  endif 
    9597# endif 
    9698 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r8280 r8657  
    2929   USE trdtra 
    3030   USE prtctl_trc      ! Print control 
    31    !! USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3231 
    3332   IMPLICIT NONE 
     
    109108      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    110109      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    111       !  
    112       !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...  
    113       !! DO jn = 1, jptra 
    114       !!   CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    115       !!   CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
    116       !! END DO 
    117       ! 
    118110 
    119111      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r8356 r8657  
    7777         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    7878                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    79 # if defined key_debug_medusa 
    80          IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 
    81          CALL trc_rst_tra_stat 
    82          CALL flush(numout) 
    83 # endif 
    84  
    8579         IF( ln_zps ) THEN 
    8680           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kstp, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
     
    9589#endif 
    9690                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    97 # if defined key_debug_medusa 
    98          IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 
    99          CALL trc_rst_tra_stat 
    100          CALL flush(numout) 
    101 # endif 
    10291                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    10392# if defined key_debug_medusa 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r8280 r8657  
    1515   USE par_c14b      ! C14 bomb tracer 
    1616   USE par_cfc       ! CFC 11 and 12 tracers 
     17   USE par_age       ! AGE  tracer 
    1718   USE par_my_trc    ! user defined passive tracers 
     19   USE par_idtra     ! Idealize tracer 
    1820   USE par_medusa    ! MEDUSA model 
    19    USE par_idtra     ! Idealize tracer 
    20    USE par_age       ! AGE  tracer 
    2121 
    2222   IMPLICIT NONE 
     
    2828   ! Passive tracers : Total size 
    2929   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra     + jp_age 
    31    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d  + jp_age_2d 
    32    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d  + jp_age_3d 
     30   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_age    + jp_my_trc    + jp_idtra     + jp_medusa    
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_age_2d + jp_my_trc_2d + jp_idtra_2d  + jp_medusa_2d 
     32   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_age_3d + jp_my_trc_3d + jp_idtra_3d  + jp_medusa_3d 
    3333   !                     ! total number of sms diagnostic arrays 
    34    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 
     34   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd + jp_idtra_trd + jp_medusa_trd  
    3535    
    3636   !  1D configuration ("key_c1d") 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r8280 r8657  
    134134                  OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2,                                          & ! end of regular 2D 
    135135                  TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3,                                             & ! end of regular 3D 
     136! JPALM (01/09/17): additional UKESM 2D diag 
     137                  CHL_MLD,                                                                           & 
    136138! AXY (11/11/16): additional CMIP6 2D diagnostics 
    137139                  epC100, epCALC100, epN100, epSI100,                                                & 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r8356 r8657  
    2424   USE trcini_pisces   ! PISCES   initialisation 
    2525   USE trcini_c14b     ! C14 bomb initialisation 
     26   USE trcini_age      ! AGE      initialisation 
    2627   USE trcini_my_trc   ! MY_TRC   initialisation 
     28   USE trcini_idtra    ! idealize tracer initialisation 
    2729   USE trcini_medusa   ! MEDUSA   initialisation 
    28    USE trcini_idtra    ! idealize tracer initialisation 
    29    USE trcini_age      ! AGE      initialisation 
    3030   USE trcdta          ! initialisation from files 
    3131   USE daymod          ! calendar manager 
     
    7979         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    8080         & Computation of a daily mean shortwave for some biogeochemical models) ') 
    81           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    82           !!!!! CHECK For MEDUSA 
    83           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     81 
    8482      IF( nn_cla == 1 )   & 
    8583         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
     
    102100 
    103101      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    104       IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
    105       IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    106102      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    107103      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    108104      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
    109105      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     106      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
     107      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
    110108 
    111109      CALL trc_ice_ini                                 ! Tracers in sea ice 
    112  
    113 # if defined key_debug_medusa 
    114          IF (lwp) write (numout,*) '------------------------------' 
    115          IF (lwp) write (numout,*) 'Jpalm - debug' 
    116          IF (lwp) write (numout,*) ' in trc_init' 
    117          IF (lwp) write (numout,*) ' sms init OK' 
    118          IF (lwp) write (numout,*) ' next: open tracer.stat' 
    119          IF (lwp) write (numout,*) ' ' 
    120          CALL flush(numout) 
    121 # endif 
    122110 
    123111      IF( ln_ctl ) THEN 
     
    133121      ENDIF 
    134122 
    135 # if defined key_debug_medusa 
    136          IF (lwp) write (numout,*) '------------------------------' 
    137          IF (lwp) write (numout,*) 'Jpalm - debug' 
    138          IF (lwp) write (numout,*) ' in trc_init' 
    139          IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
    140          IF (lwp) write (numout,*) ' ' 
    141          CALL flush(numout) 
    142 # endif 
    143  
    144  
    145123      IF( ln_trcdta ) THEN 
    146 #if defined key_medusa 
    147          IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
    148          IF(lwp) CALL flush(numout) 
    149 #endif 
    150124         CALL trc_dta_init(jptra) 
    151125      ENDIF 
     
    153127      IF( ln_rsttr ) THEN 
    154128        ! 
    155 #if defined key_medusa 
    156         IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
    157         IF(lwp) CALL flush(numout) 
    158 #endif 
    159129        CALL trc_rst_read              ! restart from a file 
    160130        ! 
    161131      ELSE 
    162         ! 
    163 # if defined key_debug_medusa 
    164          IF (lwp) write (numout,*) '------------------------------' 
    165          IF (lwp) write (numout,*) 'Jpalm - debug' 
    166          IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 
    167          IF (lwp) write (numout,*) ' ' 
    168          CALL flush(numout) 
    169 # endif 
    170132        ! 
    171133        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     
    188150        ENDIF 
    189151        ! 
    190 # if defined key_debug_medusa 
    191          IF (lwp) write (numout,*) '------------------------------' 
    192          IF (lwp) write (numout,*) 'Jpalm - debug' 
    193          IF (lwp) write (numout,*) ' in trc_init' 
    194          IF (lwp) write (numout,*) ' before trb = trn' 
    195          IF (lwp) write (numout,*) ' ' 
    196          CALL flush(numout) 
    197 # endif 
    198         ! 
    199152        trb(:,:,:,:) = trn(:,:,:,:) 
    200153        !  
    201 # if defined key_debug_medusa 
    202          IF (lwp) write (numout,*) '------------------------------' 
    203          IF (lwp) write (numout,*) 'Jpalm - debug' 
    204          IF (lwp) write (numout,*) ' in trc_init' 
    205          IF (lwp) write (numout,*) ' trb = trn -- OK' 
    206          IF (lwp) write (numout,*) ' ' 
    207          CALL flush(numout) 
    208 # endif 
    209         !  
    210154      ENDIF 
    211155  
    212156      tra(:,:,:,:) = 0._wp 
    213157      ! 
    214 # if defined key_debug_medusa 
    215          IF (lwp) write (numout,*) '------------------------------' 
    216          IF (lwp) write (numout,*) 'Jpalm - debug' 
    217          IF (lwp) write (numout,*) ' in trc_init' 
    218          IF (lwp) write (numout,*) ' partial step -- OK' 
    219          IF (lwp) write (numout,*) ' ' 
    220          CALL flush(numout) 
    221 # endif 
    222       ! 
    223158      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    224159      ! 
    225 # if defined key_debug_medusa 
    226          IF (lwp) write (numout,*) '------------------------------' 
    227          IF (lwp) write (numout,*) 'Jpalm - debug' 
    228          IF (lwp) write (numout,*) ' in trc_init' 
    229          IF (lwp) write (numout,*) ' before initiate tracer contents' 
    230          IF (lwp) write (numout,*) ' ' 
    231          CALL flush(numout) 
    232 # endif 
    233       ! 
     160 
    234161      trai(:) = 0._wp                                                   ! initial content of all tracers 
    235162      DO jn = 1, jptra 
     
    295222      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc 
    296223#endif 
     224# if defined key_medusa 
     225      USE bio_medusa_mod, ONLY:   bio_medusa_alloc 
     226# endif 
     227 
    297228      ! 
    298229      INTEGER :: ierr 
     
    307238      ierr = ierr + trd_mxl_trc_alloc() 
    308239#endif 
     240#if defined key_medusa 
     241      ierr = ierr + bio_medusa_alloc() 
     242#endif 
    309243      ! 
    310244      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r8280 r8657  
    2525   USE trcnam_cfc        ! CFC SMS namelist 
    2626   USE trcnam_c14b       ! C14 SMS namelist 
     27   USE trcnam_age        ! AGE SMS namelist 
    2728   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     29   USE trcnam_idtra      ! Idealise tracer namelist 
    2830   USE trcnam_medusa     ! MEDUSA namelist 
    29    USE trcnam_idtra      ! Idealise tracer namelist 
    30    USE trcnam_age        ! AGE SMS namelist 
    3131   USE trd_oce        
    3232   USE trdtrc_oce 
     
    6565       
    6666      !                                        !  passive tracer informations 
    67 # if defined key_debug_medusa 
    68       CALL flush(numout) 
    69       IF (lwp) write (numout,*) '------------------------------' 
    70       IF (lwp) write (numout,*) 'Jpalm - debug' 
    71       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 
    72       IF (lwp) write (numout,*) ' ' 
    73 # endif 
    74       ! 
    7567      CALL trc_nam_trc 
    7668       
    7769      !                                        !   Parameters of additional diagnostics 
    78 # if defined key_debug_medusa 
    79       CALL flush(numout) 
    80       IF (lwp) write (numout,*) '------------------------------' 
    81       IF (lwp) write (numout,*) 'Jpalm - debug' 
    82       IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 
    83       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 
    84       IF (lwp) write (numout,*) ' ' 
    85 # endif 
    86       ! 
    87  
    8870      CALL trc_nam_dia 
    8971 
    9072      !                                        !   namelist of transport 
    91 # if defined key_debug_medusa 
    92       CALL flush(numout) 
    93       IF (lwp) write (numout,*) '------------------------------' 
    94       IF (lwp) write (numout,*) 'Jpalm - debug' 
    95       IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 
    96       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 
    97       IF (lwp) write (numout,*) ' ' 
    98 # endif 
    99       ! 
    10073      CALL trc_nam_trp 
    101       ! 
    102 # if defined key_debug_medusa 
    103       CALL flush(numout) 
    104       IF (lwp) write (numout,*) '------------------------------' 
    105       IF (lwp) write (numout,*) 'Jpalm - debug' 
    106       IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 
    107       IF (lwp) write (numout,*) 'continue trc_nam ' 
    108       IF (lwp) write (numout,*) ' ' 
    109       CALL flush(numout) 
    110 # endif 
    111       ! 
    11274 
    11375 
     
    13193         END DO 
    13294         WRITE(numout,*) ' ' 
    133 # if defined key_debug_medusa 
    134       CALL flush(numout) 
    135 # endif 
    13695      ENDIF 
    13796 
     
    152111            WRITE(numout,*) 
    153112         ENDIF 
    154 # if defined key_debug_medusa 
    155       CALL flush(numout) 
    156 # endif 
    157113      ENDIF 
    158114 
     
    170126        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    171127        WRITE(numout,*)  
    172 # if defined key_debug_medusa 
    173       CALL flush(numout) 
    174 # endif 
    175128      ENDIF 
    176129 
     
    200153               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    201154            END DO 
    202          WRITE(numout,*) ' ' 
    203          CALL flush(numout) 
    204155         ENDIF 
    205156#endif 
    206157 
    207 # if defined key_debug_medusa 
    208       CALL flush(numout) 
    209       IF (lwp) write (numout,*) '------------------------------' 
    210       IF (lwp) write (numout,*) 'Jpalm - debug' 
    211       IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 
    212       IF (lwp) write (numout,*) ' ' 
    213 # endif 
    214       ! 
    215158 
    216159      ! Call the ice module for tracers 
    217160      ! ------------------------------- 
    218161      CALL trc_nam_ice 
    219  
    220 # if defined key_debug_medusa 
    221       CALL flush(numout) 
    222       IF (lwp) write (numout,*) '------------------------------' 
    223       IF (lwp) write (numout,*) 'Jpalm - debug' 
    224       IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 
    225       IF (lwp) write (numout,*) ' ' 
    226 # endif 
    227       ! 
    228162 
    229163      ! namelist of SMS 
     
    232166      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    233167      ENDIF 
    234       ! 
    235 # if defined key_debug_medusa 
    236       CALL flush(numout) 
    237       IF (lwp) write (numout,*) '------------------------------' 
    238       IF (lwp) write (numout,*) 'Jpalm - debug' 
    239       IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK' 
    240       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
    241       IF (lwp) write (numout,*) ' ' 
    242 # endif 
    243       ! 
     168 
     169      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
     170      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
     171      ENDIF 
     172 
     173      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
     174      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     175      ENDIF 
     176 
     177      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     178      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     179      ENDIF 
     180 
     181      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
     182      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
     183      ENDIF 
     184 
     185      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
     186      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
     187      ENDIF 
     188 
    244189      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers 
    245190      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used' 
    246191      ENDIF 
    247192      ! 
    248 # if defined key_debug_medusa 
    249       CALL flush(numout) 
    250       IF (lwp) write (numout,*) '------------------------------' 
    251       IF (lwp) write (numout,*) 'Jpalm - debug' 
    252       IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 
    253       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 
    254       IF (lwp) write (numout,*) ' ' 
    255 # endif 
    256       ! 
    257       IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
    258       ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
    259       ENDIF 
    260       ! 
    261 # if defined key_debug_medusa 
    262       CALL flush(numout) 
    263       IF (lwp) write (numout,*) '------------------------------' 
    264       IF (lwp) write (numout,*) 'Jpalm - debug' 
    265       IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 
    266       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 
    267       IF (lwp) write (numout,*) ' ' 
    268 # endif 
    269       ! 
    270       IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    271       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    272       ENDIF 
    273       ! 
    274 # if defined key_debug_medusa 
    275       CALL flush(numout) 
    276       IF (lwp) write (numout,*) '------------------------------' 
    277       IF (lwp) write (numout,*) 'Jpalm - debug' 
    278       IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
    279       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 
    280       IF (lwp) write (numout,*) ' ' 
    281 # endif 
    282       ! 
    283       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    284       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    285       ENDIF 
    286       ! 
    287 # if defined key_debug_medusa 
    288       CALL flush(numout) 
    289       IF (lwp) write (numout,*) '------------------------------' 
    290       IF (lwp) write (numout,*) 'Jpalm - debug' 
    291       IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 
    292       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 
    293       IF (lwp) write (numout,*) ' ' 
    294 # endif 
    295       ! 
    296       IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
    297       ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
    298       ENDIF 
    299       ! 
    300 # if defined key_debug_medusa 
    301       CALL flush(numout) 
    302       IF (lwp) write (numout,*) '------------------------------' 
    303       IF (lwp) write (numout,*) 'Jpalm - debug' 
    304       IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 
    305       IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 
    306       IF (lwp) write (numout,*) ' ' 
    307 # endif 
    308       ! 
    309       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    310       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    311       ENDIF 
    312         
    313       IF(lwp)   CALL flush(numout) 
    314193   END SUBROUTINE trc_nam 
    315194 
     
    450329         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    451330      END DO 
    452       IF(lwp)  CALL flush(numout)       
    453  
     331       
    454332    END SUBROUTINE trc_nam_trc 
    455333 
     
    504382         CALL flush(numout) 
    505383      ENDIF 
    506 !! 
    507 !! JPALM -- 17-07-2015 -- 
    508 !! MEDUSA is not yet up-to-date with the iom server. 
    509 !! we use it for the main tracer, but not fully with diagnostics. 
    510 !! will have to adapt it properly when visiting Christian Ethee 
    511 !! for now, we change  
    512 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
    513 !! to : 
    514 !! 
     384 
    515385      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN  
    516386         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
     
    522392         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    523393         ! 
    524       !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 
    525       !!    CALL trc_nam_iom_medusa 
    526394      ENDIF 
    527395 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r8280 r8657  
    745745      !!--------------------------------------------------------------------- 
    746746      INTEGER  :: jk, jn 
     747      CHARACTER (LEN=18) :: text_zmean 
    747748      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
    748749      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     
    750751 
    751752      IF( lwp )  WRITE(numout,*) 'STAT- ', names 
    752       ! 
     753       
     754      ! fse3t_a will be undefined at the start of a run, but this routine 
     755      ! may be called at any stage! Hence we MUST make sure it is  
     756      ! initialised to zero when allocated to enable us to test for  
     757      ! zero content here and avoid potentially dangerous and non-portable  
     758      ! operations (e.g. divide by zero, global sums of junk values etc.)    
    753759      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
    754760      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
     
    761767         CALL mpp_max( zmax )      ! max over the global domain 
    762768      END IF 
    763       zmean  = ztraf / areasf 
    764       IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 
    765       ! 
    766       IF(lwp) WRITE(numout,*) 
    767 9002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     769 
     770      text_zmean = "N/A" 
     771      ! Avoid divide by zero. areasf must be positive. 
     772      IF  (areasf > 0.0) THEN  
     773         zmean = ztraf / areasf 
     774         WRITE(text_zmean,'(e18.10)') zmean 
     775      ENDIF 
     776 
     777      IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax 
     778 
     779  9002  FORMAT(' tracer name :',A,'    mean :',A,'    min :',e18.10, & 
    768780      &      '    max :',e18.10 ) 
    769781      ! 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r8280 r8657  
    1616   USE trc                ! 
    1717   USE trcsms_pisces      ! PISCES biogeo-model 
    18    USE trcsms_medusa      ! MEDUSA tracers 
    19    USE trcsms_idtra       ! Idealize Tracer 
    2018   USE trcsms_cfc         ! CFC 11 & 12 
    2119   USE trcsms_c14b        ! C14b tracer  
    2220   USE trcsms_age         ! AGE tracer  
    2321   USE trcsms_my_trc      ! MY_TRC  tracers 
     22   USE trcsms_idtra       ! Idealize Tracer 
     23   USE trcsms_medusa      ! MEDUSA tracers 
    2424   USE prtctl_trc         ! Print control for debbuging 
    2525 
     
    4646      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4747      !! 
    48       INTEGER            ::  jn 
    4948      CHARACTER (len=25) :: charout 
    5049      !!--------------------------------------------------------------------- 
     
    5352      ! 
    5453      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     54      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     55      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     56      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
     57      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
     58      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
    5559      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
    56 # if defined key_debug_medusa 
    57          IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- ' 
    58       CALL flush(numout) 
    59 # endif 
    60       IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
    61 # if defined key_debug_medusa 
    62          IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- ' 
    63       CALL flush(numout) 
    64 # endif 
    65       IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    66 # if defined key_debug_medusa 
    67          IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  next C14 -- ' 
    68       CALL flush(numout) 
    69 # endif 
    70       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
    71 # if defined key_debug_medusa 
    72          IF(lwp) WRITE(numout,*) '--trcsms : C14 OK --  next C14 -- ' 
    73       CALL flush(numout) 
    74 # endif 
    75       IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
    76 # if defined key_debug_medusa 
    77          IF(lwp) WRITE(numout,*) '--trcsms : Age OK --  Continue  -- ' 
    78       CALL flush(numout) 
    79 # endif 
    80       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    8160 
    8261      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r8356 r8657  
    8989         tra(:,:,:,:) = 0.e0 
    9090         ! 
    91 # if defined key_debug_medusa 
    92          IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
    93          CALL flush(numout) 
    94 # endif 
    9591                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    96 # if defined key_debug_medusa 
    97                                    CALL trc_rst_stat  
    98                                    CALL trc_rst_tra_stat 
    99 # endif 
    10092         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    10193         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
     
    124116         ! 
    125117         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    126 # if defined key_debug_medusa 
    127          IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
    128          CALL flush(numout) 
    129 # endif 
    130118         ! 
    131119      ENDIF 
  • branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r8280 r8657  
    2121   USE trcwri_cfc 
    2222   USE trcwri_c14b 
     23   USE trcwri_age 
    2324   USE trcwri_my_trc 
     25   USE trcwri_idtra 
    2426   USE trcwri_medusa 
    25    USE trcwri_idtra 
    26    USE trcwri_age 
    2727 
    2828   IMPLICIT NONE 
     
    6161      ! --------------------------------------- 
    6262      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
    63       IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
    64       IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
    6563      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6664      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
    6765      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6866      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     67      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
     68      IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
    6969      ! 
    7070      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.