diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8938e2c3..fe5e00b7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -71,6 +71,7 @@ jobs: matrix: mpi: [true, false] openmp: ['enabled', 'disabled'] + ecosys: [true, false] # Tell Meson to use Intel compilers env: CC: icc diff --git a/cesm/mod_cesm.F90 b/cesm/mod_cesm.F90 index cc371c18..01969506 100644 --- a/cesm/mod_cesm.F90 +++ b/cesm/mod_cesm.F90 @@ -29,10 +29,14 @@ module mod_cesm use mod_xc use mod_forcing, only: trxday, srxday, swa, nsf, lip, sop, eva, rnf, rfi, & fmltfz, sfl, ztx, mty, ustarw, slp, abswnd, & - lamult, lasl, ustokes, vstokes, atmco2, atmbrf + lamult, lasl, ustokes, vstokes, atmco2, atmbrf, & + flxdms, flxbrf use mod_ben02, only: initai, rdcsic, rdctsf, fnlzai use mod_seaice, only: ficem use mod_checksum, only: csdiag, chksummsk +#ifdef HAMOCC + use mo_control_bgc, only: use_bromo +#endif implicit none @@ -76,7 +80,9 @@ module mod_cesm ustokes_da, & ! u-component of surface Stokes drift [m s-1]. vstokes_da, & ! v-component of surface Stokes drift [m s-1]. atmco2_da, & ! Atmospheric CO2 concentration [ppm]. - atmbrf_da ! Atmospheric bromoform concentration [ppt]. + atmbrf_da, & ! Atmospheric bromoform concentration [ppt]. + flxdms_da, & ! dms surface flux computed by mediator [kg m-2 s-1] + flxbrf_da ! brf surface flux computed by mediator [kg m-2 s-1] logical :: & smtfrc ! If true, time smooth CESM forcing fields. @@ -87,10 +93,9 @@ module mod_cesm public :: runid_cesm, runtyp_cesm, ocn_cpl_dt_cesm, nstep_in_cpl, hmlt, & frzpot, mltpot, swa_da, nsf_da, hmlt_da, lip_da, sop_da, eva_da, & rnf_da, rfi_da, fmltfz_da, sfl_da, ztx_da, mty_da, ustarw_da, & - slp_da, abswnd_da, ficem_da, lamult_da, lasl_da, & + slp_da, abswnd_da, ficem_da, lamult_da, lasl_da, flxdms_da, flxbrf_da, & ustokes_da, vstokes_da, atmco2_da, atmbrf_da, smtfrc, l1ci, l2ci, & inicon_cesm, inifrc_cesm, getfrc_cesm - contains subroutine inicon_cesm @@ -208,7 +213,7 @@ subroutine getfrc_cesm call ncfopn('getfrc_cesm.nc', 'w', 'c', 1, iotype) call ncdims('x', itdm) call ncdims('y', jtdm) - call ncdefvar('ustarw_da', 'x y', ndouble, 8) + call ncdefvar('ustarw_da', 'x y', ndouble, 8) call ncdefvar('lip_da', 'x y', ndouble, 8) call ncdefvar('sop_da', 'x y', ndouble, 8) call ncdefvar('eva_da', 'x y', ndouble, 8) diff --git a/cime_config/ocn_in.readme b/cime_config/ocn_in.readme index 05f933e6..d288c614 100644 --- a/cime_config/ocn_in.readme +++ b/cime_config/ocn_in.readme @@ -75,8 +75,8 @@ ! SRXBAL : Balance the SSS relaxation (l) ! SCFILE : Name of file containing SSS climatology used for relaxation (a) ! WAVSRC : Source of wave fields. Valid source: 'none', 'param', 'extern' (a) -! SMTFRC : Smooth CESM forcing (l) -! SPRFAC : Send precipitation/runoff factor to CESM coupler (l) +! SMTFRC : Smooth NorESM forcing (l) +! SPRFAC : Send precipitation/runoff factor to NorESM coupler (l) ! ATM_PATH : Path to forcing fields in case of EXPCNF 'ben02clim' or ! 'ben02syn' (a) ! ITEST : Global i-index of point diagnostics (i) diff --git a/drivers/nuopc/mod_nuopc_methods.F90 b/drivers/nuopc/mod_nuopc_methods.F90 index 53b52d1e..bcf1a183 100644 --- a/drivers/nuopc/mod_nuopc_methods.F90 +++ b/drivers/nuopc/mod_nuopc_methods.F90 @@ -23,29 +23,30 @@ module mod_nuopc_methods ! NUOPC cap. ! ------------------------------------------------------------------------------ - use mod_types, only: r8 - use mod_constants, only: rearth, onem - use mod_time, only: nstep, baclin, delt1, dlt + use mod_types, only: r8 + use mod_constants, only: rearth, onem + use mod_time, only: nstep, baclin, delt1, dlt use mod_xc - use mod_grid, only: scuy, scvx, scp2, scuxi, scvyi, plon, plat, & - cosang, sinang - use mod_state, only: u, v, dp, temp, saln, pbu, pbv, ubflxs, vbflxs, sealv - use mod_forcing, only: wavsrc_opt, wavsrc_extern, sprfac, prfac, flxco2, & - flxdms, flxbrf - use mod_difest, only: obldepth - use mod_vcoord, only: vcoord_type_tag, isopyc_bulkml, cntiso_hybrid - use mod_cesm, only: frzpot, mltpot, & - swa_da, nsf_da, hmlt_da, lip_da, sop_da, eva_da, & - rnf_da, rfi_da, fmltfz_da, sfl_da, ztx_da, mty_da, & - ustarw_da, slp_da, abswnd_da, ficem_da, lamult_da, & - lasl_da, ustokes_da, vstokes_da, atmco2_da, atmbrf_da, & - l1ci, l2ci - use mod_utility, only: util1, util2 - use mod_checksum, only: csdiag, chksummsk - use shr_const_mod, only: SHR_CONST_RHOSW, SHR_CONST_LATICE, SHR_CONST_TKFRZ + use mod_grid, only: scuy, scvx, scp2, scuxi, scvyi, plon, plat, cosang, sinang + use mod_state, only: u, v, dp, temp, saln, pbu, pbv, ubflxs, vbflxs, sealv + use mod_forcing, only: wavsrc_opt, wavsrc_extern, sprfac, prfac, flxco2,flxdms, flxbrf + use mod_difest, only: obldepth + use mod_vcoord, only: vcoord_type_tag, isopyc_bulkml, cntiso_hybrid + use mod_cesm, only: frzpot, mltpot, & + swa_da, nsf_da, hmlt_da, lip_da, sop_da, eva_da, & + rnf_da, rfi_da, fmltfz_da, sfl_da, ztx_da, mty_da, & + ustarw_da, slp_da, abswnd_da, ficem_da, lamult_da, & + lasl_da, ustokes_da, vstokes_da, atmco2_da, atmbrf_da, & + flxdms_da, flxbrf_da, l1ci, l2ci + use mod_utility, only: util1, util2 + use mod_checksum, only: csdiag, chksummsk + use shr_const_mod, only: SHR_CONST_RHOSW, SHR_CONST_LATICE, SHR_CONST_TKFRZ +#ifdef HAMOCC + use mo_carbch, only: ocetra + use mo_control_bgc, only: use_BROMO, use_DIAGCO2, use_PROGCO2 +#endif implicit none - private ! Parameters. @@ -57,6 +58,7 @@ module mod_nuopc_methods integer :: ungridded_ubound = 0 real(r8), dimension(:), pointer :: dataptr end type fldlist_type + integer, parameter :: fldsMax = 100 real(r8), dimension(:), allocatable :: mod2med_areacor, med2mod_areacor real(r8), dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: & @@ -64,57 +66,202 @@ module mod_nuopc_methods acc_fco2, acc_fdms, acc_fbrf real(r8) :: tlast_coupled integer :: jjcpl - logical :: fco2_requested, fdms_requested, fbrf_requested - public :: fldlist_type, tlast_coupled, & - fco2_requested, fdms_requested, fbrf_requested, & + public :: fldlist_type, fldsmax, tlast_coupled, & blom_logwrite, blom_getgindex, blom_checkmesh, blom_setareacor, & blom_getglobdim, blom_getprecipfact, blom_accflds, & + blom_advertise_imports, blom_advertise_exports, & blom_importflds, blom_exportflds + ! Indices for import fields + integer :: & + index_Si_ifrac = -1, & + index_So_duu10n = -1, & + index_Fioi_melth = -1, & + index_Fioi_meltw = -1, & + index_Fioi_salt = -1, & + index_Fioi_bcpho = -1, & + index_Fioi_bcphi = -1, & + index_Fioi_flxdst = -1, & + index_Foxx_rofl = -1, & + index_Foxx_rofi = -1, & + index_Foxx_tauy = -1, & + index_Foxx_taux = -1, & + index_Foxx_lat = -1, & + index_Foxx_sen = -1, & + index_Foxx_lwup = -1, & + index_Foxx_evap = -1, & + index_Foxx_swnet = -1, & + index_Sw_lamult = -1, & + index_Sw_ustokes = -1, & + index_Sw_vstokes = -1, & + index_Sw_hstokes = -1, & + index_Faxa_lwdn = -1, & + index_Faxa_snow = -1, & + index_Faxa_rain = -1, & + index_Sa_pslv = -1, & + index_Sa_co2diag = -1, & + index_Sa_co2prog = -1 + + ! Indices for export fields + integer :: & + index_So_omask = -1, & + index_So_u = -1, & + index_So_v = -1, & + index_So_dhdx = -1, & + index_So_dhdy = -1, & + index_So_t = -1, & + index_So_s = -1, & + index_So_bldepth = -1, & + index_Fioo_q = -1, & + index_Faoo_dms = -1, & + index_Faoo_brf = -1, & + index_Faoo_fco2_ocn = -1 + contains ! --------------------------------------------------------------------------- ! Private procedures. ! --------------------------------------------------------------------------- - subroutine getfldindex(fldlist_num, fldlist, stdname, fldindex) + subroutine fldlist_add(num, fldlist, stdname, index, ungridded_lbound, ungridded_ubound) ! --------------------------------------------------------------------------- - ! Get index of field with given standard name. If no field has a matching - ! name or a field with matching name has an unassociated data pointer, set - ! index to zero. + ! Add to list of field information. ! --------------------------------------------------------------------------- ! Input/output arguments. - integer, intent(in) :: fldlist_num - type(fldlist_type), dimension(:), intent(in) :: fldlist - character(len=*), intent(in) :: stdname - integer, intent(inout) :: fldindex + integer , intent(inout) :: num + type(fldlist_type), intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: stdname + integer , intent(out) :: index + integer, optional , intent(in) :: ungridded_lbound, ungridded_ubound - ! Local variables. - integer :: n + ! Local parameters. + character(len=*), parameter :: & + subname = modname//':(fldlist_add)' - if (fldindex >= 0) return + ! Local variables. + integer :: rc + + num = num + 1 + if (num > fldsMax) then + write(lp,'(a,3i6,2(f21.13,3x),d21.5)') subname// & + ': BLOM ERROR: number of fields exceeds fldsMax for '//trim(stdname) + call xchalt(subname) + stop subname + endif + fldlist(num)%stdname = trim(stdname) - fldindex = 0 + index = num - do n = 1, fldlist_num - if (fldlist(n)%stdname == stdname) then - if (associated(fldlist(n)%dataptr)) fldindex = n - return - endif - enddo + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + endif - end subroutine getfldindex + end subroutine fldlist_add ! --------------------------------------------------------------------------- ! Public procedures. ! --------------------------------------------------------------------------- + subroutine blom_advertise_imports(flds_scalar_name, fldsToOcn_num, fldsToOcn, & + flds_co2a, flds_co2c) + + ! ------------------------------------------------------------------- + ! Determine fldsToOcn for import fields + ! ------------------------------------------------------------------- + + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(inout) :: fldsToOcn_num + type(fldlist_type) , intent(inout), dimension(:) :: fldsToOcn + logical , intent(in) :: flds_co2a + logical , intent(in) :: flds_co2c + + integer :: index_scalar + + call fldlist_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), index_scalar) + + ! From ice: + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Si_ifrac' , index_Si_ifrac ) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_melth' , index_Fioi_melth) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_meltw' , index_Fioi_meltw) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_salt' , index_Fioi_salt) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_bcpho' , index_Fioi_bcpho) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_bcphi' , index_Fioi_bcphi) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_flxdst', index_Fioi_flxdst) + + ! From river: + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_rofl', index_Foxx_rofl) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_rofi', index_Foxx_rofi) + + ! From fields computed mediator: + call fldlist_add(fldsToOcn_num, fldsToOcn, 'So_duu10n' , index_So_duu10n) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_tauy' , index_Foxx_tauy) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_taux' , index_Foxx_taux) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_lat' , index_Foxx_lat) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_sen' , index_Foxx_sen) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_lwup' , index_Foxx_lwup) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_evap' , index_Foxx_evap) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_swnet' , index_Foxx_swnet) + + ! From wave: + if (wavsrc_opt == wavsrc_extern) then + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_lamult' , index_Sw_lamult) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_ustokes' , index_Sw_ustokes) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_vstokes' , index_Sw_vstokes) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_hstokes' , index_Sw_hstokes) + end if + + ! From atmosphere: + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_pslv' , index_Sa_pslv ) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_lwdn' , index_Faxa_lwdn) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_snow' , index_Faxa_snow) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_rain' , index_Faxa_rain) + + ! From atm co2 fields: + if (flds_co2a .or. flds_co2c) then + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_co2diag' ,index_Sa_co2diag) + call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_co2prog', index_Sa_co2prog) + endif + + end subroutine blom_advertise_imports + + subroutine blom_advertise_exports(flds_scalar_name, fldsFrOcn_num, fldsFrOcn) + ! ------------------------------------------------------------------- + ! Determine fldsToOcn for export fields + ! ------------------------------------------------------------------- + + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(inout) :: fldsFrOcn_num + type(fldlist_type), dimension(:) , intent(inout) :: fldsFrOcn + + integer :: index_scalar + + call fldlist_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), index_scalar) + + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_omask' , index_So_omask) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_t' , index_So_t) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_u' , index_So_u) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_v' , index_So_v) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_s' , index_So_s) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_dhdx' , index_So_dhdx) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_dhdy' , index_So_dhdy) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_bldepth' , index_So_bldepth) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'Fioo_q' , index_Fioo_q) + call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'Faoo_fco2_ocn' , index_Faoo_fco2_ocn) +#ifdef HAMOCC + ! call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faoo_dms', index_Faoo_dms) + ! if (use_BROMO) then + ! call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faoo_brf', index_Faoo_brf) + ! end if +#endif + end subroutine blom_advertise_exports + subroutine blom_logwrite(msg) - ! --------------------------------------------------------------------------- - ! Write message string to standard out from master PE. - ! --------------------------------------------------------------------------- + ! --------------------------------------------------------------------------- + ! Write message string to standard out from master PE. + ! --------------------------------------------------------------------------- ! Input/output arguments. character(len=*), intent(in) :: msg @@ -315,6 +462,7 @@ subroutine blom_accflds ! Local variables. real(r8) :: q integer m, n, mm, nn, k1m, k1n, i, j, l + logical :: first_call = .true. ! ------------------------------------------------------------------------ ! Set accumulation arrays to zero if this is the first call after a @@ -347,8 +495,8 @@ subroutine blom_accflds k1n = 1 + nn call xctilr(sealv, 1,1, 1,1, halo_ps) - - !$omp parallel do private(l, i) + + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isu(j) do i = max(1, ifu(j,l)), min(ii, ilu(j,l)) @@ -378,12 +526,12 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do + !$omp end parallel do select case (vcoord_type_tag) case (isopyc_bulkml) q = baclin/onem - !$omp parallel do private(l, i) + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -391,9 +539,9 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do + !$omp end parallel do case (cntiso_hybrid) - !$omp parallel do private(l, i) + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -401,16 +549,17 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do + !$omp end parallel do case default - if (mnproc == 1) & + if (mnproc == 1.and. first_call) then write(lp,*) subname//': unsupported vertical coordinate!' + end if call xcstop(subname) - stop subname + stop subname end select - if (fco2_requested) then - !$omp parallel do private(l, i) + if (index_Faoo_fco2_ocn > 0) then + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -418,11 +567,11 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do + !$omp end parallel do endif - if (fdms_requested) then - !$omp parallel do private(l, i) + if (index_Faoo_dms > 0) then + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -430,11 +579,11 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do - endif + !$omp end parallel do + end if - if (fbrf_requested) then - !$omp parallel do private(l, i) + if (index_Faoo_brf > 0) then + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -442,8 +591,8 @@ subroutine blom_accflds enddo enddo enddo - !$omp end parallel do - endif + !$omp end parallel do + end if ! ------------------------------------------------------------------------ ! Increment time since last coupling. @@ -451,6 +600,10 @@ subroutine blom_accflds tlast_coupled = tlast_coupled + baclin + if (first_call) then + first_call = .false. + end if + end subroutine blom_accflds subroutine blom_importflds(fldlist_num, fldlist) @@ -468,39 +621,12 @@ subroutine blom_importflds(fldlist_num, fldlist) real(r8), parameter :: & mval = - 1.e12_r8, & fval = - 1.e13_r8 + logical :: first_call = .true. ! Local variables. real(r8) :: afac, utmp, vtmp integer :: n, i, j, l - integer, save :: & - index_Si_ifrac = - 1, & - index_Fioi_melth = - 1, & - index_Fioi_meltw = - 1, & - index_Fioi_salt = - 1, & - index_Fioi_bcpho = - 1, & - index_Fioi_bcphi = - 1, & - index_Fioi_flxdst = - 1, & - index_Foxx_rofl = - 1, & - index_Foxx_rofi = - 1, & - index_So_duu10n = - 1, & - index_Foxx_tauy = - 1, & - index_Foxx_taux = - 1, & - index_Foxx_lat = - 1, & - index_Foxx_sen = - 1, & - index_Foxx_lwup = - 1, & - index_Foxx_evap = - 1, & - index_Foxx_swnet = - 1, & - index_Sw_lamult = - 1, & - index_Sw_ustokes = - 1, & - index_Sw_vstokes = - 1, & - index_Sw_hstokes = - 1, & - index_Faxa_lwdn = - 1, & - index_Faxa_snow = - 1, & - index_Faxa_rain = - 1, & - index_Sa_pslv = - 1, & - index_Sa_co2diag = - 1, & - index_Sa_co2prog = - 1, & - index_Sa_brfprog = - 1 + integer :: index_co2 ! Update time level indices. if (l1ci == 1 .and. l2ci == 1) then @@ -511,10 +637,7 @@ subroutine blom_importflds(fldlist_num, fldlist) l2ci = 3 - l2ci endif - call getfldindex(fldlist_num, fldlist, 'Foxx_taux', index_Foxx_taux) - call getfldindex(fldlist_num, fldlist, 'Foxx_tauy', index_Foxx_tauy) - - !$omp parallel do private(i, n, afac, utmp, vtmp) + !$omp parallel do private(i, n, afac, utmp, vtmp) do j = 1, jjcpl do i = 1, ii if (ip(i,j) == 0) then @@ -540,7 +663,7 @@ subroutine blom_importflds(fldlist_num, fldlist) endif enddo enddo - !$omp end parallel do + !$omp end parallel do call fill_global(mval, fval, halo_pv, util1) call fill_global(mval, fval, halo_pv, util2) @@ -549,7 +672,7 @@ subroutine blom_importflds(fldlist_num, fldlist) call xctilr(util1, 1,1, 1,1, halo_pv) call xctilr(util2, 1,1, 1,1, halo_pv) - !$omp parallel do private(l, i) + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isu(j) do i = max(1,ifu(j,l)), min(ii,ilu(j,l)) @@ -564,30 +687,13 @@ subroutine blom_importflds(fldlist_num, fldlist) enddo enddo enddo - !$omp end parallel do + !$omp end parallel do - call getfldindex(fldlist_num, fldlist, 'Faxa_rain', index_Faxa_rain) - call getfldindex(fldlist_num, fldlist, 'Faxa_snow', index_Faxa_snow) - call getfldindex(fldlist_num, fldlist, 'Foxx_evap', index_Foxx_evap) - call getfldindex(fldlist_num, fldlist, 'Foxx_rofl', index_Foxx_rofl) - call getfldindex(fldlist_num, fldlist, 'Foxx_rofi', index_Foxx_rofi) - call getfldindex(fldlist_num, fldlist, 'Fioi_meltw', index_Fioi_meltw) - call getfldindex(fldlist_num, fldlist, 'Fioi_salt', index_Fioi_salt) - call getfldindex(fldlist_num, fldlist, 'Foxx_swnet', index_Foxx_swnet) - call getfldindex(fldlist_num, fldlist, 'Foxx_lat', index_Foxx_lat) - call getfldindex(fldlist_num, fldlist, 'Foxx_sen', index_Foxx_sen) - call getfldindex(fldlist_num, fldlist, 'Foxx_lwup', index_Foxx_lwup) - call getfldindex(fldlist_num, fldlist, 'Faxa_lwdn', index_Faxa_lwdn) - call getfldindex(fldlist_num, fldlist, 'Fioi_melth', index_Fioi_melth) - call getfldindex(fldlist_num, fldlist, 'Sa_pslv', index_Sa_pslv) - call getfldindex(fldlist_num, fldlist, 'So_duu10n', index_So_duu10n) - call getfldindex(fldlist_num, fldlist, 'Si_ifrac', index_Si_ifrac) - - !$omp parallel do private(i, n, afac) + !$omp parallel do private(i, n, afac) do j = 1, jjcpl do i = 1, ii - if (ip(i,j) == 0) then + if (ip(i,j) == 0) then lip_da(i,j,l2ci) = mval sop_da(i,j,l2ci) = mval eva_da(i,j,l2ci) = mval @@ -669,7 +775,7 @@ subroutine blom_importflds(fldlist_num, fldlist) enddo enddo - !$omp end parallel do + !$omp end parallel do if (nreg == 2) then call xctilr(lip_da(1-nbdy,1-nbdy,l2ci), 1,1, 0,0, halo_ps) @@ -689,12 +795,6 @@ subroutine blom_importflds(fldlist_num, fldlist) call fill_global(mval, fval, halo_ps, ficem_da(1-nbdy,1-nbdy,l2ci)) if (wavsrc_opt == wavsrc_extern) then - - call getfldindex(fldlist_num, fldlist, 'Sw_lamult', index_Sw_lamult) - call getfldindex(fldlist_num, fldlist, 'Sw_ustokes', index_Sw_ustokes) - call getfldindex(fldlist_num, fldlist, 'Sw_vstokes', index_Sw_vstokes) - call getfldindex(fldlist_num, fldlist, 'Sw_hstokes', index_Sw_hstokes) - !$omp parallel do private(i, n, utmp, vtmp) do j = 1, jjcpl do i = 1, ii @@ -725,7 +825,7 @@ subroutine blom_importflds(fldlist_num, fldlist) endif enddo enddo - !$omp end parallel do + !$omp end parallel do call fill_global(mval, fval, halo_pv, util1) call fill_global(mval, fval, halo_pv, util2) @@ -735,30 +835,37 @@ subroutine blom_importflds(fldlist_num, fldlist) call xctilr(util1, 1,1, 1,1, halo_pv) call xctilr(util2, 1,1, 1,1, halo_pv) - !$omp parallel do private(l, i) + !$omp parallel do private(l, i) do j = 1, jj do l = 1, isu(j) - do i = max(1,ifu(j,l)), min(ii,ilu(j,l)) - ! x-component of surface Stokes drift [m s-1]. - ustokes_da(i,j,l2ci) = .5_r8*(util1(i-1,j) + util1(i,j)) - enddo + do i = max(1,ifu(j,l)), min(ii,ilu(j,l)) + ! x-component of surface Stokes drift [m s-1]. + ustokes_da(i,j,l2ci) = .5_r8*(util1(i-1,j) + util1(i,j)) + enddo enddo do l = 1,isv(j) - do i = max(1,ifv(j,l)), min(ii,ilv(j,l)) - ! y-component of surface Stokes drift [m s-1]. - vstokes_da(i,j,l2ci) = .5_r8*(util2(i,j-1) + util2(i,j)) - enddo + do i = max(1,ifv(j,l)), min(ii,ilv(j,l)) + ! y-component of surface Stokes drift [m s-1]. + vstokes_da(i,j,l2ci) = .5_r8*(util2(i,j-1) + util2(i,j)) + enddo enddo enddo - !$omp end parallel do + !$omp end parallel do - endif + end if -#ifdef PROGCO2 - call getfldindex(fldlist_num, fldlist, 'Sa_co2prog', index_Sa_co2prog) + ! CO2 flux - if (index_Sa_co2prog > 0) then - !$omp parallel do private(i, n) + index_co2 = -1 +#ifdef HAMOCC + if (use_DIAGCO2 .and. index_Sa_co2diag > 0) then + index_co2 = index_Sa_co2diag + else if (use_PROGCO2 .and. index_Sa_co2prog > 0) then + index_co2 = index_Sa_co2prog + end if +#endif + if (index_co2 > 0) then + !$omp parallel do private(i, n) do j = 1, jjcpl do i = 1, ii if (ip(i,j) == 0) then @@ -768,54 +875,17 @@ subroutine blom_importflds(fldlist_num, fldlist) else n = (j - 1)*ii + i ! Atmospheric co2 concentration [ppmv?] - atmco2_da(i,j,l2ci) = fldlist(index_Sa_co2prog)%dataptr(n) + atmco2_da(i,j,l2ci) = fldlist(index_co2)%dataptr(n) endif enddo enddo - !$omp end parallel do - call fill_global(mval, fval, halo_ps, atmco2_da(1-nbdy,1-nbdy,l2ci)) - if (mnproc == 1) & - write(lp,*) subname//': prog. atmospheric co2 read' - else - !$omp parallel do private(i) - do j = 1, jj - do i = 1, ii - if (ip(i,j) == 0) then - atmco2_da(i,j,l2ci) = mval - else - atmco2_da(i,j,l2ci) = -1 - endif - enddo - enddo - !$omp end parallel do - if (mnproc == 1) & - write(lp,*) subname//': prog. atmospheric co2 not read' - endif - -#elif defined(DIAGCO2) - call getfldindex(fldlist_num, fldlist, 'Sa_co2diag', index_Sa_co2diag) - - if (index_Sa_co2diag > 0) then - !$omp parallel do private(i, n) - do j = 1, jjcpl - do i = 1, ii - if (ip(i,j) == 0) then - atmco2_da(i,j,l2ci) = mval - elseif (cplmsk(i,j) == 0) then - atmco2_da(i,j,l2ci) = fval - else - n = (j - 1)*ii + i - ! Atmospheric co2 concentration [ppmv?] - atmco2_da(i,j,l2ci) = fldlist(index_Sa_co2diag)%dataptr(n) - endif - enddo - enddo - !$omp end parallel do + !$omp end parallel do call fill_global(mval, fval, halo_ps, atmco2_da(1-nbdy,1-nbdy,l2ci)) - if (mnproc == 1) & - write(lp,*) subname//': diag. atmospheric co2 read' + if (mnproc == 1 .and. first_call) then + write(lp,*) subname//': atmospheric co2 obtained from mediator' + end if else - !$omp parallel do private(i) + !$omp parallel do private(i) do j = 1, jj do i = 1, ii if (ip(i,j) == 0) then @@ -825,65 +895,14 @@ subroutine blom_importflds(fldlist_num, fldlist) endif enddo enddo - !$omp end parallel do - if (mnproc == 1) & - write(lp,*) subname//': diag. atmospheric co2 not read' - endif -#else - !$omp parallel do private(i) - do j = 1, jj - do i = 1, ii - if (ip(i,j) == 0) then - atmco2_da(i,j,l2ci) = mval - else - atmco2_da(i,j,l2ci) = -1 - endif - enddo - enddo - !$omp end parallel do - if (mnproc == 1) & - write(lp,*) subname//': atmospheric co2 not read' -#endif - - call getfldindex(fldlist_num, fldlist, 'Sa_brfprog', index_Sa_brfprog) - - if (index_Sa_brfprog > 0) then - !$omp parallel do private(i, n) - do j = 1, jjcpl - do i = 1, ii - if (ip(i,j) == 0) then - atmbrf_da(i,j,l2ci) = mval - elseif (cplmsk(i,j) == 0) then - atmbrf_da(i,j,l2ci) = fval - else - n = (j - 1)*ii + i - ! Atmospheric bromoform concentration [ppt] - atmbrf_da(i,j,l2ci) = fldlist(index_Sa_brfprog)%dataptr(n) - endif - enddo - enddo - !$omp end parallel do - call fill_global(mval, fval, halo_ps, atmbrf_da(1-nbdy,1-nbdy,l2ci)) - if (mnproc == 1) & - write(lp,*) subname//': prog. atmospheric bromoform read' - else - !$omp parallel do private(i) - do j = 1, jj - do i = 1, ii - if (ip(i,j) == 0) then - atmbrf_da(i,j,l2ci) = mval - else - atmbrf_da(i,j,l2ci) = -1 - endif - enddo - enddo - !$omp end parallel do - if (mnproc == 1) & - write(lp,*) subname//': prog. atmospheric bromoform not read' - endif + !$omp end parallel do + if (mnproc == 1 .and. first_call) then + write(lp,*) subname//': atmospheric co2 not obtained from mediator' + endif + end if if (csdiag) then - if (mnproc == 1) then + if (mnproc == 1 .and. first_call) then write(lp,*) subname//':' endif call chksummsk(ustarw_da(1-nbdy,1-nbdy,l2ci),ip,1,'ustarw') @@ -903,9 +922,12 @@ subroutine blom_importflds(fldlist_num, fldlist) call chksummsk(abswnd_da(1-nbdy,1-nbdy,l2ci),ip,1,'abswnd') call chksummsk(ficem_da(1-nbdy,1-nbdy,l2ci),ip,1,'ficem') call chksummsk(atmco2_da(1-nbdy,1-nbdy,l2ci),ip,1,'atmco2') - call chksummsk(atmbrf_da(1-nbdy,1-nbdy,l2ci),ip,1,'atmbrf') endif + if (first_call) then + first_call = .false. + end if + end subroutine blom_importflds subroutine blom_exportflds(fldlist_num, fldlist) @@ -923,20 +945,8 @@ subroutine blom_exportflds(fldlist_num, fldlist) ! Local variables. real(r8) :: tfac, utmp, vtmp - integer :: n, l, i, j - integer, save :: & - index_So_omask = - 1, & - index_So_u = - 1, & - index_So_v = - 1, & - index_So_dhdx = - 1, & - index_So_dhdy = - 1, & - index_So_t = - 1, & - index_So_s = - 1, & - index_So_bldepth = - 1, & - index_Fioo_q = - 1, & - index_Faoo_fdms_ocn = - 1, & - index_Faoo_fco2_ocn = - 1, & - index_Faoo_fbrf_ocn = - 1 + integer :: n, l, i, j + logical, save :: first_call = .true. tfac = 1._r8/tlast_coupled @@ -949,16 +959,6 @@ subroutine blom_exportflds(fldlist_num, fldlist) call xctilr(acc_dhdx, 1,1, 1,1, halo_uv) call xctilr(acc_dhdy, 1,1, 1,1, halo_vv) - call getfldindex(fldlist_num, fldlist, 'So_omask', index_So_omask) - call getfldindex(fldlist_num, fldlist, 'So_u', index_So_u) - call getfldindex(fldlist_num, fldlist, 'So_v', index_So_v) - call getfldindex(fldlist_num, fldlist, 'So_dhdx', index_So_dhdx) - call getfldindex(fldlist_num, fldlist, 'So_dhdy', index_So_dhdy) - call getfldindex(fldlist_num, fldlist, 'So_t', index_So_t) - call getfldindex(fldlist_num, fldlist, 'So_s', index_So_s) - call getfldindex(fldlist_num, fldlist, 'So_bldepth', index_So_bldepth) - call getfldindex(fldlist_num, fldlist, 'Fioo_q', index_Fioo_q) - fldlist(index_So_omask)%dataptr(:) = 0._r8 fldlist(index_So_u)%dataptr(:) = 0._r8 fldlist(index_So_v)%dataptr(:) = 0._r8 @@ -969,7 +969,7 @@ subroutine blom_exportflds(fldlist_num, fldlist) fldlist(index_So_bldepth)%dataptr(:) = 0._r8 fldlist(index_Fioo_q)%dataptr(:) = 0._r8 - !$omp parallel do private(l, i, n, utmp, vtmp) + !$omp parallel do private(l, i, n, utmp, vtmp) do j = 1, jjcpl do l = 1, isp(j) do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) @@ -978,8 +978,7 @@ subroutine blom_exportflds(fldlist_num, fldlist) ! Ocean mask []. fldlist(index_So_omask)%dataptr(n) = 1._r8 - ! Surface velocity, interpolated onto scalar points and rotated - ! [m s-1]. + ! Surface velocity, interpolated onto scalar points and rotated [m s-1]. utmp = .5_r8*(acc_u(i,j) + acc_u(i+1,j))*tfac*1.e-2_r8 vtmp = .5_r8*(acc_v(i,j) + acc_v(i,j+1))*tfac*1.e-2_r8 fldlist(index_So_u)%dataptr(n) = utmp*cosang(i,j) & @@ -998,8 +997,7 @@ subroutine blom_exportflds(fldlist_num, fldlist) + vtmp*cosang(i,j) ! Surface temperature [K]. - fldlist(index_So_t)%dataptr(n) = acc_t(i,j)*tfac & - + SHR_CONST_TKFRZ + fldlist(index_So_t)%dataptr(n) = acc_t(i,j)*tfac + SHR_CONST_TKFRZ ! Surface salinity [g kg-1]. fldlist(index_So_s)%dataptr(n) = acc_s(i,j)*tfac @@ -1009,92 +1007,84 @@ subroutine blom_exportflds(fldlist_num, fldlist) ! Freezing/melting potential [W m-2]. if (acc_frzpot(i,j) > 0._r8) then - fldlist(index_Fioo_q)%dataptr(n) = & - acc_frzpot(i,j)*tfac*mod2med_areacor(n) + fldlist(index_Fioo_q)%dataptr(n) = acc_frzpot(i,j)*tfac*mod2med_areacor(n) else - fldlist(index_Fioo_q)%dataptr(n) = & - mltpot(i,j)*tfac*mod2med_areacor(n) + fldlist(index_Fioo_q)%dataptr(n) = mltpot(i,j)*tfac*mod2med_areacor(n) endif enddo enddo enddo - !$omp end parallel do - - ! ------------------------------------------------------------------------ - ! Provide DMS flux [kmol DMS m-2 s-1], if requested. - ! ------------------------------------------------------------------------ - - call getfldindex(fldlist_num, fldlist, 'Faoo_fdms_ocn', & - index_Faoo_fdms_ocn) + !$omp end parallel do - if (fbrf_requested .and. index_Faoo_fdms_ocn > 0) then - fldlist(index_Faoo_fdms_ocn)%dataptr(:) = 0._r8 - !$omp parallel do private(l, i, n) - do j = 1, jjcpl - do l = 1, isp(j) - do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) - n = (j - 1)*ii + i - fldlist(index_Faoo_fdms_ocn)%dataptr(n) = & - acc_fbrf(i,j)*tfac*mod2med_areacor(n) - enddo + if (index_Faoo_fco2_ocn > 0) then + ! CO2 flux [kg CO2 m-2 s-1] + if (associated(fldlist(index_Faoo_fco2_ocn)%dataptr)) then + fldlist(index_Faoo_fco2_ocn)%dataptr(:) = 0._r8 + !$omp parallel do private(l, i, n) + do j = 1, jjcpl + do l = 1, isp(j) + do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) + n = (j - 1)*ii + i + fldlist(index_Faoo_fco2_ocn)%dataptr(n) = acc_fco2(i,j)*tfac*mod2med_areacor(n) + enddo + enddo enddo - enddo - !$omp end parallel do + !$omp end parallel do + end if else - if (mnproc == 1) & - write(lp,*) subname//': dms flux not sent to coupler' - endif - - ! ------------------------------------------------------------------------ - ! Provide CO2 flux [kg CO2 m-2 s-1], if requested. - ! ------------------------------------------------------------------------ - - call getfldindex(fldlist_num, fldlist, 'Faoo_fco2_ocn', & - index_Faoo_fco2_ocn) - - if (fco2_requested .and. index_Faoo_fco2_ocn > 0) then - fldlist(index_Faoo_fco2_ocn)%dataptr(:) = 0._r8 - !$omp parallel do private(l, i, n) + if (first_call) then + if (mnproc == 1 .and. first_call) then + write(lp,*) subname//': co2 flux not sent to coupler' + end if + end if + end if + + if (index_Faoo_dms > 0) then + ! dms flux (kmol DMS/m^2/s) + fldlist(index_Faoo_dms)%dataptr(:) = 0._r8 + !$omp parallel do private(l, i, n) do j = 1, jjcpl do l = 1, isp(j) - do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) - n = (j - 1)*ii + i - fldlist(index_Faoo_fco2_ocn)%dataptr(n) = & - acc_fco2(i,j)*tfac*mod2med_areacor(n) - enddo + do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) + n = (j - 1)*ii + i + fldlist(index_Faoo_dms)%dataptr(n) = acc_fdms(i,j)*tfac*mod2med_areacor(n) + enddo enddo enddo - !$omp end parallel do + !$omp end parallel do else - if (mnproc == 1) & - write(lp,*) subname//': co2 flux not sent to coupler' - endif - - ! ------------------------------------------------------------------------ - ! Provide bromoform flux [kg CHBr3 m-2 s-1], if requested. - ! ------------------------------------------------------------------------ - - call getfldindex(fldlist_num, fldlist, 'Faoo_fbrf_ocn', & - index_Faoo_fbrf_ocn) - - if (fbrf_requested .and. index_Faoo_fbrf_ocn > 0) then - fldlist(index_Faoo_fbrf_ocn)%dataptr(:) = 0._r8 - !$omp parallel do private(l, i, n) + if (first_call) then + if (mnproc == 1 .and. first_call) then + write(lp,*) subname//': dms flux not sent to coupler' + end if + end if + end if + + if (index_Faoo_brf > 0) then + ! brf flux (kmol BRF/m^2/s) + fldlist(index_Faoo_brf)%dataptr(:) = 0._r8 + !$omp parallel do private(l, i, n) do j = 1, jjcpl do l = 1, isp(j) - do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) - n = (j - 1)*ii + i - fldlist(index_Faoo_fbrf_ocn)%dataptr(n) = & - acc_fbrf(i,j)*tfac*mod2med_areacor(n) - enddo + do i = max(1, ifp(j,l)), min(ii, ilp(j,l)) + n = (j - 1)*ii + i + fldlist(index_Faoo_brf)%dataptr(n) = acc_fbrf(i,j)*tfac*mod2med_areacor(n) + enddo enddo enddo - !$omp end parallel do + !$omp end parallel do else - if (mnproc == 1) & - write(lp,*) subname//': bromoform flux not sent to coupler' - endif + if (first_call) then + if (mnproc == 1 .and. first_call) then + write(lp,*) subname//': brf flux not sent to coupler' + end if + end if + end if + + if (first_call) then + first_call = .false. + end if tlast_coupled = 0._r8 diff --git a/drivers/nuopc/ocn_comp_nuopc.F90 b/drivers/nuopc/ocn_comp_nuopc.F90 index 086501e5..d7b44e3b 100644 --- a/drivers/nuopc/ocn_comp_nuopc.F90 +++ b/drivers/nuopc/ocn_comp_nuopc.F90 @@ -41,12 +41,12 @@ module ocn_comp_nuopc use shr_file_mod, only: shr_file_getUnit, shr_file_getLogUnit, & shr_file_setLogUnit use shr_cal_mod, only : shr_cal_ymd2date - use mod_nuopc_methods, only: fldlist_type, tlast_coupled, fco2_requested, & - fdms_requested, fbrf_requested, & + use mod_nuopc_methods, only: fldlist_type, fldsMax, tlast_coupled, & blom_logwrite, blom_getgindex, blom_checkmesh, & blom_setareacor, blom_getglobdim, & blom_getprecipfact, blom_accflds, & - blom_importflds, blom_exportflds + blom_importflds, blom_exportflds, & + blom_advertise_imports, blom_advertise_exports use mod_xc, only: mpicom_external, lp, nfu use mod_cesm, only: runid_cesm, runtyp_cesm, ocn_cpl_dt_cesm use mod_config, only: inst_index, inst_name, inst_suffix @@ -62,7 +62,6 @@ module ocn_comp_nuopc character(len=*), parameter :: u_FILE_u = & __FILE__ - integer, parameter :: fldsMax = 100 integer :: fldsToOcn_num = 0 integer :: fldsFrOcn_num = 0 type(fldlist_type) :: fldsToOcn(fldsMax) @@ -74,8 +73,7 @@ module ocn_comp_nuopc integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_precip_factor = 0 - logical :: ldriver_has_atm_co2_diag, ldriver_has_atm_co2_prog, & - ocn2glc_coupling + logical :: ocn2glc_coupling, flds_dms_med integer :: dbug = 0 logical :: profile_memory = .false. @@ -88,42 +86,6 @@ module ocn_comp_nuopc ! Private procedures. ! --------------------------------------------------------------------------- - subroutine fldlist_add(num, fldlist, stdname, & - ungridded_lbound, ungridded_ubound) - ! --------------------------------------------------------------------------- - ! Add to list of field information. - ! --------------------------------------------------------------------------- - - ! Input/output arguments. - integer , intent(inout) :: num - type(fldlist_type), intent(inout) :: fldlist(:) - character(len=*) , intent(in) :: stdname - integer, optional , intent(in) :: ungridded_lbound, ungridded_ubound - - ! Local parameters. - character(len=*), parameter :: & - subname = modname//':(fldlist_add)' - - ! Local variables. - integer :: rc - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=subname//": ERROR number of field exceeded fldsMax: "// & - trim(stdname), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - fldlist(num)%stdname = trim(stdname) - - if (present(ungridded_lbound) .and. present(ungridded_ubound)) then - fldlist(num)%ungridded_lbound = ungridded_lbound - fldlist(num)%ungridded_ubound = ungridded_ubound - endif - - end subroutine fldlist_add - subroutine fldlist_realize(state, fldlist_num, fldlist, tag, mesh, rc) ! --------------------------------------------------------------------------- ! Realize list of import or export fields. @@ -387,7 +349,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: localPet, nthrds, shrlogunit, n character(len=cslen) :: starttype, stdname, cvalue, cname character(len=cllen) :: msg - logical :: isPresent, isSet, flds_co2a, flds_co2b, flds_co2c + logical :: isPresent, isSet + logical :: flds_co2a, flds_co2c ! Get debug flag. call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, & @@ -521,94 +484,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) trim(cvalue), ESMF_LOGMSG_INFO) endif - ! ------------------------------------------------------------------------ - ! Advertise import fields. - ! ------------------------------------------------------------------------ - - call fldlist_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name)) - - ! From ice: - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Si_ifrac') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_melth') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_meltw') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_salt') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_bcpho') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_bcphi') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Fioi_flxdst') - - ! From river: - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_rofl') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_rofi') - - ! From mediator: - call fldlist_add(fldsToOcn_num, fldsToOcn, 'So_duu10n') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_tauy') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_taux') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_lat') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_sen') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_lwup') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_evap') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Foxx_swnet') - - ! From wave: - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_lamult') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_ustokes') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_vstokes') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sw_hstokes') - - ! From atmosphere: - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_pslv') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_lwdn') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_snow') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Faxa_rain') - - ! From atm co2 fields: - + ! Determine if co2 will be imported from mediator call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc, __LINE__, u_FILE_u)) return read(cvalue,*) flds_co2a call blom_logwrite(subname//': flds_co2a = '//trim(cvalue)) - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) flds_co2b - call blom_logwrite(subname//': flds_co2b = '//trim(cvalue)) - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (ChkErr(rc, __LINE__, u_FILE_u)) return read(cvalue,*) flds_co2c call blom_logwrite(subname//': flds_co2c = '//trim(cvalue)) - if (flds_co2a .or. flds_co2c) then - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_co2diag') - call fldlist_add(fldsToOcn_num, fldsToOcn, 'Sa_co2prog') - ldriver_has_atm_co2_prog = .true. - ldriver_has_atm_co2_diag = .true. - else - ldriver_has_atm_co2_prog = .false. - ldriver_has_atm_co2_diag = .false. - endif - - !TODO Determine if will get nitrogen deposition from atm - - do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - enddo - - ! ------------------------------------------------------------------------ - ! Advertise export fields. - ! ------------------------------------------------------------------------ - ! Determine if ocn is sending temperature and salinity data to glc + ! If data is sent to glc will need to determine number of ocean + ! levels and ocean level indices call NUOPC_CompAttributeGet(gcomp, name="ocn2glc_coupling", value=cvalue, rc=rc) if (ChkErr(rc, __LINE__, u_FILE_u)) return read(cvalue,*) ocn2glc_coupling write(msg,'(a,l1)') subname//': ocn2glc coupling is ', ocn2glc_coupling call blom_logwrite(msg) - - ! Determine number of ocean levels and ocean level indices if (ocn2glc_coupling) then call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & msg=subname//": ocn2glc coupling not implemented", & @@ -616,17 +510,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - call fldlist_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name)) - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_omask') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_t') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_u') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_v') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_s') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_dhdx') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_dhdy') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'So_bldepth') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'Fioo_q') - call fldlist_add(fldsFrOcn_num, fldsFrOcn, 'Faoo_fco2_ocn') + !NOTE: Nitrogen deposition is always sent from atm now (either CAM or DATM) + + ! ------------------------------------------------------------------------ + ! Advertise import fields. + ! ------------------------------------------------------------------------ + + call blom_advertise_imports(flds_scalar_name, fldsToOcn_num, fldsToOcn, & + flds_co2a, flds_co2c) + + do n = 1,fldsToOcn_num + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (ChkErr(rc, __LINE__, u_FILE_u)) return + enddo + + ! ------------------------------------------------------------------------ + ! Advertise export fields. + ! ------------------------------------------------------------------------ + + call blom_advertise_exports(flds_scalar_name, fldsFrOcn_num, fldsFrOcn) do n = 1,fldsFrOcn_num call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & @@ -786,19 +689,6 @@ subroutine DataInitialize(gcomp, rc) call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) if (ChkErr(rc, __LINE__, u_FILE_u)) return - ! ------------------------------------------------------------------------ - ! Check whether non-standard export fields are present. - ! ------------------------------------------------------------------------ - - call ESMF_StateGet(exportState, 'Faoo_fco2_ocn', itemType) - fco2_requested = (itemType /= ESMF_STATEITEM_NOTFOUND) - - call ESMF_StateGet(exportState, 'Faoo_fdms_ocn', itemType) - fdms_requested = (itemType /= ESMF_STATEITEM_NOTFOUND) - - call ESMF_StateGet(exportState, 'Faoo_fbrf_ocn', itemType) - fbrf_requested = (itemType /= ESMF_STATEITEM_NOTFOUND) - ! ------------------------------------------------------------------------ ! TODO ! ------------------------------------------------------------------------ diff --git a/hamocc/accfields.F90 b/hamocc/accfields.F90 index 3edce9a7..614ad44f 100644 --- a/hamocc/accfields.F90 +++ b/hamocc/accfields.F90 @@ -46,111 +46,91 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) !******************************************************************************* use mod_xc, only: mnproc use mod_dia, only: ddm - use mo_carbch, only: atm,atmflx,co2fxd,co2fxu,co3,hi,kwco2sol,ndepflx,rivinflx,oalkflx,ocetra,omegaa,omegac,pco2d, & - & satoxy,sedfluxo,pco2m,kwco2d,co2sold,co2solm - use mo_biomod, only: bsiflx_bot,bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000,calflx_bot,calflx0100,calflx0500,& - & calflx1000,calflx2000,calflx4000,carflx_bot,carflx0100,carflx0500,carflx1000,carflx2000,carflx4000,& - & expoca,expoor,exposi,intdms_bac,intdms_uv,intdmsprod,intdnit,intnfix,intphosy,phosy3d - use mo_bgcmean, only: domassfluxes,jalkali,jano3,jasize,jatmco2,jbsiflx0100,jbsiflx0500,jbsiflx1000,jbsiflx2000, & - & jbsiflx4000,jbsiflx_bot,jcalc,jcalflx0100,jcalflx0500,jcalflx1000,jcalflx2000,jcalflx4000, & - & jcalflx_bot,jcarflx0100,jcarflx0500,jcarflx1000,jcarflx2000,jcarflx4000,jcarflx_bot, & - & jsediffic,jsediffal,jsediffph,jsediffox,jsediffn2,jsediffno3,jsediffsi,jco2flux, & - & jco2fxd,jco2fxu,jco3,jdic,jdicsat,jdms,jdms_bac,jdms_uv,jdmsflux,jdmsprod,jdoc,jdp,jeps,jexpoca, & - & jexport,jexposi,jgrazer,jintdnit,jintnfix,jintphosy,jiralk,jirdet,jirdin,jirdip,jirdoc,jiriron, & - & jiron,jirsi,jkwco2,jlvlalkali,jlvlano3,jlvlasize,jlvlbigd14c,jlvlbromo,jlvlcalc,jlvlcalc13, & - & jlvlcfc11,jlvlcfc12,jlvlco3,jlvld13c,jlvld14c,jlvldic,jlvldic13,jlvldic14,jlvldicsat,jlvldoc, & - & jlvldoc13,jlvleps,jlvlgrazer,jlvlgrazer13,jlvliron,jlvln2o,jlvlnatalkali,jlvlnatcalc,jlvlnatco3, & - & jlvlnatdic,jlvlnatomegaa,jlvlnatomegac,jlvlnos,jlvlo2sat,jlvlomegaa,jlvlomegac,jlvlopal,jlvloxygen,& - & jlvlph,jlvlphosph,jlvlphosy,jlvlphyto,jlvlphyto13,jlvlpoc,jlvlpoc13,jlvlprefalk,jlvlprefdic, & - & jlvlprefo2,jlvlprefpo4,jlvlsf6,jlvlsilica,jlvlwnos,jlvlwphy,jn2flux,jn2o,jn2oflux,jn2ofx, & - & jprorca,jprcaca,jsilpro,jpodiic,jpodial,jpodiph,jpodiox,jpodin2,jpodino3,jpodisi,jndep,joalk, & - & jniflux,jnos,jo2flux,jo2sat,jomegaa,jomegac,jopal,joxflux,joxygen,jpco2,jpco2m,jkwco2khm,jco2khm, & - & jco2kh,jph,jphosph,jphosy,jphyto,jpoc,jprefalk,jprefdic,jprefo2,jprefpo4,jsilica,jsrfalkali, & - & jsrfano3,jsrfdic,jsrfiron,jsrfoxygen,jsrfphosph,jsrfphyto,jsrfsilica,jsrfph,jwnos,jwphy,jndepfx, & - & joalkfx,nbgc,nacc_bgc,bgcwrt,glb_inventory,bgct2d,acclvl,acclyr,accsrf,bgczlv - use mo_control_bgc, only: io_stdo_bgc - use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmdms,iatmn2,iatmn2o,iatmo2,icalc,idet,idms,idicsat,idoc,iiron,iopal,& - & ioxygen,iphosph,iphy,iprefalk,iprefdic,iprefpo4,iprefo2,isco212,isilica,izoo, & - & irdin,irdip,irsi,iralk,iriron,irdoc,irdet - -#ifdef AGG - use mo_biomod, only: asize3d,eps3d,wnumb,wmass - use mo_param1_bgc, only: inos - use mo_control_bgc, only: dtb -#endif -#ifdef BROMO - use mo_param1_bgc, only: iatmbromo,ibromo - use mo_biomod, only: int_chbr3_prod,int_chbr3_uv - use mo_bgcmean, only: jatmbromo,jbromo,jbromo_prod,jbromo_uv,jbromofx,jsrfbromo -#endif -#ifdef CFC - use mo_param1_bgc, only: iatmf11,iatmf12,iatmsf6,icfc11,icfc12,isf6 - use mo_bgcmean, only: jcfc11,jcfc11fx,jcfc12,jcfc12fx,jsf6,jsf6fx -#endif -#ifdef cisonew - use mo_carbch, only: co213fxd,co213fxu,co214fxd,co214fxu - use mo_biomod, only: c14fac,re1312,re14to + use mo_carbch, only: atm,atmflx,co2fxd,co2fxu,co3,hi,kwco2sol,ndepflx,rivinflx,oalkflx,ocetra,omegaa,omegac,pco2d, & + satoxy,sedfluxo,pco2m,kwco2d,co2sold,co2solm, & + co213fxd,co213fxu,co214fxd,co214fxu, natco3,nathi,natomegaa,natomegac,natpco2d + use mo_biomod, only: bsiflx_bot,bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000,calflx_bot,calflx0100,calflx0500, & + calflx1000,calflx2000,calflx4000,carflx_bot,carflx0100,carflx0500,carflx1000,carflx2000,carflx4000, & + expoca,expoor,exposi,intdms_bac,intdms_uv,intdmsprod,intdnit,intnfix,intphosy,phosy3d, & + asize3d,eps3d,wnumb,wmass, int_chbr3_prod,int_chbr3_uv, c14fac,re1312,re14to + use mo_bgcmean, only: domassfluxes,jalkali,jano3,jasize,jatmco2,jbsiflx0100,jbsiflx0500,jbsiflx1000,jbsiflx2000, & + jbsiflx4000,jbsiflx_bot,jcalc,jcalflx0100,jcalflx0500,jcalflx1000,jcalflx2000,jcalflx4000, & + jcalflx_bot,jcarflx0100,jcarflx0500,jcarflx1000,jcarflx2000,jcarflx4000,jcarflx_bot, & + jsediffic,jsediffal,jsediffph,jsediffox,jsediffn2,jsediffno3,jsediffsi,jco2flux, & + jco2fxd,jco2fxu,jco3,jdic,jdicsat,jdms,jdms_bac,jdms_uv,jdmsflux,jdmsprod,jdoc,jdp,jeps,jexpoca, & + jexport,jexposi,jgrazer,jintdnit,jintnfix,jintphosy,jiralk,jirdet,jirdin,jirdip,jirdoc,jiriron, & + jiron,jirsi,jkwco2,jlvlalkali,jlvlano3,jlvlasize,jlvlbigd14c,jlvlbromo,jlvlcalc,jlvlcalc13, & + jlvlcfc11,jlvlcfc12,jlvlco3,jlvld13c,jlvld14c,jlvldic,jlvldic13,jlvldic14,jlvldicsat,jlvldoc, & + jlvldoc13,jlvleps,jlvlgrazer,jlvlgrazer13,jlvliron,jlvln2o,jlvlnatalkali,jlvlnatcalc,jlvlnatco3, & + jlvlnatdic,jlvlnatomegaa,jlvlnatomegac,jlvlnos,jlvlo2sat,jlvlomegaa,jlvlomegac,jlvlopal,jlvloxygen, & + jlvlph,jlvlphosph,jlvlphosy,jlvlphyto,jlvlphyto13,jlvlpoc,jlvlpoc13,jlvlprefalk,jlvlprefdic, & + jlvlprefo2,jlvlprefpo4,jlvlsf6,jlvlsilica,jlvlwnos,jlvlwphy,jn2flux,jn2o,jn2oflux,jn2ofx, & + jprorca,jprcaca,jsilpro,jpodiic,jpodial,jpodiph,jpodiox,jpodin2,jpodino3,jpodisi,jndep,joalk, & + jniflux,jnos,jo2flux,jo2sat,jomegaa,jomegac,jopal,joxflux,joxygen,jpco2,jpco2m,jkwco2khm,jco2khm, & + jco2kh,jph,jphosph,jphosy,jphyto,jpoc,jprefalk,jprefdic,jprefo2,jprefpo4,jsilica,jsrfalkali, & + jsrfano3,jsrfdic,jsrfiron,jsrfoxygen,jsrfphosph,jsrfphyto,jsrfsilica,jsrfph,jwnos,jwphy,jndepfx, & + joalkfx,nbgc,nacc_bgc,bgcwrt,glb_inventory,bgct2d,acclvl,acclyr,accsrf,bgczlv, & + jatmbromo,jbromo,jbromo_prod,jbromo_uv,jbromofx,jsrfbromo, & + jcfc11,jcfc11fx,jcfc12,jcfc12fx,jsf6,jsf6fx, & + jatmc13,jatmc14,jbigd14c,jcalc13,jco213fxd,jco213fxu,jco214fxd,jco214fxu,jd13c,jd14c,jdic13,jdic14, & + jdoc13,jgrazer13,jphyto13,jpoc13, & + jlvlnatph,jnatalkali,jnatcalc,jnatco2fx,jnatco3,jnatdic,jnatomegaa,jnatomegac,jnatpco2,jnatph, & + jsrfnatalk,jsrfnatdic,jsrfnatph, & + jbursssc12,jburssso12,jburssssil,jburssster,jpowaal,jpowaic,jpowaox,jpowaph,jpowaph,jpowasi,jpown2, & + jpowno3,jsssc12,jssso12,jssssil,jssster,accbur,accsdm, jatmco2,jatmn2,jatmo2 + use mo_control_bgc, only: io_stdo_bgc, & + dtb, use_BROMO, use_AGG, use_WLIN, use_natDIC, use_CFC, use_sedbypass, use_cisonew, use_BOXATM + use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmdms,iatmn2,iatmn2o,iatmo2,icalc,idet,idms,idicsat,idoc,iiron,iopal, & + ioxygen,iphosph,iphy,iprefalk,iprefdic,iprefpo4,iprefo2,isco212,isilica,izoo, & + irdin,irdip,irsi,iralk,iriron,irdoc,irdet,inos,iatmbromo,ibromo, & + iatmf11,iatmf12,iatmsf6,icfc11,icfc12,isf6, & + iatmc13,iatmc14,icalc13,idet13,idoc13,iphy13,isco213,isco214,izoo13,safediv, & + iatmnco2,inatalkali,inatcalc,inatsco212, & + ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster + use mo_sedmnt, only: powtra,sedlay,burial use mo_vgrid, only: dp_min - use mo_param1_bgc, only: iatmc13,iatmc14,icalc13,idet13,idoc13,iphy13,isco213,isco214,izoo13,safediv - use mo_bgcmean, only: jatmc13,jatmc14,jbigd14c,jcalc13,jco213fxd,jco213fxu,jco214fxd,jco214fxu,jd13c,jd14c,jdic13,jdic14,& - & jdoc13,jgrazer13,jphyto13,jpoc13 -#endif -#ifdef natDIC - use mo_param1_bgc, only: iatmnco2,inatalkali,inatcalc,inatsco212 - use mo_carbch, only: natco3,nathi,natomegaa,natomegac,natpco2d - use mo_bgcmean, only: jlvlnatph,jnatalkali,jnatcalc,jnatco2fx,jnatco3,jnatdic,jnatomegaa,jnatomegac,jnatpco2,jnatph, & - & jsrfnatalk,jsrfnatdic,jsrfnatph -#endif -#ifndef sedbypass - use mo_param1_bgc, only: ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster - use mo_sedmnt, only: powtra,sedlay,burial - use mo_bgcmean, only: jbursssc12,jburssso12,jburssssil,jburssster,jpowaal,jpowaic,jpowaox,jpowaph,jpowaph,jpowasi,jpown2, & - & jpowno3,jsssc12,jssso12,jssssil,jssster,accbur,accsdm -#endif - implicit none - INTEGER :: kpie,kpje,kpke - REAL :: pdlxp(kpie,kpje) - REAL :: pdlyp(kpie,kpje) - REAL :: pddpo(kpie,kpje,kpke) - REAL :: omask(kpie,kpje) -! Local variables + INTEGER , intent(in) :: kpie,kpje,kpke + REAL , intent(in) :: pdlxp(kpie,kpje) + REAL , intent(in) :: pdlyp(kpie,kpje) + REAL , intent(in) :: pddpo(kpie,kpje,kpke) + REAL , intent(in) :: omask(kpie,kpje) + + ! Local variables INTEGER :: i,j,k,l INTEGER :: ind1(kpie,kpje),ind2(kpie,kpje) REAL :: wghts(kpie,kpje,ddm) + REAL :: di12c ! cisonew + REAL :: d13c(kpie,kpje,kpke) ! cisonew + REAL :: d14c(kpie,kpje,kpke) ! cisonew + REAL :: bigd14c(kpie,kpje,kpke) ! cisonew -#ifdef cisonew - REAL :: di12c - REAL :: d13c(kpie,kpje,kpke) - REAL :: d14c(kpie,kpje,kpke) - REAL :: bigd14c(kpie,kpje,kpke) - - -! Calculation d13C, d14C and Dd14C: Delta notation for output - d13c(:,:,:)=0. - d14c(:,:,:)=0. - bigd14c(:,:,:)=0. - do k=1,kpke - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5.and.pddpo(i,j,k).gt.dp_min) then - - di12c=max(ocetra(i,j,k,isco212)-ocetra(i,j,k,isco213),0.) - d13c(i,j,k)=(ocetra(i,j,k,isco213)/(di12c+safediv)/re1312-1.)*1000. - d14c(i,j,k)=(ocetra(i,j,k,isco214)*c14fac/(ocetra(i,j,k,isco212)+safediv)/re14to-1.)*1000. - bigd14c(i,j,k)=d14c(i,j,k)-2.*(d13c(i,j,k)+25.)*(1.+d14c(i,j,k)/1000.) - - endif - enddo - enddo - enddo -#endif + if (use_cisonew) then + ! Calculation d13C, d14C and Dd14C: Delta notation for output + d13c(:,:,:)=0. + d14c(:,:,:)=0. + bigd14c(:,:,:)=0. + do k=1,kpke + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5.and.pddpo(i,j,k).gt.dp_min) then + + di12c=max(ocetra(i,j,k,isco212)-ocetra(i,j,k,isco213),0.) + d13c(i,j,k)=(ocetra(i,j,k,isco213)/(di12c+safediv)/re1312-1.)*1000. + d14c(i,j,k)=(ocetra(i,j,k,isco214)*c14fac/(ocetra(i,j,k,isco212)+safediv)/re14to-1.)*1000. + bigd14c(i,j,k)=d14c(i,j,k)-2.*(d13c(i,j,k)+25.)*(1.+d14c(i,j,k)/1000.) + + endif + enddo + enddo + enddo + end if -! Accumulated fluxes for inventory.F90. Note that these are currently not written to restart! -! Division by 2 is to account for leap-frog timestepping (but this is not exact) + ! Accumulated fluxes for inventory.F90. Note that these are currently not written to restart! + ! Division by 2 is to account for leap-frog timestepping (but this is not exact) do j=1,kpje do i=1,kpie if(omask(i,j).gt.0.5) then @@ -164,16 +144,16 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) bgct2d(i,j,jprorca) = bgct2d(i,j,jprorca) + carflx_bot(i,j)/2.0 bgct2d(i,j,jprcaca) = bgct2d(i,j,jprcaca) + calflx_bot(i,j)/2.0 bgct2d(i,j,jsilpro) = bgct2d(i,j,jsilpro) + bsiflx_bot(i,j)/2.0 -#ifndef sedbypass - ! Diffusive fluxes between water-column and sediment - bgct2d(i,j,jpodiic) = bgct2d(i,j,jpodiic) + sedfluxo(i,j,ipowaic)/2.0 - bgct2d(i,j,jpodial) = bgct2d(i,j,jpodial) + sedfluxo(i,j,ipowaal)/2.0 - bgct2d(i,j,jpodiph) = bgct2d(i,j,jpodiph) + sedfluxo(i,j,ipowaph)/2.0 - bgct2d(i,j,jpodiox) = bgct2d(i,j,jpodiox) + sedfluxo(i,j,ipowaox)/2.0 - bgct2d(i,j,jpodin2) = bgct2d(i,j,jpodin2) + sedfluxo(i,j,ipown2)/2.0 - bgct2d(i,j,jpodino3) = bgct2d(i,j,jpodino3) + sedfluxo(i,j,ipowno3)/2.0 - bgct2d(i,j,jpodisi) = bgct2d(i,j,jpodisi) + sedfluxo(i,j,ipowasi)/2.0 -#endif + if (.not. use_sedbypass) then + ! Diffusive fluxes between water-column and sediment + bgct2d(i,j,jpodiic) = bgct2d(i,j,jpodiic) + sedfluxo(i,j,ipowaic)/2.0 + bgct2d(i,j,jpodial) = bgct2d(i,j,jpodial) + sedfluxo(i,j,ipowaal)/2.0 + bgct2d(i,j,jpodiph) = bgct2d(i,j,jpodiph) + sedfluxo(i,j,ipowaph)/2.0 + bgct2d(i,j,jpodiox) = bgct2d(i,j,jpodiox) + sedfluxo(i,j,ipowaox)/2.0 + bgct2d(i,j,jpodin2) = bgct2d(i,j,jpodin2) + sedfluxo(i,j,ipown2)/2.0 + bgct2d(i,j,jpodino3) = bgct2d(i,j,jpodino3) + sedfluxo(i,j,ipowno3)/2.0 + bgct2d(i,j,jpodisi) = bgct2d(i,j,jpodisi) + sedfluxo(i,j,ipowasi)/2.0 + end if ! N-deposition, ocean alkalinization, and riverine input fluxes bgct2d(i,j,jndep) = bgct2d(i,j,jndep) + ndepflx(i,j)/2.0 bgct2d(i,j,joalk) = bgct2d(i,j,joalk) + oalkflx(i,j)/2.0 @@ -189,45 +169,44 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) enddo enddo - -! Accumulate atmosphere fields and fluxes + ! Accumulate atmosphere fields and fluxes call accsrf(jatmco2,atm(1,1,iatmco2),omask,0) -#if defined(BOXATM) - call accsrf(jatmo2 ,atm(1,1,iatmo2),omask,0) - call accsrf(jatmn2 ,atm(1,1,iatmn2),omask,0) -#endif + if (use_BOXATM) then + call accsrf(jatmo2 ,atm(1,1,iatmo2),omask,0) + call accsrf(jatmn2 ,atm(1,1,iatmn2),omask,0) + end if call accsrf(joxflux,atmflx(1,1,iatmo2),omask,0) call accsrf(jniflux,atmflx(1,1,iatmn2),omask,0) call accsrf(jn2ofx,atmflx(1,1,iatmn2o),omask,0) call accsrf(jdmsflux,atmflx(1,1,iatmdms),omask,0) -#ifdef CFC - call accsrf(jcfc11fx,atmflx(1,1,iatmf11),omask,0) - call accsrf(jcfc12fx,atmflx(1,1,iatmf12),omask,0) - call accsrf(jsf6fx,atmflx(1,1,iatmsf6),omask,0) -#endif -#ifdef natDIC - call accsrf(jnatco2fx,atmflx(1,1,iatmnco2),omask,0) -#endif -#ifdef BROMO - call accsrf(jatmbromo,atm(1,1,iatmbromo),omask,0) - call accsrf(jbromofx,atmflx(1,1,iatmbromo),omask,0) -#endif -#ifdef cisonew - call accsrf(jatmc13,atm(1,1,iatmc13),omask,0) - call accsrf(jatmc14,atm(1,1,iatmc14),omask,0) -#endif + if (use_CFC) then + call accsrf(jcfc11fx,atmflx(1,1,iatmf11),omask,0) + call accsrf(jcfc12fx,atmflx(1,1,iatmf12),omask,0) + call accsrf(jsf6fx,atmflx(1,1,iatmsf6),omask,0) + endif + if (use_natDIC) then + call accsrf(jnatco2fx,atmflx(1,1,iatmnco2),omask,0) + endif + if (use_BROMO) then + call accsrf(jatmbromo,atm(1,1,iatmbromo),omask,0) + call accsrf(jbromofx,atmflx(1,1,iatmbromo),omask,0) + endif + if (use_cisonew) then + call accsrf(jatmc13,atm(1,1,iatmc13),omask,0) + call accsrf(jatmc14,atm(1,1,iatmc14),omask,0) + endif ! Save up and downward fluxes for CO2 seperately call accsrf(jco2fxd,co2fxd,omask,0) call accsrf(jco2fxu,co2fxu,omask,0) -#ifdef cisonew - call accsrf(jco213fxd,co213fxd,omask,0) - call accsrf(jco213fxu,co213fxu,omask,0) - call accsrf(jco214fxd,co214fxd,omask,0) - call accsrf(jco214fxu,co214fxu,omask,0) -#endif + if (use_cisonew) then + call accsrf(jco213fxd,co213fxd,omask,0) + call accsrf(jco213fxu,co213fxu,omask,0) + call accsrf(jco214fxd,co214fxd,omask,0) + call accsrf(jco214fxu,co214fxu,omask,0) + endif -! Accumulate 2d diagnostics + ! Accumulate 2d diagnostics call accsrf(jpco2,pco2d,omask,0) call accsrf(jpco2m,pco2m,omask,0) call accsrf(jkwco2khm,kwco2sol,omask,0) @@ -253,23 +232,23 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) call accsrf(jintphosy,intphosy,omask,0) call accsrf(jintdnit,intdnit,omask,0) call accsrf(jintnfix,intnfix,omask,0) -#ifdef natDIC - call accsrf(jsrfnatdic,ocetra(1,1,1,inatsco212),omask,0) - call accsrf(jsrfnatalk,ocetra(1,1,1,inatalkali),omask,0) - call accsrf(jnatpco2,natpco2d,omask,0) - call accsrf(jsrfnatph,nathi(1,1,1),omask,0) -#endif -#ifdef BROMO - call accsrf(jsrfbromo,ocetra(1,1,1,ibromo),omask,0) - call accsrf(jbromo_prod,int_chbr3_prod,omask,0) - call accsrf(jbromo_uv,int_chbr3_uv,omask,0) -#endif + if (use_natDIC) then + call accsrf(jsrfnatdic,ocetra(1,1,1,inatsco212),omask,0) + call accsrf(jsrfnatalk,ocetra(1,1,1,inatalkali),omask,0) + call accsrf(jnatpco2,natpco2d,omask,0) + call accsrf(jsrfnatph,nathi(1,1,1),omask,0) + endif + if (use_BROMO) then + call accsrf(jsrfbromo,ocetra(1,1,1,ibromo),omask,0) + call accsrf(jbromo_prod,int_chbr3_prod,omask,0) + call accsrf(jbromo_uv,int_chbr3_uv,omask,0) + endif -! Accumulate fluxes due to N-deposition, ocean alkalinization + ! Accumulate fluxes due to N-deposition, ocean alkalinization call accsrf(jndepfx,ndepflx,omask,0) call accsrf(joalkfx,oalkflx,omask,0) -! Accumulate the diagnostic mass sinking field + ! Accumulate the diagnostic mass sinking field IF( domassfluxes ) THEN call accsrf(jcarflx0100,carflx0100,omask,0) call accsrf(jbsiflx0100,bsiflx0100,omask,0) @@ -291,18 +270,18 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) call accsrf(jcalflx_bot,calflx_bot,omask,0) ENDIF -#ifndef sedbypass -! Accumulate diffusive fluxes between water column and sediment - call accsrf(jsediffic,sedfluxo(1,1,ipowaic),omask,0) - call accsrf(jsediffal,sedfluxo(1,1,ipowaal),omask,0) - call accsrf(jsediffph,sedfluxo(1,1,ipowaph),omask,0) - call accsrf(jsediffox,sedfluxo(1,1,ipowaox),omask,0) - call accsrf(jsediffn2,sedfluxo(1,1,ipown2),omask,0) - call accsrf(jsediffno3,sedfluxo(1,1,ipowno3),omask,0) - call accsrf(jsediffsi,sedfluxo(1,1,ipowasi),omask,0) -#endif + if (.not. use_sedbypass) then + ! Accumulate diffusive fluxes between water column and sediment + call accsrf(jsediffic,sedfluxo(1,1,ipowaic),omask,0) + call accsrf(jsediffal,sedfluxo(1,1,ipowaal),omask,0) + call accsrf(jsediffph,sedfluxo(1,1,ipowaph),omask,0) + call accsrf(jsediffox,sedfluxo(1,1,ipowaox),omask,0) + call accsrf(jsediffn2,sedfluxo(1,1,ipown2),omask,0) + call accsrf(jsediffno3,sedfluxo(1,1,ipowno3),omask,0) + call accsrf(jsediffsi,sedfluxo(1,1,ipowasi),omask,0) + endif -! Accumulate layer diagnostics + ! Accumulate layer diagnostics call acclyr(jdp,pddpo,pddpo,0) call acclyr(jphyto,ocetra(1,1,1,iphy),pddpo,1) call acclyr(jgrazer,ocetra(1,1,1,izoo),pddpo,1) @@ -329,45 +308,44 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) call acclyr(jprefalk,ocetra(1,1,1,iprefalk),pddpo,1) call acclyr(jprefdic,ocetra(1,1,1,iprefdic),pddpo,1) call acclyr(jdicsat,ocetra(1,1,1,idicsat),pddpo,1) -#ifdef natDIC - call acclyr(jnatalkali,ocetra(1,1,1,inatalkali),pddpo,1) - call acclyr(jnatdic,ocetra(1,1,1,inatsco212),pddpo,1) - call acclyr(jnatcalc,ocetra(1,1,1,inatcalc),pddpo,1) - call acclyr(jnatco3,natco3,pddpo,1) - call acclyr(jnatph,nathi,pddpo,1) - call acclyr(jnatomegaa,natOmegaA,pddpo,1) - call acclyr(jnatomegac,natOmegaC,pddpo,1) -#endif -#ifdef cisonew - call acclyr(jdic13,ocetra(1,1,1,isco213),pddpo,1) - call acclyr(jdic14,ocetra(1,1,1,isco214),pddpo,1) - call acclyr(jd13c,d13c,pddpo,1) - call acclyr(jd14c,d14c,pddpo,1) - call acclyr(jbigd14c,bigd14c,pddpo,1) - call acclyr(jpoc13,ocetra(1,1,1,idet13),pddpo,1) - call acclyr(jdoc13,ocetra(1,1,1,idoc13),pddpo,1) - call acclyr(jcalc13,ocetra(1,1,1,icalc13),pddpo,1) - call acclyr(jphyto13,ocetra(1,1,1,iphy13),pddpo,1) - call acclyr(jgrazer13,ocetra(1,1,1,izoo13),pddpo,1) -#endif -#ifdef AGG - call acclyr(jnos,ocetra(1,1,1,inos),pddpo,1) - call acclyr(jwphy, wmass/dtb,pddpo,1) - call acclyr(jwnos, wnumb/dtb,pddpo,1) - call acclyr(jeps, eps3d, pddpo,1) - call acclyr(jasize,asize3d, pddpo,1) -#endif -#ifdef CFC - call acclyr(jcfc11,ocetra(1,1,1,icfc11),pddpo,1) - call acclyr(jcfc12,ocetra(1,1,1,icfc12),pddpo,1) - call acclyr(jsf6,ocetra(1,1,1,isf6),pddpo,1) -#endif -#ifdef BROMO - call acclyr(jbromo,ocetra(1,1,1,ibromo),pddpo,1) -#endif + if (use_natDIC) then + call acclyr(jnatalkali,ocetra(1,1,1,inatalkali),pddpo,1) + call acclyr(jnatdic,ocetra(1,1,1,inatsco212),pddpo,1) + call acclyr(jnatcalc,ocetra(1,1,1,inatcalc),pddpo,1) + call acclyr(jnatco3,natco3,pddpo,1) + call acclyr(jnatph,nathi,pddpo,1) + call acclyr(jnatomegaa,natOmegaA,pddpo,1) + call acclyr(jnatomegac,natOmegaC,pddpo,1) + endif + if (use_cisonew) then + call acclyr(jdic13,ocetra(1,1,1,isco213),pddpo,1) + call acclyr(jdic14,ocetra(1,1,1,isco214),pddpo,1) + call acclyr(jd13c,d13c,pddpo,1) + call acclyr(jd14c,d14c,pddpo,1) + call acclyr(jbigd14c,bigd14c,pddpo,1) + call acclyr(jpoc13,ocetra(1,1,1,idet13),pddpo,1) + call acclyr(jdoc13,ocetra(1,1,1,idoc13),pddpo,1) + call acclyr(jcalc13,ocetra(1,1,1,icalc13),pddpo,1) + call acclyr(jphyto13,ocetra(1,1,1,iphy13),pddpo,1) + call acclyr(jgrazer13,ocetra(1,1,1,izoo13),pddpo,1) + endif + if (use_AGG) then + call acclyr(jnos,ocetra(1,1,1,inos),pddpo,1) + call acclyr(jwphy, wmass/dtb,pddpo,1) + call acclyr(jwnos, wnumb/dtb,pddpo,1) + call acclyr(jeps, eps3d, pddpo,1) + call acclyr(jasize,asize3d, pddpo,1) + endif + if (use_CFC) then + call acclyr(jcfc11,ocetra(1,1,1,icfc11),pddpo,1) + call acclyr(jcfc12,ocetra(1,1,1,icfc12),pddpo,1) + call acclyr(jsf6,ocetra(1,1,1,isf6),pddpo,1) + endif + if (use_BROMO) then + call acclyr(jbromo,ocetra(1,1,1,ibromo),pddpo,1) + endif - -! Accumulate level diagnostics + ! Accumulate level diagnostics IF (SUM(jlvlphyto+jlvlgrazer+jlvlphosph+jlvloxygen+jlvliron+ & & jlvlano3+jlvlalkali+jlvlsilica+jlvldic+jlvldoc+jlvlpoc+jlvlcalc+& & jlvlopal+jlvln2o+jlvlco3+jlvlph+jlvlomegaa+jlvlomegac+jlvlphosy+& @@ -404,69 +382,68 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) call acclvl(jlvlprefalk,ocetra(1,1,1,iprefalk),k,ind1,ind2,wghts) call acclvl(jlvlprefdic,ocetra(1,1,1,iprefdic),k,ind1,ind2,wghts) call acclvl(jlvldicsat,ocetra(1,1,1,idicsat),k,ind1,ind2,wghts) -#ifdef natDIC - call acclvl(jlvlnatdic,ocetra(1,1,1,inatsco212),k,ind1,ind2,wghts) - call acclvl(jlvlnatalkali,ocetra(1,1,1,inatalkali),k,ind1,ind2,wghts) - call acclvl(jlvlnatcalc,ocetra(1,1,1,inatcalc),k,ind1,ind2,wghts) - call acclvl(jlvlnatco3,natco3,k,ind1,ind2,wghts) - call acclvl(jlvlnatph,nathi,k,ind1,ind2,wghts) - call acclvl(jlvlnatomegaa,natOmegaA,k,ind1,ind2,wghts) - call acclvl(jlvlnatomegac,natOmegaC,k,ind1,ind2,wghts) -#endif -#ifdef cisonew - call acclvl(jlvld13c,d13c,k,ind1,ind2,wghts) - call acclvl(jlvld14c,d14c,k,ind1,ind2,wghts) - call acclvl(jlvlbigd14c,bigd14c,k,ind1,ind2,wghts) - call acclvl(jlvldic13,ocetra(1,1,1,isco213),k,ind1,ind2,wghts) - call acclvl(jlvldic14,ocetra(1,1,1,isco214),k,ind1,ind2,wghts) - call acclvl(jlvlpoc13,ocetra(1,1,1,idet13),k,ind1,ind2,wghts) - call acclvl(jlvldoc13,ocetra(1,1,1,idoc13),k,ind1,ind2,wghts) - call acclvl(jlvlcalc13,ocetra(1,1,1,icalc13),k,ind1,ind2,wghts) - call acclvl(jlvlphyto13,ocetra(1,1,1,iphy13),k,ind1,ind2,wghts) - call acclvl(jlvlgrazer13,ocetra(1,1,1,izoo13),k,ind1,ind2,wghts) -#endif -#ifdef AGG - call acclvl(jlvlnos,ocetra(1,1,1,inos),k,ind1,ind2,wghts) - call acclvl(jlvlwphy, wmass/dtb,k,ind1,ind2,wghts) - call acclvl(jlvlwnos, wnumb/dtb,k,ind1,ind2,wghts) - call acclvl(jlvleps, eps3d, k,ind1,ind2,wghts) - call acclvl(jlvlasize,asize3d, k,ind1,ind2,wghts) -#endif -#ifdef CFC - call acclvl(jlvlcfc11,ocetra(1,1,1,icfc11),k,ind1,ind2,wghts) - call acclvl(jlvlcfc12,ocetra(1,1,1,icfc12),k,ind1,ind2,wghts) - call acclvl(jlvlsf6,ocetra(1,1,1,isf6),k,ind1,ind2,wghts) -#endif -#ifdef BROMO - call acclvl(jlvlbromo,ocetra(1,1,1,ibromo),k,ind1,ind2,wghts) -#endif + if (use_natDIC) then + call acclvl(jlvlnatdic,ocetra(1,1,1,inatsco212),k,ind1,ind2,wghts) + call acclvl(jlvlnatalkali,ocetra(1,1,1,inatalkali),k,ind1,ind2,wghts) + call acclvl(jlvlnatcalc,ocetra(1,1,1,inatcalc),k,ind1,ind2,wghts) + call acclvl(jlvlnatco3,natco3,k,ind1,ind2,wghts) + call acclvl(jlvlnatph,nathi,k,ind1,ind2,wghts) + call acclvl(jlvlnatomegaa,natOmegaA,k,ind1,ind2,wghts) + call acclvl(jlvlnatomegac,natOmegaC,k,ind1,ind2,wghts) + endif + if (use_cisonew) then + call acclvl(jlvld13c,d13c,k,ind1,ind2,wghts) + call acclvl(jlvld14c,d14c,k,ind1,ind2,wghts) + call acclvl(jlvlbigd14c,bigd14c,k,ind1,ind2,wghts) + call acclvl(jlvldic13,ocetra(1,1,1,isco213),k,ind1,ind2,wghts) + call acclvl(jlvldic14,ocetra(1,1,1,isco214),k,ind1,ind2,wghts) + call acclvl(jlvlpoc13,ocetra(1,1,1,idet13),k,ind1,ind2,wghts) + call acclvl(jlvldoc13,ocetra(1,1,1,idoc13),k,ind1,ind2,wghts) + call acclvl(jlvlcalc13,ocetra(1,1,1,icalc13),k,ind1,ind2,wghts) + call acclvl(jlvlphyto13,ocetra(1,1,1,iphy13),k,ind1,ind2,wghts) + call acclvl(jlvlgrazer13,ocetra(1,1,1,izoo13),k,ind1,ind2,wghts) + endif + if (use_AGG) then + call acclvl(jlvlnos,ocetra(1,1,1,inos),k,ind1,ind2,wghts) + call acclvl(jlvlwphy, wmass/dtb,k,ind1,ind2,wghts) + call acclvl(jlvlwnos, wnumb/dtb,k,ind1,ind2,wghts) + call acclvl(jlvleps, eps3d, k,ind1,ind2,wghts) + call acclvl(jlvlasize,asize3d, k,ind1,ind2,wghts) + endif + if (use_CFC) then + call acclvl(jlvlcfc11,ocetra(1,1,1,icfc11),k,ind1,ind2,wghts) + call acclvl(jlvlcfc12,ocetra(1,1,1,icfc12),k,ind1,ind2,wghts) + call acclvl(jlvlsf6,ocetra(1,1,1,isf6),k,ind1,ind2,wghts) + endif + if (use_BROMO) then + call acclvl(jlvlbromo,ocetra(1,1,1,ibromo),k,ind1,ind2,wghts) + endif ENDDO ENDIF -#ifndef sedbypass -! Accumulate sediments - call accsdm(jpowaic,powtra(1,1,1,ipowaic)) - call accsdm(jpowaal,powtra(1,1,1,ipowaal)) - call accsdm(jpowaph,powtra(1,1,1,ipowaph)) - call accsdm(jpowaox,powtra(1,1,1,ipowaox)) - call accsdm(jpown2 ,powtra(1,1,1,ipown2) ) - call accsdm(jpowno3,powtra(1,1,1,ipowno3)) - call accsdm(jpowasi,powtra(1,1,1,ipowasi)) - call accsdm(jssso12,sedlay(1,1,1,issso12)) - call accsdm(jssssil,sedlay(1,1,1,issssil)) - call accsdm(jsssc12,sedlay(1,1,1,isssc12)) - call accsdm(jssster,sedlay(1,1,1,issster)) - -! Accumulate sediment burial - call accbur(jburssso12,burial(1,1,issso12)) - call accbur(jburssssil,burial(1,1,issssil)) - call accbur(jbursssc12,burial(1,1,isssc12)) - call accbur(jburssster,burial(1,1,issster)) -#endif - + if (.not. use_sedbypass) then + ! Accumulate sediments + call accsdm(jpowaic,powtra(1,1,1,ipowaic)) + call accsdm(jpowaal,powtra(1,1,1,ipowaal)) + call accsdm(jpowaph,powtra(1,1,1,ipowaph)) + call accsdm(jpowaox,powtra(1,1,1,ipowaox)) + call accsdm(jpown2 ,powtra(1,1,1,ipown2) ) + call accsdm(jpowno3,powtra(1,1,1,ipowno3)) + call accsdm(jpowasi,powtra(1,1,1,ipowasi)) + call accsdm(jssso12,sedlay(1,1,1,issso12)) + call accsdm(jssssil,sedlay(1,1,1,issssil)) + call accsdm(jsssc12,sedlay(1,1,1,isssc12)) + call accsdm(jssster,sedlay(1,1,1,issster)) + + ! Accumulate sediment burial + call accbur(jburssso12,burial(1,1,issso12)) + call accbur(jburssssil,burial(1,1,issssil)) + call accbur(jbursssc12,burial(1,1,isssc12)) + call accbur(jburssster,burial(1,1,issster)) + end if -! Write output if requested + ! Write output if requested DO l=1,nbgc nacc_bgc(l)=nacc_bgc(l)+1 if (bgcwrt(l)) then @@ -484,4 +461,4 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) rivinflx=0. RETURN - END + END SUBROUTINE ACCFIELDS diff --git a/hamocc/aufr_bgc.F90 b/hamocc/aufr_bgc.F90 index 6b40d8fe..02da7f23 100644 --- a/hamocc/aufr_bgc.F90 +++ b/hamocc/aufr_bgc.F90 @@ -5,16 +5,16 @@ ! This file is part of BLOM/iHAMOCC. ! ! BLOM is free software: you can redistribute it and/or modify it under the -! terms of the GNU Lesser General Public License as published by the Free -! Software Foundation, either version 3 of the License, or (at your option) -! any later version. +! terms of the GNU Lesser General Public License as published by the Free +! Software Foundation, either version 3 of the License, or (at your option) +! any later version. ! -! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY -! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -! more details. +! more details. ! -! You should have received a copy of the GNU Lesser General Public License +! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. @@ -43,7 +43,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! and "NOMPI" ! ! J.Schwinger, *GFI, Bergen* 2014-05-21 -! - adapted code for writing of two time level tracer +! - adapted code for writing of two time level tracer ! and sediment fields ! ! A.Moree, *GFI, Bergen* 2018-04-12 @@ -57,7 +57,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! observed d13C and d14C). This is used if c-isotope fields are ! not found in the restart file. ! - consistently organised restart of CFC and natural tracers -! from scratch, i.e. for the case that CFC and natural tracers are +! from scratch, i.e. for the case that CFC and natural tracers are ! not found in the restart file. ! - removed satn2o which is not needed to restart the model ! - added sediment bypass preprocessor option @@ -76,9 +76,9 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! ------- ! The bgc data are read from an extra file, other than the ocean data. ! The time stamp of the bgc restart file (idate) is specified from the -! ocean time stamp through the SBR parameter list of AUFW_BGC. The only -! time control variable proper to the bgc is the time step number -! (idate(5)). It can differ from that of the ocean (idate(4)) by the +! ocean time stamp through the SBR parameter list of AUFW_BGC. The only +! time control variable proper to the bgc is the time step number +! (idate(5)). It can differ from that of the ocean (idate(4)) by the ! difference of the offsets of restart files. ! ! @@ -91,7 +91,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! *INTEGER* *ntr* - number of tracers in tracer field ! *INTEGER* *ntrbgc* - number of biogechemical tracers in tracer field ! *INTEGER* *itrbgc* - start index for biogeochemical tracers in tracer field -! *REAL* *trc* - initial/restart tracer field to be passed to the +! *REAL* *trc* - initial/restart tracer field to be passed to the ! ocean model [mol/kg] ! *INTEGER* *kplyear* - year in ocean restart date ! *INTEGER* *kplmon* - month in ocean restart date @@ -102,66 +102,47 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! !************************************************************************** - use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close,nf90_open,nf90_get_att,nf90_inq_varid + use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close,nf90_open,nf90_get_att,nf90_inq_varid use mo_carbch, only: co2star,co3,hi,satoxy - use mo_control_bgc, only: io_stdo_bgc,ldtbgc + use mo_carbch, only: ocetra + use mo_carbch, only: atm + use mo_carbch, only: nathi + use mo_control_bgc, only: io_stdo_bgc,ldtbgc,use_cisonew,use_AGG,use_BOXATM,use_BROMO,use_CFC,use_natDIC,use_sedbypass use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idicsat,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy,& - & iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo,nocetra + iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo,nocetra use mo_vgrid, only: kbo use mo_sedmnt, only: sedhpl use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 use mod_xc, only: nbdy,mnproc,iqr,jqr,xcbcst,xchalt use mod_dia, only: iotype -#ifdef AGG - use mo_param1_bgc, only: iadust,inos -#endif -#ifdef BOXATM - use mo_param1_bgc, only: iatmco2,iatmn2,iatmo2 - use mo_carbch, only: atm -#endif -#ifdef BROMO - use mo_param1_bgc, only: ibromo -#endif -#ifdef CFC - use mo_param1_bgc, only: icfc11,icfc12,isf6 -#endif -#ifdef cisonew - use mo_carbch, only: ocetra - use mo_biomod, only: bifr13,bifr14,c14fac,re1312,re14to - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv -#ifndef sedbypass - use mo_param1_bgc, only: issso13,issso14,isssc13,isssc14,ipowc13,ipowc14 -#endif -#endif -#ifdef natDIC - use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 - use mo_carbch, only: nathi -#endif -#ifndef sedbypass - use mo_param1_bgc, only: ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster,ks -#endif - + use mo_bgcmean, only: jatmo2,jatmn2 + use mo_biomod, only: bifr13,bifr14,c14fac,re1312,re14to,prei13,prei14 + use mo_param1_bgc, only: iadust,inos,iatmco2,iatmn2,iatmo2,ibromo,icfc11,icfc12,isf6, & + icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv, & + issso13,issso14,isssc13,isssc14,ipowc13,ipowc14, & + iatmc13,iatmc14,iatmnco2, & + inatalkali,inatcalc,inatsco212, & + ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster,ks implicit none - INTEGER :: kpie,kpje,kpke,ntr,ntrbgc,itrbgc - REAL :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) - REAL :: omask(kpie,kpje) - INTEGER :: kplyear,kplmon,kplday - character(len=*) :: rstfnm + INTEGER, intent(in) :: kpie,kpje,kpke,ntr,ntrbgc,itrbgc + REAL, intent(inout) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) + REAL, intent(in) :: omask(kpie,kpje) + INTEGER, intent(in) :: kplyear,kplmon,kplday + character(len=*), intent(in) :: rstfnm ! Local variables - REAL :: locetra(kpie,kpje,2*kpke,nocetra) ! local array for reading + REAL, allocatable :: locetra(:,:,:,:) ! local array for reading + INTEGER :: errstat INTEGER :: restyear ! year of restart file INTEGER :: restmonth ! month of restart file INTEGER :: restday ! day of restart file INTEGER :: restdtoce ! time step number from bgc ocean file INTEGER :: idate(5),i,j,k logical :: lread_cfc,lread_nat,lread_iso,lread_atm,lread_bro -#ifdef cisonew - REAL :: rco213,rco214,alpha14,beta13,beta14,d14cat -#endif - INTEGER ncid,ncstat,ncvarid + REAL :: rco213,rco214,alpha14,beta13,beta14,d13C_atm,d14cat ! cisonew + INTEGER :: ncid,ncstat,ncvarid #ifdef PNETCDF # include @@ -176,11 +157,15 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & character(len=9) :: stripestr2 integer :: ierr,testio INTEGER :: leninrstfn - + ! + ! Allocate and initialize local array for reading (locetra) + ! + allocate(locetra(kpie,kpje,2*kpke,nocetra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory for locetra allocation' locetra(:,:,:,:) = 0.0 -! -! Open netCDF data file -! + ! + ! Open netCDF data file + ! testio=0 IF(mnproc==1 .AND. IOTYPE==0) THEN ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) @@ -188,14 +173,13 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & CALL xchalt('(AUFR: Problem with netCDF1)') stop '(AUFR: Problem with netCDF1)' ENDIF - -! -! Read restart data : date -! + ! + ! Read restart data : date + ! ncstat = NF90_GET_ATT(ncid, NF90_GLOBAL,'date', idate) IF ( ncstat .NE. NF90_NOERR ) THEN CALL xchalt('(AUFR: Problem reading date of restart file)') - stop '(AUFR: Problem reading date of restart file)' + stop '(AUFR: Problem reading date of restart file)' ENDIF restyear = idate(1) restmonth = idate(2) @@ -227,13 +211,13 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & stop '(AUFR: Problem with netCDF1)' ENDIF -! -! Read restart data : date -! + ! + ! Read restart data : date + ! ncstat = NFMPI_GET_ATT_INT(ncid, NF_GLOBAL,'date', idate) IF ( ncstat .NE. NF_NOERR ) THEN CALL xchalt('(AUFR: Problem reading date of restart file)') - stop '(AUFR: Problem reading date of restart file)' + stop '(AUFR: Problem reading date of restart file)' ENDIF restyear = idate(1) restmonth = idate(2) @@ -257,9 +241,9 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & endif ENDIF -! -! Compare with date read from ocean restart file -! + ! + ! Compare with date read from ocean restart file + ! IF (mnproc.eq.1) THEN IF ( kplyear .NE. restyear ) THEN @@ -280,112 +264,111 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & & ,kplday,'/',restday,' !!!' ENDIF - ENDIF - -! Find out whether to restart CFCs -#ifdef CFC - lread_cfc=.true. - IF(IOTYPE==0) THEN - if(mnproc==1) ncstat=nf90_inq_varid(ncid,'cfc11',ncvarid) - call xcbcst(ncstat) - if(ncstat.ne.nf90_noerr) lread_cfc=.false. - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - ncstat=nfmpi_inq_varid(ncid,'cfc11',ncvarid) - if(ncstat.ne.nf_noerr) lread_cfc=.false. -#endif - ENDIF - IF(mnproc==1 .and. .not. lread_cfc) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'AUFR_BGC info: CFC tracers not in restart file, ' - WRITE(io_stdo_bgc,*) ' CFCs initialised to zero.' ENDIF -#endif -! Find out whether to restart natural tracers -#ifdef natDIC - lread_nat=.true. - IF(IOTYPE==0) THEN - if(mnproc==1) ncstat=nf90_inq_varid(ncid,'natsco212',ncvarid) - call xcbcst(ncstat) - if(ncstat.ne.nf90_noerr) lread_nat=.false. - ELSE IF(IOTYPE==1) THEN + ! Find out whether to restart CFCs + if (use_CFC) then + lread_cfc=.true. + IF(IOTYPE==0) THEN + if(mnproc==1) ncstat=nf90_inq_varid(ncid,'cfc11',ncvarid) + call xcbcst(ncstat) + if(ncstat.ne.nf90_noerr) lread_cfc=.false. + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat=nfmpi_inq_varid(ncid,'natsco212',ncvarid) - if(ncstat.ne.nf_noerr) lread_nat=.false. -#endif - ENDIF - IF(mnproc==1 .and. .not. lread_nat) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'AUFR_BGC info: natural tracers not in restart file. ' - WRITE(io_stdo_bgc,*) ' Initialising natural tracers with their non-natural ' - WRITE(io_stdo_bgc,*) ' counterpart.' - ENDIF + ncstat=nfmpi_inq_varid(ncid,'cfc11',ncvarid) + if(ncstat.ne.nf_noerr) lread_cfc=.false. #endif - -! Find out whether to restart marine carbon isotopes -#ifdef cisonew - lread_iso=.true. - IF(IOTYPE==0) THEN - if(mnproc==1) ncstat=nf90_inq_varid(ncid,'sco213',ncvarid) - call xcbcst(ncstat) - if(ncstat.ne.nf90_noerr) lread_iso=.false. - ELSE IF(IOTYPE==1) THEN + ENDIF + IF(mnproc==1 .and. .not. lread_cfc) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'AUFR_BGC info: CFC tracers not in restart file, ' + WRITE(io_stdo_bgc,*) ' CFCs initialised to zero.' + ENDIF + end if + + ! Find out whether to restart natural tracers + if (use_natDIC) then + lread_nat=.true. + IF(IOTYPE==0) THEN + if(mnproc==1) ncstat=nf90_inq_varid(ncid,'natsco212',ncvarid) + call xcbcst(ncstat) + if(ncstat.ne.nf90_noerr) lread_nat=.false. + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat=nfmpi_inq_varid(ncid,'sco213',ncvarid) - if(ncstat.ne.nf_noerr) lread_iso=.false. + ncstat=nfmpi_inq_varid(ncid,'natsco212',ncvarid) + if(ncstat.ne.nf_noerr) lread_nat=.false. #endif - ENDIF - IF(mnproc==1 .and. .not. lread_iso) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'AUFR_BGC info: carbon isotopes not in restart file. ' - WRITE(io_stdo_bgc,*) ' Initialising carbon isotopes from scratch ' - ENDIF -#endif - -! Find out whether to restart Bromoform -#ifdef BROMO - lread_bro=.true. - IF(IOTYPE==0) THEN - if(mnproc==1) ncstat=nf90_inq_varid(ncid,'bromo',ncvarid) - call xcbcst(ncstat) - if(ncstat.ne.nf90_noerr) lread_bro=.false. - ELSE IF(IOTYPE==1) THEN + ENDIF + IF(mnproc==1 .and. .not. lread_nat) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'AUFR_BGC info: natural tracers not in restart file. ' + WRITE(io_stdo_bgc,*) ' Initialising natural tracers with their non-natural ' + WRITE(io_stdo_bgc,*) ' counterpart.' + ENDIF + end if + + ! Find out whether to restart marine carbon isotopes + if (use_cisonew) then + lread_iso=.true. + IF(IOTYPE==0) THEN + if(mnproc==1) ncstat=nf90_inq_varid(ncid,'sco213',ncvarid) + call xcbcst(ncstat) + if(ncstat.ne.nf90_noerr) lread_iso=.false. + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat=nfmpi_inq_varid(ncid,'bromo',ncvarid) - if(ncstat.ne.nf_noerr) lread_bro=.false. + ncstat=nfmpi_inq_varid(ncid,'sco213',ncvarid) + if(ncstat.ne.nf_noerr) lread_iso=.false. #endif - ENDIF - IF(mnproc==1 .and. .not. lread_bro) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'AUFR_BGC info: Bromoform tracer not in restart file, ' - WRITE(io_stdo_bgc,*) 'Initialised to 0.01 pmol L-1 (Stemmler et al., 2015).' - ENDIF -#endif - -! Find out whether to restart atmosphere -#if defined(BOXATM) - lread_atm=.true. - IF(IOTYPE==0) THEN - if(mnproc==1) ncstat=nf90_inq_varid(ncid,'atmco2',ncvarid) - call xcbcst(ncstat) - if(ncstat.ne.nf90_noerr) lread_atm=.false. - ELSE IF(IOTYPE==1) THEN + ENDIF + IF(mnproc==1 .and. .not. lread_iso) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'AUFR_BGC info: carbon isotopes not in restart file. ' + WRITE(io_stdo_bgc,*) ' Initialising carbon isotopes from scratch ' + ENDIF + end if + + ! Find out whether to restart Bromoform + if (use_BROMO) then + lread_bro=.true. + IF(IOTYPE==0) THEN + if(mnproc==1) ncstat=nf90_inq_varid(ncid,'bromo',ncvarid) + call xcbcst(ncstat) + if(ncstat.ne.nf90_noerr) lread_bro=.false. + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat=nfmpi_inq_varid(ncid,'atmco2',ncvarid) - if(ncstat.ne.nf_noerr) lread_atm=.false. + ncstat=nfmpi_inq_varid(ncid,'bromo',ncvarid) + if(ncstat.ne.nf_noerr) lread_bro=.false. #endif - ENDIF - IF(mnproc==1 .and. .not. lread_atm) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'AUFR_BGC info: atmosphere fields not in restart file. ' - WRITE(io_stdo_bgc,*) ' Initialising atmosphere from scratch ' - ENDIF + ENDIF + IF(mnproc==1 .and. .not. lread_bro) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'AUFR_BGC info: Bromoform tracer not in restart file, ' + WRITE(io_stdo_bgc,*) 'Initialised to 0.01 pmol L-1 (Stemmler et al., 2015).' + ENDIF + end if + + ! Find out whether to restart atmosphere + if (use_BOXATM) then + lread_atm=.true. + IF(IOTYPE==0) THEN + if(mnproc==1) ncstat=nf90_inq_varid(ncid,'atmco2',ncvarid) + call xcbcst(ncstat) + if(ncstat.ne.nf90_noerr) lread_atm=.false. + ELSE IF(IOTYPE==1) THEN +#ifdef PNETCDF + ncstat=nfmpi_inq_varid(ncid,'atmco2',ncvarid) + if(ncstat.ne.nf_noerr) lread_atm=.false. #endif - -! -! Read restart data : ocean aquateous tracer -! + ENDIF + IF(mnproc==1 .and. .not. lread_atm) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'AUFR_BGC info: atmosphere fields not in restart file. ' + WRITE(io_stdo_bgc,*) ' Initialising atmosphere from scratch ' + ENDIF + end if + ! + ! Read restart data : ocean aquateous tracer + ! CALL read_netcdf_var(ncid,'sco212',locetra(1,1,1,isco212),2*kpke,0,iotype) CALL read_netcdf_var(ncid,'alkali',locetra(1,1,1,ialkali),2*kpke,0,iotype) CALL read_netcdf_var(ncid,'phosph',locetra(1,1,1,iphosph),2*kpke,0,iotype) @@ -409,232 +392,228 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & CALL read_netcdf_var(ncid,'prefdic',locetra(1,1,1,iprefdic),2*kpke,0,iotype) CALL read_netcdf_var(ncid,'dicsat',locetra(1,1,1,idicsat),2*kpke,0,iotype) -#ifdef cisonew - IF(lread_iso) THEN - CALL read_netcdf_var(ncid,'sco213',locetra(1,1,1,isco213),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'sco214',locetra(1,1,1,isco214),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'doc13',locetra(1,1,1,idoc13),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'doc14',locetra(1,1,1,idoc14),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'phyto13',locetra(1,1,1,iphy13),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'phyto14',locetra(1,1,1,iphy14),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'grazer13',locetra(1,1,1,izoo13),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'grazer14',locetra(1,1,1,izoo14),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'poc13',locetra(1,1,1,idet13),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'poc14',locetra(1,1,1,idet14),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu13',locetra(1,1,1,icalc13),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu14',locetra(1,1,1,icalc14),2*kpke,0,iotype) - ENDIF -#endif -#ifdef AGG - CALL read_netcdf_var(ncid,'snos',locetra(1,1,1,inos),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'adust',locetra(1,1,1,iadust),2*kpke,0,iotype) -#endif /*AGG*/ -#ifdef CFC - IF(lread_cfc) THEN - CALL read_netcdf_var(ncid,'cfc11',locetra(1,1,1,icfc11),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'cfc12',locetra(1,1,1,icfc12),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'sf6',locetra(1,1,1,isf6),2*kpke,0,iotype) - ENDIF -#endif -#ifdef natDIC - IF(lread_nat) THEN - CALL read_netcdf_var(ncid,'natsco212',locetra(1,1,1,inatsco212),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'natalkali',locetra(1,1,1,inatalkali),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'natcalciu',locetra(1,1,1,inatcalc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0,iotype) - ELSE - CALL read_netcdf_var(ncid,'sco212',locetra(1,1,1,inatsco212),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'alkali',locetra(1,1,1,inatalkali),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,inatcalc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'hi',nathi(1,1,1),kpke,0,iotype) - ENDIF -#endif -#ifdef BROMO - IF(lread_bro) THEN - CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) - ENDIF -#endif - -! -! Read restart data : diagnostic ocean fields (needed for bit to bit reproducability) -! + if (use_cisonew) then + IF(lread_iso) THEN + CALL read_netcdf_var(ncid,'sco213',locetra(1,1,1,isco213),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'sco214',locetra(1,1,1,isco214),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'doc13',locetra(1,1,1,idoc13),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'doc14',locetra(1,1,1,idoc14),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'phyto13',locetra(1,1,1,iphy13),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'phyto14',locetra(1,1,1,iphy14),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'grazer13',locetra(1,1,1,izoo13),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'grazer14',locetra(1,1,1,izoo14),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'poc13',locetra(1,1,1,idet13),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'poc14',locetra(1,1,1,idet14),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'calciu13',locetra(1,1,1,icalc13),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'calciu14',locetra(1,1,1,icalc14),2*kpke,0,iotype) + ENDIF + endif + if (use_AGG)then + CALL read_netcdf_var(ncid,'snos',locetra(1,1,1,inos),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'adust',locetra(1,1,1,iadust),2*kpke,0,iotype) + end if + if (use_CFC) then + IF(lread_cfc) THEN + CALL read_netcdf_var(ncid,'cfc11',locetra(1,1,1,icfc11),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'cfc12',locetra(1,1,1,icfc12),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'sf6',locetra(1,1,1,isf6),2*kpke,0,iotype) + ENDIF + endif + if (use_natDIC) then + IF(lread_nat) THEN + CALL read_netcdf_var(ncid,'natsco212',locetra(1,1,1,inatsco212),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'natalkali',locetra(1,1,1,inatalkali),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'natcalciu',locetra(1,1,1,inatcalc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0,iotype) + ELSE + CALL read_netcdf_var(ncid,'sco212',locetra(1,1,1,inatsco212),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'alkali',locetra(1,1,1,inatalkali),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,inatcalc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'hi',nathi(1,1,1),kpke,0,iotype) + ENDIF + end if + if (use_BROMO) then + IF(lread_bro) THEN + CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) + ENDIF + end if + ! + ! Read restart data : diagnostic ocean fields (needed for bit to bit reproducability) + ! CALL read_netcdf_var(ncid,'hi',hi(1,1,1),kpke,0,iotype) CALL read_netcdf_var(ncid,'co3',co3(1,1,1),kpke,0,iotype) CALL read_netcdf_var(ncid,'co2star',co2star(1,1,1),kpke,0,iotype) CALL read_netcdf_var(ncid,'satoxy',satoxy(1,1,1),kpke,0,iotype) - -! -! Read restart data : sediment variables. -! -#ifndef sedbypass - CALL read_netcdf_var(ncid,'ssso12',sedlay2(1,1,1,issso12),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'sssc12',sedlay2(1,1,1,isssc12),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'ssssil',sedlay2(1,1,1,issssil),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0,iotype) - CALL read_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0,iotype) - CALL read_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'pown2',powtra2(1,1,1,ipown2),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powno3',powtra2(1,1,1,ipowno3),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powasi',powtra2(1,1,1,ipowasi),2*ks,0,iotype) -#ifdef cisonew - IF(lread_iso) THEN - CALL read_netcdf_var(ncid,'ssso13',sedlay2(1,1,1,issso13),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'ssso14',sedlay2(1,1,1,issso14),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'sssc13',sedlay2(1,1,1,isssc13),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'sssc14',sedlay2(1,1,1,isssc14),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'bur_o13',burial2(1,1,1,issso13),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_o14',burial2(1,1,1,issso14),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_c13',burial2(1,1,1,isssc13),2,0,iotype) - CALL read_netcdf_var(ncid,'bur_c14',burial2(1,1,1,isssc14),2,0,iotype) - CALL read_netcdf_var(ncid,'powc13',powtra2(1,1,1,ipowc13),2*ks,0,iotype) - CALL read_netcdf_var(ncid,'powc14',powtra2(1,1,1,ipowc14),2*ks,0,iotype) - ENDIF -#endif -#endif - -! -! Read restart data: atmosphere -! -#if defined(BOXATM) - IF(lread_atm) THEN - CALL read_netcdf_var(ncid,'atmco2',atm2(1,1,1,iatmco2),2,0,iotype) - CALL read_netcdf_var(ncid,'atmo2',atm2(1,1,1,iatmo2),2,0,iotype) - CALL read_netcdf_var(ncid,'atmn2',atm2(1,1,1,iatmn2),2,0,iotype) -#ifdef cisonew - IF(lread_iso) THEN - CALL read_netcdf_var(ncid,'atmc13',atm2(1,1,1,iatmc13),2,0,iotype) - CALL read_netcdf_var(ncid,'atmc14',atm2(1,1,1,iatmc14),2,0,iotype) - ELSE - ! If atm isotopes are not in restart but boxatm is on, calculate initial value using atmco2 - ! that is just read in from restart files. Normalize atmc14 using beleg c14fac. - DO j=1,kpje - DO i=1,kpie - beta13 = (prei13/1000.)+1. - alpha14 = 2.*(prei13+25.) - d14cat = (prei14+alpha14)/(1.-alpha14/1000.) - atm(i,j,iatmc13) = beta13*re1312*atm2(i,j,1,iatmco2)/(1.+beta13*re1312) - atm(i,j,iatmc14) = ((d14cat/1000.)+1.)*re14to*atm2(i,j,1,iatmco2)/c14fac - ENDDO - ENDDO - ! Copy the isotope atmosphere fields into both timelevels of atm2. - atm2(:,:,1,iatmc13) = atm(:,:,iatmc13) - atm2(:,:,2,iatmc13) = atm(:,:,iatmc13) - atm2(:,:,1,iatmc14) = atm(:,:,iatmc14) - atm2(:,:,2,iatmc14) = atm(:,:,iatmc14) - ENDIF -#endif -#ifdef natDIC - CALL read_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0,iotype) -#endif - ELSE - ! If atmosphere field is not in restart, copy the atmosphere field - ! (initialised in beleg.F90) into both timelevels of atm2. - atm2(:,:,1,:) = atm(:,:,:) - atm2(:,:,2,:) = atm(:,:,:) - ENDIF -#endif + ! + ! Read restart data : sediment variables. + ! + if (.not. use_sedbypass) then + CALL read_netcdf_var(ncid,'ssso12',sedlay2(1,1,1,issso12),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'sssc12',sedlay2(1,1,1,isssc12),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'ssssil',sedlay2(1,1,1,issssil),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0,iotype) + CALL read_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0,iotype) + CALL read_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'pown2',powtra2(1,1,1,ipown2),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powno3',powtra2(1,1,1,ipowno3),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powasi',powtra2(1,1,1,ipowasi),2*ks,0,iotype) + if (use_cisonew) then + IF(lread_iso) THEN + CALL read_netcdf_var(ncid,'ssso13',sedlay2(1,1,1,issso13),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'ssso14',sedlay2(1,1,1,issso14),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'sssc13',sedlay2(1,1,1,isssc13),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'sssc14',sedlay2(1,1,1,isssc14),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'bur_o13',burial2(1,1,1,issso13),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_o14',burial2(1,1,1,issso14),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_c13',burial2(1,1,1,isssc13),2,0,iotype) + CALL read_netcdf_var(ncid,'bur_c14',burial2(1,1,1,isssc14),2,0,iotype) + CALL read_netcdf_var(ncid,'powc13',powtra2(1,1,1,ipowc13),2*ks,0,iotype) + CALL read_netcdf_var(ncid,'powc14',powtra2(1,1,1,ipowc14),2*ks,0,iotype) + ENDIF + endif + end if + ! + ! Read restart data: atmosphere + ! + if (use_BOXATM) then + IF(lread_atm) THEN + CALL read_netcdf_var(ncid,'atmco2',atm2(1,1,1,iatmco2),2,0,iotype) + CALL read_netcdf_var(ncid,'atmo2',atm2(1,1,1,iatmo2),2,0,iotype) + CALL read_netcdf_var(ncid,'atmn2',atm2(1,1,1,iatmn2),2,0,iotype) + if (use_cisonew) then + IF(lread_iso) THEN + CALL read_netcdf_var(ncid,'atmc13',atm2(1,1,1,iatmc13),2,0,iotype) + CALL read_netcdf_var(ncid,'atmc14',atm2(1,1,1,iatmc14),2,0,iotype) + ELSE + ! If atm isotopes are not in restart but boxatm is on, calculate initial value using atmco2 + ! that is just read in from restart files. Normalize atmc14 using beleg c14fac. + DO j=1,kpje + DO i=1,kpie + beta13 = (prei13/1000.)+1. + alpha14 = 2.*(prei13+25.) + d14cat = (prei14+alpha14)/(1.-alpha14/1000.) + atm(i,j,iatmc13) = beta13*re1312*atm2(i,j,1,iatmco2)/(1.+beta13*re1312) + atm(i,j,iatmc14) = ((d14cat/1000.)+1.)*re14to*atm2(i,j,1,iatmco2)/c14fac + ENDDO + ENDDO + ! Copy the isotope atmosphere fields into both timelevels of atm2. + atm2(:,:,1,iatmc13) = atm(:,:,iatmc13) + atm2(:,:,2,iatmc13) = atm(:,:,iatmc13) + atm2(:,:,1,iatmc14) = atm(:,:,iatmc14) + atm2(:,:,2,iatmc14) = atm(:,:,iatmc14) + ENDIF + endif + if (use_natDIC) then + CALL read_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0,iotype) + endif + ELSE + ! If atmosphere field is not in restart, copy the atmosphere field + ! (initialised in beleg.F90) into both timelevels of atm2. + atm2(:,:,1,:) = atm(:,:,:) + atm2(:,:,2,:) = atm(:,:,:) + ENDIF + end if IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = NF90_CLOSE(ncid) + ncstat = NF90_CLOSE(ncid) ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat = NFMPI_CLOSE(ncid) + ncstat = NFMPI_CLOSE(ncid) #endif ENDIF - -#ifdef cisonew - IF(.NOT. lread_iso) THEN - ! If carbon isotope fields are not read from restart file, copy the d13C - ! d14C fields (initialised in beleg.F90) into both timelevels of locetra. - locetra(:,:,1:kpke, isco213)=ocetra(:,:,:,isco213) - locetra(:,:,kpke+1:2*kpke,isco213)=ocetra(:,:,:,isco213) - locetra(:,:,1:kpke, isco214)=ocetra(:,:,:,isco214) - locetra(:,:,kpke+1:2*kpke,isco214)=ocetra(:,:,:,isco214) - ! Initialise 13C and 14C fields in the same way as in beleg.F90 - DO k=1,2*kpke - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - ! 13C is read in as delta13C, convert to 13C using model restart total C - beta13=locetra(i,j,k,isco213)/1000.+1. - locetra(i,j,k,isco213)=locetra(i,j,k,isco212)*beta13*re1312/(1.+beta13*re1312) - - ! 14C is read in as delta14C, convert to 14C using model restart total C, - ! normalize 14C by c14fac to prevent numerical errors - beta14=locetra(i,j,k,isco214)/1000.+1. - locetra(i,j,k,isco214)=locetra(i,j,k,isco212)*beta14*re14to/c14fac - - ! Initialise the remaining 13C and 14C fields, using the restart isco212 field - rco213=locetra(i,j,k,isco213)/(locetra(i,j,k,isco212)+safediv) - rco214=locetra(i,j,k,isco214)/(locetra(i,j,k,isco212)+safediv) - locetra(i,j,k,idoc13)=locetra(i,j,k,idoc)*rco213*bifr13 - locetra(i,j,k,idoc14)=locetra(i,j,k,idoc)*rco214*bifr14 - locetra(i,j,k,iphy13)=locetra(i,j,k,iphy)*rco213*bifr13 - locetra(i,j,k,iphy14)=locetra(i,j,k,iphy)*rco214*bifr14 - locetra(i,j,k,izoo13)=locetra(i,j,k,izoo)*rco213*bifr13 - locetra(i,j,k,izoo14)=locetra(i,j,k,izoo)*rco214*bifr14 - locetra(i,j,k,idet13)=locetra(i,j,k,idet)*rco213*bifr13 - locetra(i,j,k,idet14)=locetra(i,j,k,idet)*rco214*bifr14 - locetra(i,j,k,icalc13)=locetra(i,j,k,icalc)*rco213 - locetra(i,j,k,icalc14)=locetra(i,j,k,icalc)*rco214 - - ENDIF - ENDDO - ENDDO - ENDDO -#ifndef sedbypass - ! Burial fields for c-isotopes still missing - !JT added burial loop below 20.06.2023 - DO k=1,2*ks - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - powtra2(i,j,k,ipowc13)=powtra2(i,j,k,ipowaic)*rco213 - powtra2(i,j,k,ipowc14)=powtra2(i,j,k,ipowaic)*rco214 - sedlay2(i,j,k,issso13)=sedlay2(i,j,k,issso12)*rco213*bifr13 - sedlay2(i,j,k,issso14)=sedlay2(i,j,k,issso12)*rco214*bifr14 - sedlay2(i,j,k,isssc13)=sedlay2(i,j,k,isssc12)*rco213 - sedlay2(i,j,k,isssc14)=sedlay2(i,j,k,isssc12)*rco214 - ENDIF - ENDDO - ENDDO - ENDDO - - DO k=1,2 - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - burial2(i,j,k,issso13)=burial2(i,j,k,issso12)*rco213*bifr13 - burial2(i,j,k,issso14)=burial2(i,j,k,issso12)*rco214*bifr14 - burial2(i,j,k,isssc13)=burial2(i,j,k,isssc12)*rco213 - burial2(i,j,k,isssc14)=burial2(i,j,k,isssc12)*rco214 - ENDIF - ENDDO - ENDDO - ENDDO -#endif - ENDIF ! .NOT. lread_iso -#endif - -! return tracer fields to ocean model (both timelevels); No unit -! conversion here, since tracers in the restart file are in -! BLOM units (mol/kg) -!-------------------------------------------------------------------- -! + if (use_cisonew) then + IF(.NOT. lread_iso) THEN + ! If carbon isotope fields are not read from restart file, copy the d13C + ! d14C fields (initialised in beleg.F90) into both timelevels of locetra. + locetra(:,:,1:kpke, isco213)=ocetra(:,:,:,isco213) + locetra(:,:,kpke+1:2*kpke,isco213)=ocetra(:,:,:,isco213) + locetra(:,:,1:kpke, isco214)=ocetra(:,:,:,isco214) + locetra(:,:,kpke+1:2*kpke,isco214)=ocetra(:,:,:,isco214) + ! Initialise 13C and 14C fields in the same way as in beleg.F90 + DO k=1,2*kpke + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + ! 13C is read in as delta13C, convert to 13C using model restart total C + beta13=locetra(i,j,k,isco213)/1000.+1. + locetra(i,j,k,isco213)=locetra(i,j,k,isco212)*beta13*re1312/(1.+beta13*re1312) + + ! 14C is read in as delta14C, convert to 14C using model restart total C, + ! normalize 14C by c14fac to prevent numerical errors + beta14=locetra(i,j,k,isco214)/1000.+1. + locetra(i,j,k,isco214)=locetra(i,j,k,isco212)*beta14*re14to/c14fac + + ! Initialise the remaining 13C and 14C fields, using the restart isco212 field + rco213=locetra(i,j,k,isco213)/(locetra(i,j,k,isco212)+safediv) + rco214=locetra(i,j,k,isco214)/(locetra(i,j,k,isco212)+safediv) + locetra(i,j,k,idoc13)=locetra(i,j,k,idoc)*rco213*bifr13 + locetra(i,j,k,idoc14)=locetra(i,j,k,idoc)*rco214*bifr14 + locetra(i,j,k,iphy13)=locetra(i,j,k,iphy)*rco213*bifr13 + locetra(i,j,k,iphy14)=locetra(i,j,k,iphy)*rco214*bifr14 + locetra(i,j,k,izoo13)=locetra(i,j,k,izoo)*rco213*bifr13 + locetra(i,j,k,izoo14)=locetra(i,j,k,izoo)*rco214*bifr14 + locetra(i,j,k,idet13)=locetra(i,j,k,idet)*rco213*bifr13 + locetra(i,j,k,idet14)=locetra(i,j,k,idet)*rco214*bifr14 + locetra(i,j,k,icalc13)=locetra(i,j,k,icalc)*rco213 + locetra(i,j,k,icalc14)=locetra(i,j,k,icalc)*rco214 + ENDIF + ENDDO + ENDDO + ENDDO + + if (.not. use_sedbypass) then + ! Burial fields for c-isotopes still missing + DO k=1,2*ks + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + powtra2(i,j,k,ipowc13)=powtra2(i,j,k,ipowaic)*rco213 + powtra2(i,j,k,ipowc14)=powtra2(i,j,k,ipowaic)*rco214 + sedlay2(i,j,k,issso13)=sedlay2(i,j,k,issso12)*rco213*bifr13 + sedlay2(i,j,k,issso14)=sedlay2(i,j,k,issso12)*rco214*bifr14 + sedlay2(i,j,k,isssc13)=sedlay2(i,j,k,isssc12)*rco213 + sedlay2(i,j,k,isssc14)=sedlay2(i,j,k,isssc12)*rco214 + ENDIF + ENDDO + ENDDO + ENDDO + + DO k=1,2 + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + burial2(i,j,k,issso13)=burial2(i,j,k,issso12)*rco213*bifr13 + burial2(i,j,k,issso14)=burial2(i,j,k,issso12)*rco214*bifr14 + burial2(i,j,k,isssc13)=burial2(i,j,k,isssc12)*rco213 + burial2(i,j,k,isssc14)=burial2(i,j,k,isssc12)*rco214 + ENDIF + ENDDO + ENDDO + ENDDO + + end if ! .NOT. use_sedbypass + ENDIF ! .NOT. lread_iso + end if ! use_cisonew + + ! return tracer fields to ocean model (both timelevels); No unit + ! conversion here, since tracers in the restart file are in + ! BLOM units (mol/kg) + !-------------------------------------------------------------------- + ! trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1)=locetra(:,:,:,:) - + deallocate(locetra) RETURN - END + END SUBROUTINE AUFR_BGC diff --git a/hamocc/aufw_bgc.F90 b/hamocc/aufw_bgc.F90 index 6c615a5b..8636d550 100644 --- a/hamocc/aufw_bgc.F90 +++ b/hamocc/aufw_bgc.F90 @@ -5,20 +5,20 @@ ! This file is part of BLOM/iHAMOCC. ! ! BLOM is free software: you can redistribute it and/or modify it under the -! terms of the GNU Lesser General Public License as published by the Free -! Software Foundation, either version 3 of the License, or (at your option) -! any later version. +! terms of the GNU Lesser General Public License as published by the Free +! Software Foundation, either version 3 of the License, or (at your option) +! any later version. ! -! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY -! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -! more details. +! more details. ! -! You should have received a copy of the GNU Lesser General Public License +! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. - SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) !****************************************************************************** ! @@ -41,7 +41,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! - code cleanup, removed preprocessor option "PNETCDF" ! ! J.Schwinger, *GFI, Bergen* 2014-05-21 -! - adapted code for writing of two time level tracer and +! - adapted code for writing of two time level tracer and ! sediment fields ! ! A.Moree, *GFI, Bergen* 2018-04-12 @@ -69,7 +69,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! The bgc data are written to an extra file, other than the ocean data. ! The time stamp of the bgc restart file (idate) is taken from the ! ocean time stamp through the SBR parameter list. The only time -! control variable proper to the bgc is the time step number (idate(5)). +! control variable proper to the bgc is the time step number (idate(5)). ! It can differ from that of the ocean (idate(4)) by the difference ! of the offsets of restart files. ! @@ -83,7 +83,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! *INTEGER* *ntr* - number of tracers in tracer field ! *INTEGER* *ntrbgc* - number of biogechemical tracers in tracer field ! *INTEGER* *itrbgc* - start index for biogeochemical tracers in tracer field -! *REAL* *trc* - initial/restart tracer field to be passed from the +! *REAL* *trc* - initial/restart tracer field to be passed from the ! ocean model [mol/kg] ! *REAL* *sedlay2* - initial/restart sediment (two time levels) field ! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field @@ -96,43 +96,25 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! *CHAR* *rstfnm* - restart file name-informations ! !************************************************************************** - use netcdf, only: nf90_64bit_offset,nf90_global,nf90_noerr,nf90_nofill,nf90_def_dim,nf90_enddef,nf90_close, & - & nf90_create,nf90_put_att,nf90_set_fill - use mo_carbch, only: co2star,co3, hi,satoxy - use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasko - use mo_param1_bgc, only: ialkali, ian2o,iano3,icalc,idet,idicsat,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy, & - & iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo,ks,nocetra + use netcdf, only: nf90_64bit_offset,nf90_global,nf90_noerr,nf90_nofill,nf90_def_dim,nf90_enddef,nf90_close, & + nf90_create,nf90_put_att,nf90_set_fill + use mo_carbch, only: co2star,co3,hi,satoxy,nathi + use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasko, & + use_cisonew, use_AGG, use_BOXATM, use_BROMO, use_CFC, use_natDIC, use_sedbypass use mo_sedmnt, only: sedhpl use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 use mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt use mod_dia, only: iotype -#ifdef AGG - use mo_param1_bgc, only: iadust, inos -#endif -#ifdef BOXATM - use mo_param1_bgc, only: iatmco2,iatmn2,iatmo2 -#endif -#ifdef BROMO - use mo_param1_bgc, only: ibromo -#endif -#ifdef CFC - use mo_param1_bgc, only: icfc11,icfc12,isf6 -#endif -#ifdef cisonew - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14 -#ifndef sedbypass - use mo_param1_bgc, only: issso13,issso14,isssc13,isssc14,ipowc13,ipowc14 -#endif -#endif -#ifdef natDIC - use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 - use mo_carbch, only: nathi -#endif -#ifndef sedbypass - use mo_param1_bgc, only: ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster -#endif + use mo_control_bgc, only: rmasks + use mo_param1_bgc, only: ialkali, ian2o,iano3,icalc,idet,idicsat,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy, & + iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo,ks,nocetra, & + iadust, inos,iatmco2,iatmn2,iatmo2,ibromo,icfc11,icfc12,isf6, & + icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14, & + issso13,issso14,isssc13,isssc14,ipowc13,ipowc14, & + iatmnco2,iatmc13,iatmc14, & + inatalkali,inatcalc,inatsco212, & + ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster - implicit none INTEGER, intent(in) :: kpie,kpje,kpke,ntr,ntrbgc,itrbgc @@ -144,6 +126,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! Local variables INTEGER :: i,j REAL :: locetra(kpie,kpje,2*kpke,nocetra) + INTEGER :: errstat ! Variables for netcdf INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) @@ -164,13 +147,16 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & save /xcmpii/ #endif -! pass tracer fields in from ocean model, note that both timelevels -! are passed into the local array locetra; No unit conversion here, -! tracers in the restart file are written in mol/kg -!-------------------------------------------------------------------- -! + ! pass tracer fields in from ocean model, note that both timelevels + ! are passed into the local array locetra; No unit conversion here, + ! tracers in the restart file are written in mol/kg + !-------------------------------------------------------------------- + ! testio=0 - locetra(:,:,:,:)=trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) + ! + ! Initialize local array for writing (locetra) + ! + locetra(:,:,:,:) = trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) idate(1) = kplyear idate(2) = kplmon @@ -178,18 +164,17 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & idate(4) = kpldtoce idate(5) = ldtbgc IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Writing restart file at date :' & - &,'YY=',idate(1),' MM=',idate(2),' day=',idate(3) - WRITE(io_stdo_bgc,*) 'Ocean model step number is ',idate(4) - WRITE(io_stdo_bgc,*) 'Bgc model step number is ',idate(5) + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Writing restart file at date :' & + &,'YY=',idate(1),' MM=',idate(2),' day=',idate(3) + WRITE(io_stdo_bgc,*) 'Ocean model step number is ',idate(4) + WRITE(io_stdo_bgc,*) 'Bgc model step number is ',idate(5) ENDIF rmissing = rmasko - -! -! Open netCDF data file -! + ! + ! Open netCDF data file + ! IF(mnproc==1 .AND. IOTYPE==0) THEN write(io_stdo_bgc,*) 'BGC RESTART ',rstfnm ncstat = NF90_CREATE(rstfnm,NF90_64BIT_OFFSET,ncid) @@ -215,22 +200,21 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & stop '(AUFW: Problem with netCDF1)' ENDIF #endif - if(testio .eq. 0) then CALL xchalt('(AUFW: Problem with namelist iotype)') stop '(AUFW: Problem with namelist iotype)' endif ENDIF -! -! Define dimension -! ---------------------------------------------------------------------- -! + ! + ! Define dimension + ! ---------------------------------------------------------------------- + ! IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = NF90_DEF_DIM(ncid, 'lon', itdm, nclonid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF2)') - stop '(AUFW: Problem with netCDF2)' + ncstat = NF90_DEF_DIM(ncid, 'lon', itdm, nclonid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF2)') + stop '(AUFW: Problem with netCDF2)' ENDIF ncstat = NF90_DEF_DIM(ncid, 'lat', jtdm, nclatid) @@ -319,15 +303,16 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & stop '(AUFW: Problem with PnetCDF7)' ENDIF #endif - ENDIF + ENDIF !mnproc==1 .AND. IOTYPE==0 -! -! Define global attributes -! ---------------------------------------------------------------------- -! - IF(mnproc==1 .AND. IOTYPE==0) THEN + ! + ! Define global attributes + ! ---------------------------------------------------------------------- + ! + IF (mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'title' & - &, 'Restart data for marine bgc modules') + &, 'Restart data for marine bgc modules') IF ( ncstat .NE. NF90_NOERR ) THEN call xchalt('(AUFW: Problem with netCDF9)') stop '(AUFW: Problem with netCDF9)' @@ -360,8 +345,8 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & stop '(AUFW: Problem with netCDF11)' ENDIF -!PNETCDF - ELSE IF (IOTYPE==1) THEN + ELSE IF (IOTYPE==1) THEN + #ifdef PNETCDF clen=len('Restart data for marine bgc modules') ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'title' & @@ -400,502 +385,503 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ENDIF #endif - ENDIF -! -! Define variables : advected ocean tracer -! ---------------------------------------------------------------------- -! - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = nclev2id - ncdimst(4) = 0 - ENDIF + ENDIF ! IOTYPE == 1 + ! + ! Define variables : advected ocean tracer + ! ---------------------------------------------------------------------- + ! + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = nclev2id + ncdimst(4) = 0 + ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'sco212',3,ncdimst,ncvarid, & - & 6,'mol/kg',13, 'Dissolved CO2',rmissing,10,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'sco212',3,ncdimst,ncvarid, & + & 6,'mol/kg',13, 'Dissolved CO2',rmissing,10,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'alkali',3,ncdimst,ncvarid, & - & 6,'mol/kg',10,'Alkalinity',rmissing,11,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'alkali',3,ncdimst,ncvarid, & + & 6,'mol/kg',10,'Alkalinity',rmissing,11,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'phosph',3,ncdimst,ncvarid, & - & 6,'mol/kg',19,'Dissolved phosphate',rmissing,12,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'phosph',3,ncdimst,ncvarid, & + & 6,'mol/kg',19,'Dissolved phosphate',rmissing,12,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'oxygen',3,ncdimst,ncvarid, & - & 6,'mol/kg',16,'Dissolved oxygen', & - rmissing,13,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'oxygen',3,ncdimst,ncvarid, & + & 6,'mol/kg',16,'Dissolved oxygen', & + rmissing,13,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'gasnit',3,ncdimst,ncvarid, & - & 6,'mol/kg',21,'Gaseous nitrogen (N2)', & - rmissing,14,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'gasnit',3,ncdimst,ncvarid, & + & 6,'mol/kg',21,'Gaseous nitrogen (N2)', & + rmissing,14,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,4,'ano3',3,ncdimst,ncvarid, & - & 6,'mol/kg',17,'Dissolved nitrate', & - rmissing,15,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,4,'ano3',3,ncdimst,ncvarid, & + & 6,'mol/kg',17,'Dissolved nitrate', & + rmissing,15,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'silica',3,ncdimst,ncvarid, & - & 6,'mol/kg',22,'Silicid acid (Si(OH)4)', & - rmissing,16,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'silica',3,ncdimst,ncvarid, & + & 6,'mol/kg',22,'Silicid acid (Si(OH)4)', & + rmissing,16,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'doc',3,ncdimst,ncvarid, & - & 6,'mol/kg',24,'Dissolved organic carbon', & - & rmissing,17,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,3,'doc',3,ncdimst,ncvarid, & + & 6,'mol/kg',24,'Dissolved organic carbon', & + & rmissing,17,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'poc',3,ncdimst,ncvarid, & - & 6,'mol/kg',25,'Particulate organic carbon', & - & rmissing,18,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,3,'poc',3,ncdimst,ncvarid, & + & 6,'mol/kg',25,'Particulate organic carbon', & + & rmissing,18,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'phyto',3,ncdimst,ncvarid, & - & 7,'molP/kg',27,'Phytoplankton concentration', & - & rmissing,19,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,5,'phyto',3,ncdimst,ncvarid, & + & 7,'molP/kg',27,'Phytoplankton concentration', & + & rmissing,19,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'grazer',3,ncdimst,ncvarid, & - & 7,'molP/kg',25,'Zooplankton concentration', & - & rmissing,20,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'grazer',3,ncdimst,ncvarid, & + & 7,'molP/kg',25,'Zooplankton concentration', & + & rmissing,20,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'calciu',3,ncdimst,ncvarid, & - & 6,'mol/kg',17,'Calcium carbonate', & - & rmissing,21,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'calciu',3,ncdimst,ncvarid, & + & 6,'mol/kg',17,'Calcium carbonate', & + & rmissing,21,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,4,'opal',3,ncdimst,ncvarid, & - & 6,'mol/kg',15,'Biogenic silica', & - & rmissing,22,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,4,'opal',3,ncdimst,ncvarid, & + & 6,'mol/kg',15,'Biogenic silica', & + & rmissing,22,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'n2o',3,ncdimst,ncvarid, & - & 6,'mol/kg',12,'laughing gas', & - & rmissing,23,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,3,'n2o',3,ncdimst,ncvarid, & + & 6,'mol/kg',12,'laughing gas', & + & rmissing,23,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'dms',3,ncdimst,ncvarid, & - & 6,'mol/kg',15 ,'DiMethylSulfide', & - & rmissing,24,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,3,'dms',3,ncdimst,ncvarid, & + & 6,'mol/kg',15 ,'DiMethylSulfide', & + & rmissing,24,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'fdust',3,ncdimst,ncvarid, & - & 5,'kg/kg',19,'Non-aggregated dust', & - & rmissing,25,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,5,'fdust',3,ncdimst,ncvarid, & + & 5,'kg/kg',19,'Non-aggregated dust', & + & rmissing,25,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,4,'iron',3,ncdimst,ncvarid, & - & 6,'mol/kg',14,'Dissolved iron', & - & rmissing,26,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,4,'iron',3,ncdimst,ncvarid, & + & 6,'mol/kg',14,'Dissolved iron', & + & rmissing,26,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'prefo2',3,ncdimst,ncvarid, & - & 6,'mol/kg',16,'Preformed oxygen', & - rmissing,27,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'prefo2',3,ncdimst,ncvarid, & + & 6,'mol/kg',16,'Preformed oxygen', & + rmissing,27,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'prefpo4',3,ncdimst,ncvarid, & - & 6,'mol/kg',19,'Preformed phosphate', & - rmissing,28,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,7,'prefpo4',3,ncdimst,ncvarid, & + & 6,'mol/kg',19,'Preformed phosphate', & + rmissing,28,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'prefalk',3,ncdimst,ncvarid, & - & 6,'mol/kg',20,'Preformed alkalinity', & - rmissing,29,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,7,'prefalk',3,ncdimst,ncvarid, & + & 6,'mol/kg',20,'Preformed alkalinity', & + rmissing,29,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'prefdic',3,ncdimst,ncvarid, & - & 6,'mol/kg',13,'Preformed dic', & - rmissing,30,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,7,'prefdic',3,ncdimst,ncvarid, & + & 6,'mol/kg',13,'Preformed dic', & + rmissing,30,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'dicsat',3,ncdimst,ncvarid, & - & 6,'mol/kg',13,'Saturated dic', & - rmissing,31,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'dicsat',3,ncdimst,ncvarid, & + & 6,'mol/kg',13,'Saturated dic', & + rmissing,31,io_stdo_bgc) -#ifdef cisonew + if (use_cisonew) then CALL NETCDF_DEF_VARDB(ncid,6,'sco213',3,ncdimst,ncvarid, & - & 6,'mol/kg',15, 'Dissolved CO213',rmissing,32,io_stdo_bgc) + & 6,'mol/kg',15, 'Dissolved CO213',rmissing,32,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & - & 6,'mol/kg',15, 'Dissolved CO214',rmissing,33,io_stdo_bgc) + & 6,'mol/kg',15, 'Dissolved CO214',rmissing,33,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'doc13',3,ncdimst,ncvarid, & - & 6,'mol/kg',24,'Dissolved organic carb13', & - & rmissing,34,io_stdo_bgc) + & 6,'mol/kg',24,'Dissolved organic carb13', & + & rmissing,34,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & - & 6,'mol/kg',24,'Dissolved organic carb14', & - & rmissing,35,io_stdo_bgc) + & 6,'mol/kg',24,'Dissolved organic carb14', & + & rmissing,35,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'poc13',3,ncdimst,ncvarid, & - & 7,'molC/kg',28,'Particulate organic carbon13', & - & rmissing,36,io_stdo_bgc) + & 7,'molC/kg',28,'Particulate organic carbon13', & + & rmissing,36,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & - & 7,'molC/kg',28,'Particulate organic carbon14', & - & rmissing,37,io_stdo_bgc) + & 7,'molC/kg',28,'Particulate organic carbon14', & + & rmissing,37,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,7,'phyto13',3,ncdimst,ncvarid, & - & 7,'molP/kg',27,'Phytoplankton concentr. 13c', & - & rmissing,38,io_stdo_bgc) + & 7,'molP/kg',27,'Phytoplankton concentr. 13c', & + & rmissing,38,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'phyto14',3,ncdimst,ncvarid, & - & 7,'molP/kg',27,'Phytoplankton concentr. 14c', & - & rmissing,39,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,7,'phyto14',3,ncdimst,ncvarid, & + & 7,'molP/kg',27,'Phytoplankton concentr. 14c', & + & rmissing,39,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,8,'grazer13',3,ncdimst,ncvarid, & - & 7,'molP/kg',25,'Zooplankton concentr. 13c', & - & rmissing,40,io_stdo_bgc) + & 7,'molP/kg',25,'Zooplankton concentr. 13c', & + & rmissing,40,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & - & 7,'molP/kg',25,'Zooplankton concentr. 14c', & - & rmissing,41,io_stdo_bgc) + & 7,'molP/kg',25,'Zooplankton concentr. 14c', & + & rmissing,41,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,8,'calciu13',3,ncdimst,ncvarid, & - & 7,'molC/kg',19,'Calcium carbonate13', & - & rmissing,42,io_stdo_bgc) + & 7,'molC/kg',19,'Calcium carbonate13', & + & rmissing,42,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & - & 7,'molC/kg',19,'Calcium carbonate14', & - & rmissing,43,io_stdo_bgc) -#endif -#ifdef AGG + & 7,'molC/kg',19,'Calcium carbonate14', & + & rmissing,43,io_stdo_bgc) + end if + if (use_AGG) then CALL NETCDF_DEF_VARDB(ncid,4,'snos',3,ncdimst,ncvarid, & - & 3,'1/g',38,'marine snow aggregates per g sea water', & - & rmissing,44,io_stdo_bgc) + & 3,'1/g',38,'marine snow aggregates per g sea water', & + & rmissing,44,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & - & 4,'g/kg',15,'Aggregated dust', & - & rmissing,45,io_stdo_bgc) -#endif -#ifdef CFC + & 4,'g/kg',15,'Aggregated dust', & + & rmissing,45,io_stdo_bgc) + end if + if (use_CFC) then CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & - & 6,'mol/kg',5,'CFC11', & - & rmissing,47,io_stdo_bgc) + & 6,'mol/kg',5,'CFC11', & + & rmissing,47,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'cfc12',3,ncdimst,ncvarid, & - & 6,'mol/kg',5,'CFC12', & - & rmissing,48,io_stdo_bgc) + & 6,'mol/kg',5,'CFC12', & + & rmissing,48,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & - & 6,'mol/kg',4,'SF-6', & - & rmissing,49,io_stdo_bgc) -#endif -#ifdef natDIC + & 6,'mol/kg',4,'SF-6', & + & rmissing,49,io_stdo_bgc) + end if + if (use_natDIC) then CALL NETCDF_DEF_VARDB(ncid,9,'natsco212',3,ncdimst,ncvarid, & - & 6,'mol/kg',21, 'Natural dissolved CO2',rmissing,50,io_stdo_bgc) + & 6,'mol/kg',21, 'Natural dissolved CO2',rmissing,50,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & - & 6,'mol/kg',18,'Natural alkalinity',rmissing,51,io_stdo_bgc) + & 6,'mol/kg',18,'Natural alkalinity',rmissing,51,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,9,'natcalciu',3,ncdimst,ncvarid, & - & 6,'mol/kg',25,'Natural calcium carbonate', & - & rmissing,52,io_stdo_bgc) -#endif -#ifdef BROMO + & 6,'mol/kg',25,'Natural calcium carbonate', & + & rmissing,52,io_stdo_bgc) + end if + if (use_BROMO) then CALL NETCDF_DEF_VARDB(ncid,5,'bromo',3,ncdimst,ncvarid, & - & 6,'mol/kg',9,'Bromoform',rmissing,47,io_stdo_bgc) -#endif - -! -! Define variables : diagnostic ocean fields -! ---------------------------------------------------------------------- -! - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = nclevid - ncdimst(4) = 0 - ENDIF + & 6,'mol/kg',9,'Bromoform',rmissing,47,io_stdo_bgc) + end if + + ! + ! Define variables : diagnostic ocean fields + ! ---------------------------------------------------------------------- + ! + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = nclevid + ncdimst(4) = 0 + ENDIF - CALL NETCDF_DEF_VARDB(ncid,2,'hi',3,ncdimst,ncvarid, & - & 6,'mol/kg',26,'Hydrogen ion concentration', & - & rmissing,60,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,2,'hi',3,ncdimst,ncvarid, & + & 6,'mol/kg',26,'Hydrogen ion concentration', & + & rmissing,60,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'co3',3,ncdimst,ncvarid, & - & 6,'mol/kg',25,'Dissolved carbonate (CO3)', & - & rmissing,61,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,3,'co3',3,ncdimst,ncvarid, & + & 6,'mol/kg',25,'Dissolved carbonate (CO3)', & + & rmissing,61,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'co2star',3,ncdimst,ncvarid, & - & 6,'mol/kg',20,'Dissolved CO2 (CO2*)', & - & rmissing,62,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,7,'co2star',3,ncdimst,ncvarid, & + & 6,'mol/kg',20,'Dissolved CO2 (CO2*)', & + & rmissing,62,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'satoxy',3,ncdimst,ncvarid, & - & 6,'mol/kg',16 ,'Saturated oxygen', & - & rmissing,63,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'satoxy',3,ncdimst,ncvarid, & + & 6,'mol/kg',16 ,'Saturated oxygen', & + & rmissing,63,io_stdo_bgc) -#ifdef natDIC + if (use_natDIC) then CALL NETCDF_DEF_VARDB(ncid,5,'nathi',3,ncdimst,ncvarid, & - & 6,'mol/kg',34,'Natural hydrogen ion concentration', & - & rmissing,64,io_stdo_bgc) -#endif - + & 6,'mol/kg',34,'Natural hydrogen ion concentration', & + & rmissing,64,io_stdo_bgc) + end if + ! + ! Define variables : sediment + ! ---------------------------------------------------------------------- + ! + if (.not. use_sedbypass) then -! -! Define variables : sediment -! ---------------------------------------------------------------------- -! -#ifndef sedbypass IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = ncks2id - ncdimst(4) = 0 + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = ncks2id + ncdimst(4) = 0 ENDIF CALL NETCDF_DEF_VARDB(ncid,6,'ssso12',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',35,'Sediment accumulated organic carbon', & - & rmissing,70,io_stdo_bgc) + & 9,'kmol/m**3',35,'Sediment accumulated organic carbon', & + & rmissing,70,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',38,'Sediment accumulated calcium carbonate', & - & rmissing,71,io_stdo_bgc) + & 9,'kmol/m**3',38,'Sediment accumulated calcium carbonate', & + & rmissing,71,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'ssssil',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',25,'Sediment accumulated opal', & - & rmissing,72,io_stdo_bgc) + & 9,'kmol/m**3',25,'Sediment accumulated opal', & + & rmissing,72,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & - & 7,'kg/m**3',25,'Sediment accumulated clay', & - & rmissing,73,io_stdo_bgc) + & 7,'kg/m**3',25,'Sediment accumulated clay', & + & rmissing,73,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powaic',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',23,'Sediment pore water CO2', & - & rmissing,74,io_stdo_bgc) + & 9,'kmol/m**3',23,'Sediment pore water CO2', & + & rmissing,74,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',30,'Sediment pore water alkalinity', & - & rmissing,75,io_stdo_bgc) + & 9,'kmol/m**3',30,'Sediment pore water alkalinity', & + & rmissing,75,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powaph',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',29,'Sediment pore water phosphate', & - & rmissing,76,io_stdo_bgc) + & 9,'kmol/m**3',29,'Sediment pore water phosphate', & + & rmissing,76,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',26,'Sediment pore water oxygen', & - & rmissing,77,io_stdo_bgc) + & 9,'kmol/m**3',26,'Sediment pore water oxygen', & + & rmissing,77,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,5,'pown2',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',36,'Sediment pore water gaseous nitrogen', & - & rmissing,78,io_stdo_bgc) + & 9,'kmol/m**3',36,'Sediment pore water gaseous nitrogen', & + & rmissing,78,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powno3',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',33,'Sediment pore water nitrate (NO3)', & - & rmissing,79,io_stdo_bgc) + & 9,'kmol/m**3',33,'Sediment pore water nitrate (NO3)', & + & rmissing,79,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,6,'powasi',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',42,'Sediment pore water silicid acid (Si(OH)4)',& - & rmissing,80,io_stdo_bgc) + & 9,'kmol/m**3',42,'Sediment pore water silicid acid (Si(OH)4)',& + & rmissing,80,io_stdo_bgc) -#ifdef cisonew - CALL NETCDF_DEF_VARDB(ncid,6,'ssso13',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',37,'Sediment accumulated organic carbon13', & - & rmissing,81,io_stdo_bgc) + if (use_cisonew) then + CALL NETCDF_DEF_VARDB(ncid,6,'ssso13',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',37,'Sediment accumulated organic carbon13', & + & rmissing,81,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'ssso14',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',37,'Sediment accumulated organic carbon14', & - & rmissing,82,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'ssso14',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',37,'Sediment accumulated organic carbon14', & + & rmissing,82,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'sssc13',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',40,'Sediment accumulated calcium carbonate13', & - & rmissing,83,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'sssc13',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',40,'Sediment accumulated calcium carbonate13', & + & rmissing,83,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'sssc14',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',40,'Sediment accumulated calcium carbonate14', & - & rmissing,84,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'sssc14',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',40,'Sediment accumulated calcium carbonate14', & + & rmissing,84,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powc13',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',25,'Sediment pore water DIC13', & - & rmissing,85,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'powc13',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',25,'Sediment pore water DIC13', & + & rmissing,85,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powc14',3,ncdimst,ncvarid, & - & 9,'kmol/m**3',25,'Sediment pore water DIC14', & - & rmissing,86,io_stdo_bgc) -#endif + CALL NETCDF_DEF_VARDB(ncid,6,'powc14',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',25,'Sediment pore water DIC14', & + & rmissing,86,io_stdo_bgc) + + CALL NETCDF_DEF_VARDB(ncid,6,'powc14',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',25,'Sediment pore water DIC14', & + & rmasks,86,io_stdo_bgc) + end if IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = ncksid - ncdimst(4) = 0 + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = ncksid + ncdimst(4) = 0 ENDIF CALL NETCDF_DEF_VARDB(ncid,6,'sedhpl',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',34,'Sediment accumulated hydrogen ions', & - & rmissing,87,io_stdo_bgc) - -! -! Define variables : sediment burial -! ---------------------------------------------------------------------- -! + & 9,'kmol/m**2',34,'Sediment accumulated hydrogen ions', & + & rmissing,87,io_stdo_bgc) + ! + ! Define variables : sediment burial + ! ---------------------------------------------------------------------- + ! IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = nctlvl2id - ncdimst(4) = 0 + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = nctlvl2id + ncdimst(4) = 0 ENDIF CALL NETCDF_DEF_VARDB(ncid,7,'bur_o12',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',30,'Burial layer of organic carbon', & - & rmissing,90,io_stdo_bgc) + & 9,'kmol/m**2',30,'Burial layer of organic carbon', & + & rmissing,90,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,7,'bur_c12',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',33,'Burial layer of calcium carbonate', & - & rmissing,91,io_stdo_bgc) + & 9,'kmol/m**2',33,'Burial layer of calcium carbonate', & + & rmissing,91,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,7,'bur_sil',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',20,'Burial layer of opal', & - & rmissing,92,io_stdo_bgc) + & 9,'kmol/m**2',20,'Burial layer of opal', & + & rmissing,92,io_stdo_bgc) CALL NETCDF_DEF_VARDB(ncid,8,'bur_clay',3,ncdimst,ncvarid, & - & 7,'kg/m**2',20,'Burial layer of clay', & - & rmissing,93,io_stdo_bgc) - -#ifdef cisonew - CALL NETCDF_DEF_VARDB(ncid,8,'bur_o13',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',27,'Burial layer of organic 13C', & - & rmissing,94,io_stdo_bgc) - - CALL NETCDF_DEF_VARDB(ncid,8,'bur_o14',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',27,'Burial layer of organic 14C', & - & rmissing,95,io_stdo_bgc) - - CALL NETCDF_DEF_VARDB(ncid,8,'bur_c13',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',23,'Burial layer of Ca13CO3', & - & rmissing,96,io_stdo_bgc) + & 7,'kg/m**2',20,'Burial layer of clay', & + & rmissing,93,io_stdo_bgc) + + if (use_cisonew) then + CALL NETCDF_DEF_VARDB(ncid,8,'bur_o13',3,ncdimst,ncvarid, & + & 9,'kmol/m**2',27,'Burial layer of organic 13C', & + & rmissing,94,io_stdo_bgc) + + CALL NETCDF_DEF_VARDB(ncid,8,'bur_o14',3,ncdimst,ncvarid, & + & 9,'kmol/m**2',27,'Burial layer of organic 14C', & + & rmissing,95,io_stdo_bgc) + + CALL NETCDF_DEF_VARDB(ncid,8,'bur_c13',3,ncdimst,ncvarid, & + & 9,'kmol/m**2',23,'Burial layer of Ca13CO3', & + & rmissing,96,io_stdo_bgc) + + CALL NETCDF_DEF_VARDB(ncid,8,'bur_c14',3,ncdimst,ncvarid, & + & 9,'kmol/m**2',23,'Burial layer of Ca14CO3', & + & rmissing,97,io_stdo_bgc) + end if + + end if ! not sedbypass + ! + ! Define variables: atmosphere + ! ---------------------------------------------------------------------- + ! + if (use_BOXATM) then - CALL NETCDF_DEF_VARDB(ncid,8,'bur_c14',3,ncdimst,ncvarid, & - & 9,'kmol/m**2',23,'Burial layer of Ca14CO3', & - & rmissing,97,io_stdo_bgc) -#endif -#endif /* sedbypass */ + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + ncdimst(1) = nclonid + ncdimst(2) = nclatid + ncdimst(3) = nctlvl2id + ncdimst(4) = 0 + ENDIF -! -! Define variables: atmosphere -! ---------------------------------------------------------------------- -! -#if defined(BOXATM) - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - ncdimst(1) = nclonid - ncdimst(2) = nclatid - ncdimst(3) = nctlvl2id - ncdimst(4) = 0 - ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'atmco2',3,ncdimst,ncvarid, & - & 3,'ppm',15,'atmospheric CO2', & - & rmissing,101,io_stdo_bgc) - + & 3,'ppm',15,'atmospheric CO2', & + & rmissing,101,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & - & 3,'ppm',14,'atmospheric O2', & - & rmissing,102,io_stdo_bgc) - + & 3,'ppm',14,'atmospheric O2', & + & rmissing,102,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,5,'atmn2',3,ncdimst,ncvarid, & - & 3,'ppm',14,'atmospheric N2', & - & rmissing,103,io_stdo_bgc) - -#ifdef cisonew - CALL NETCDF_DEF_VARDB(ncid,6,'atmc13',3,ncdimst,ncvarid, & - & 3,'ppm',17,'atmospheric 13CO2', & - & rmissing,104,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'atmc14',3,ncdimst,ncvarid, & - & 3,'ppm',17,'atmospheric 14CO2', & - & rmissing,105,io_stdo_bgc) -#endif -#ifdef natDIC - CALL NETCDF_DEF_VARDB(ncid,7,'atmnco2',3,ncdimst,ncvarid, & - & 3,'ppm',23,'natural atmospheric CO2', & - & rmissing,106,io_stdo_bgc) -#endif -#endif - IF(mnproc==1 .AND. IOTYPE==0) THEN + & 3,'ppm',14,'atmospheric N2', & + & rmissing,103,io_stdo_bgc) + + if (use_cisonew) then + CALL NETCDF_DEF_VARDB(ncid,6,'atmc13',3,ncdimst,ncvarid, & + & 3,'ppm',17,'atmospheric 13CO2', & + & rmissing,104,io_stdo_bgc) + CALL NETCDF_DEF_VARDB(ncid,6,'atmc14',3,ncdimst,ncvarid, & + & 3,'ppm',17,'atmospheric 14CO2', & + & rmissing,105,io_stdo_bgc) + end if + if (use_natDIC) then + CALL NETCDF_DEF_VARDB(ncid,7,'atmnco2',3,ncdimst,ncvarid, & + & 3,'ppm',23,'natural atmospheric CO2', & + & rmissing,106,io_stdo_bgc) + end if + end if ! if (use_BOXATM) + + IF (mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_ENDDEF(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF00)') - stop '(AUFW: Problem with netCDF00)' + call xchalt('(AUFW: Problem with netCDF00)') + stop '(AUFW: Problem with netCDF00)' ENDIF - -! -! Set fill mode -! ---------------------------------------------------------------------- -! + ! + ! Set fill mode + ! ---------------------------------------------------------------------- + ! ncstat = NF90_SET_FILL(ncid,NF90_NOFILL, ncoldmod) IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF97)') + call xchalt('(AUFW: Problem with netCDF97)') stop '(AUFW: Problem with netCDF97)' ENDIF + ELSE IF (IOTYPE==1) THEN - - ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF ncstat = NFMPI_ENDDEF(ncid) - IF ( ncstat .NE. NF_NOERR ) THEN call xchalt('(AUFW: Problem with PnetCDF00)') stop '(AUFW: Problem with PnetCDF00)' ENDIF #endif - ENDIF -! -! Write restart data : ocean aquateous tracer -!-------------------------------------------------------------------- -! - CALL write_netcdf_var(ncid,'sco212',locetra(1,1,1,isco212),2*kpke,0) - CALL write_netcdf_var(ncid,'alkali',locetra(1,1,1,ialkali),2*kpke,0) - CALL write_netcdf_var(ncid,'phosph',locetra(1,1,1,iphosph),2*kpke,0) - CALL write_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0) - CALL write_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0) - CALL write_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0) - CALL write_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0) - CALL write_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0) - CALL write_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0) - CALL write_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0) - CALL write_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0) - CALL write_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0) - CALL write_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0) - CALL write_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0) - CALL write_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0) - CALL write_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0) - CALL write_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0) - CALL write_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0) - CALL write_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0) - CALL write_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0) - CALL write_netcdf_var(ncid,'prefdic',locetra(1,1,1,iprefdic),2*kpke,0) - CALL write_netcdf_var(ncid,'dicsat',locetra(1,1,1,idicsat),2*kpke,0) -#ifdef cisonew - CALL write_netcdf_var(ncid,'sco213',locetra(1,1,1,isco213),2*kpke,0) - CALL write_netcdf_var(ncid,'sco214',locetra(1,1,1,isco214),2*kpke,0) - CALL write_netcdf_var(ncid,'doc13',locetra(1,1,1,idoc13),2*kpke,0) - CALL write_netcdf_var(ncid,'doc14',locetra(1,1,1,idoc14),2*kpke,0) - CALL write_netcdf_var(ncid,'poc13',locetra(1,1,1,idet13),2*kpke,0) - CALL write_netcdf_var(ncid,'poc14',locetra(1,1,1,idet14),2*kpke,0) - CALL write_netcdf_var(ncid,'phyto13',locetra(1,1,1,iphy13),2*kpke,0) - CALL write_netcdf_var(ncid,'phyto14',locetra(1,1,1,iphy14),2*kpke,0) - CALL write_netcdf_var(ncid,'grazer13',locetra(1,1,1,izoo13),2*kpke,0) - CALL write_netcdf_var(ncid,'grazer14',locetra(1,1,1,izoo14),2*kpke,0) - CALL write_netcdf_var(ncid,'calciu13',locetra(1,1,1,icalc13),2*kpke,0) - CALL write_netcdf_var(ncid,'calciu14',locetra(1,1,1,icalc14),2*kpke,0) -#endif -#ifdef AGG + ENDIF + ! + ! Write restart data : ocean aquateous tracer + !-------------------------------------------------------------------- + ! + CALL write_netcdf_var(ncid,'sco212',locetra(1,1,1,isco212),2*kpke,0) + CALL write_netcdf_var(ncid,'alkali',locetra(1,1,1,ialkali),2*kpke,0) + CALL write_netcdf_var(ncid,'phosph',locetra(1,1,1,iphosph),2*kpke,0) + CALL write_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0) + CALL write_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0) + CALL write_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0) + CALL write_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0) + CALL write_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0) + CALL write_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0) + CALL write_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0) + CALL write_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0) + CALL write_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0) + CALL write_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0) + CALL write_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0) + CALL write_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0) + CALL write_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0) + CALL write_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0) + CALL write_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0) + CALL write_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0) + CALL write_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0) + CALL write_netcdf_var(ncid,'prefdic',locetra(1,1,1,iprefdic),2*kpke,0) + CALL write_netcdf_var(ncid,'dicsat',locetra(1,1,1,idicsat),2*kpke,0) + if (use_cisonew) then + CALL write_netcdf_var(ncid,'sco213' ,locetra(1,1,1,isco213) ,2*kpke,0) + CALL write_netcdf_var(ncid,'sco214' ,locetra(1,1,1,isco214) ,2*kpke,0) + CALL write_netcdf_var(ncid,'doc13' ,locetra(1,1,1,idoc13) ,2*kpke,0) + CALL write_netcdf_var(ncid,'doc14' ,locetra(1,1,1,idoc14) ,2*kpke,0) + CALL write_netcdf_var(ncid,'poc13' ,locetra(1,1,1,idet13) ,2*kpke,0) + CALL write_netcdf_var(ncid,'poc14' ,locetra(1,1,1,idet14) ,2*kpke,0) + CALL write_netcdf_var(ncid,'phyto13' ,locetra(1,1,1,iphy13) ,2*kpke,0) + CALL write_netcdf_var(ncid,'phyto14' ,locetra(1,1,1,iphy14) ,2*kpke,0) + CALL write_netcdf_var(ncid,'grazer13' ,locetra(1,1,1,izoo13) ,2*kpke,0) + CALL write_netcdf_var(ncid,'grazer14' ,locetra(1,1,1,izoo14) ,2*kpke,0) + CALL write_netcdf_var(ncid,'calciu13' ,locetra(1,1,1,icalc13) ,2*kpke,0) + CALL write_netcdf_var(ncid,'calciu14' ,locetra(1,1,1,icalc14) ,2*kpke,0) + end if + if (use_AGG) then CALL write_netcdf_var(ncid,'snos',locetra(1,1,1,inos),2*kpke,0) CALL write_netcdf_var(ncid,'adust',locetra(1,1,1,iadust),2*kpke,0) -#endif /*AGG*/ -#ifdef CFC + end if + if (use_CFC) then CALL write_netcdf_var(ncid,'cfc11',locetra(1,1,1,icfc11),2*kpke,0) CALL write_netcdf_var(ncid,'cfc12',locetra(1,1,1,icfc12),2*kpke,0) CALL write_netcdf_var(ncid,'sf6',locetra(1,1,1,isf6),2*kpke,0) -#endif -#ifdef natDIC + end if + if (use_natDIC) then CALL write_netcdf_var(ncid,'natsco212',locetra(1,1,1,inatsco212),2*kpke,0) CALL write_netcdf_var(ncid,'natalkali',locetra(1,1,1,inatalkali),2*kpke,0) CALL write_netcdf_var(ncid,'natcalciu',locetra(1,1,1,inatcalc),2*kpke,0) -#endif -#ifdef BROMO + end if + if (use_BROMO) then CALL write_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0) -#endif - -! -! Write restart data : diagtnostic ocean fields -! - CALL write_netcdf_var(ncid,'hi',hi(1,1,1),kpke,0) - CALL write_netcdf_var(ncid,'co3',co3(1,1,1),kpke,0) - CALL write_netcdf_var(ncid,'co2star',co2star(1,1,1),kpke,0) - CALL write_netcdf_var(ncid,'satoxy',satoxy(1,1,1),kpke,0) -#ifdef natDIC + end if + + ! + ! Write restart data : diagtnostic ocean fields + ! + CALL write_netcdf_var(ncid,'hi',hi(1,1,1),kpke,0) + CALL write_netcdf_var(ncid,'co3',co3(1,1,1),kpke,0) + CALL write_netcdf_var(ncid,'co2star',co2star(1,1,1),kpke,0) + CALL write_netcdf_var(ncid,'satoxy',satoxy(1,1,1),kpke,0) + if (use_natDIC) then CALL write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) -#endif -! -! Write restart data : sediment variables. -! -#ifndef sedbypass + end if + ! + ! Write restart data : sediment variables. + ! + if (.not. use_sedbypass) then CALL write_netcdf_var(ncid,'ssso12',sedlay2(1,1,1,issso12),2*ks,0) CALL write_netcdf_var(ncid,'sssc12',sedlay2(1,1,1,isssc12),2*ks,0) CALL write_netcdf_var(ncid,'ssssil',sedlay2(1,1,1,issssil),2*ks,0) @@ -912,56 +898,55 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & CALL write_netcdf_var(ncid,'pown2',powtra2(1,1,1,ipown2),2*ks,0) CALL write_netcdf_var(ncid,'powno3',powtra2(1,1,1,ipowno3),2*ks,0) CALL write_netcdf_var(ncid,'powasi',powtra2(1,1,1,ipowasi),2*ks,0) -#ifdef cisonew - CALL write_netcdf_var(ncid,'ssso13',sedlay2(1,1,1,issso13),2*ks,0) - CALL write_netcdf_var(ncid,'ssso14',sedlay2(1,1,1,issso14),2*ks,0) - CALL write_netcdf_var(ncid,'sssc13',sedlay2(1,1,1,isssc13),2*ks,0) - CALL write_netcdf_var(ncid,'sssc14',sedlay2(1,1,1,isssc14),2*ks,0) - CALL write_netcdf_var(ncid,'bur_o13',burial2(1,1,1,issso13),2,0) - CALL write_netcdf_var(ncid,'bur_o14',burial2(1,1,1,issso14),2,0) - CALL write_netcdf_var(ncid,'bur_c13',burial2(1,1,1,isssc13),2,0) - CALL write_netcdf_var(ncid,'bur_c14',burial2(1,1,1,isssc14),2,0) - CALL write_netcdf_var(ncid,'powc13',powtra2(1,1,1,ipowc13),2*ks,0) - CALL write_netcdf_var(ncid,'powc14',powtra2(1,1,1,ipowc14),2*ks,0) -#endif -#endif -! -! Write restart data: atmosphere. -! -#if defined(BOXATM) + if (use_cisonew) then + CALL write_netcdf_var(ncid,'ssso13',sedlay2(1,1,1,issso13),2*ks,0) + CALL write_netcdf_var(ncid,'ssso14',sedlay2(1,1,1,issso14),2*ks,0) + CALL write_netcdf_var(ncid,'sssc13',sedlay2(1,1,1,isssc13),2*ks,0) + CALL write_netcdf_var(ncid,'sssc14',sedlay2(1,1,1,isssc14),2*ks,0) + CALL write_netcdf_var(ncid,'bur_o13',burial2(1,1,1,issso13),2,0) + CALL write_netcdf_var(ncid,'bur_o14',burial2(1,1,1,issso14),2,0) + CALL write_netcdf_var(ncid,'bur_c13',burial2(1,1,1,isssc13),2,0) + CALL write_netcdf_var(ncid,'bur_c14',burial2(1,1,1,isssc14),2,0) + CALL write_netcdf_var(ncid,'powc13',powtra2(1,1,1,ipowc13),2*ks,0) + CALL write_netcdf_var(ncid,'powc14',powtra2(1,1,1,ipowc14),2*ks,0) + end if + end if + ! + ! Write restart data: atmosphere. + ! + if (use_BOXATM) then CALL write_netcdf_var(ncid,'atmco2',atm2(1,1,1,iatmco2),2,0) CALL write_netcdf_var(ncid,'atmo2',atm2(1,1,1,iatmo2),2,0) CALL write_netcdf_var(ncid,'atmn2',atm2(1,1,1,iatmn2),2,0) -#ifdef cisonew - CALL write_netcdf_var(ncid,'atmc13',atm2(1,1,1,iatmc13),2,0) - CALL write_netcdf_var(ncid,'atmc14',atm2(1,1,1,iatmc14),2,0) -#endif -#ifdef natDIC - CALL write_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0) -#endif -#endif - - - IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = NF90_CLOSE(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: netCDF200)') - stop '(AUFW: netCDF200)' - ENDIF - ELSE IF(IOTYPE==1) THEN + if (use_cisonew) then + CALL write_netcdf_var(ncid,'atmc13',atm2(1,1,1,iatmc13),2,0) + CALL write_netcdf_var(ncid,'atmc14',atm2(1,1,1,iatmc14),2,0) + end if + if (use_natDIC) then + CALL write_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0) + end if + end if + + IF(mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_CLOSE(ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: netCDF200)') + stop '(AUFW: netCDF200)' + ENDIF + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat = NFMPI_CLOSE(ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: PnetCDF200)') - stop '(AUFW: PnetCDF200)' - ENDIF -#endif + ncstat = NFMPI_CLOSE(ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: PnetCDF200)') + stop '(AUFW: PnetCDF200)' ENDIF +#endif + ENDIF - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' WRITE(io_stdo_bgc,*) '***************' - ENDIF + ENDIF - RETURN - END + RETURN + END SUBROUTINE AUFW_BGC diff --git a/hamocc/beleg_vars.F90 b/hamocc/beleg_vars.F90 index e897d73f..f531dfca 100644 --- a/hamocc/beleg_vars.F90 +++ b/hamocc/beleg_vars.F90 @@ -54,39 +54,18 @@ SUBROUTINE BELEG_VARS(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask, & use mo_carbch, only: co2star,co3,hi,ocetra use mo_biomod, only: fesoly - use mo_control_bgc, only: rmasks + use mo_control_bgc, only: rmasks,use_FB_BGC_OCE, use_cisonew, use_AGG, use_CFC, use_natDIC, use_BROMO, use_sedbypass use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idicsat,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy, & - & iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo + iprefalk,iprefdic,iprefo2,iprefpo4,isco212,isilica,izoo, & + iadust,inos,ibromo,icfc11,icfc12,isf6, & + icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv, & + inatcalc, & + ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster,ks,nsedtra, & + ipowc13,ipowc13,issso13,issso13,isssc13,ipowc14,isssc14,issso14 use mo_vgrid, only: kmle,kbo - -#ifdef AGG - use mo_biomod, only: cellmass,fractdim - use mo_param1_bgc, only: iadust,inos -#endif -#ifdef BROMO - use mo_param1_bgc, only: ibromo -#endif -#ifdef CFC - use mo_param1_bgc, only: icfc11,icfc12,isf6 -#endif -#ifdef cisonew - use mo_biomod, only: bifr13,bifr14,c14fac,re1312,re14to - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv -#ifndef sedbypass - use mo_param1_bgc, only: ipowc13,ipowc14,issso13,issso14,isssc13,isssc14 -#endif -#endif -#ifdef natDIC - use mo_param1_bgc, only: inatcalc + use mo_biomod, only: cellmass,fractdim,bifr13,bifr14,c14fac,re1312,re14to,abs_oce use mo_carbch, only: nathi,natco3 -#endif -#ifndef sedbypass - use mo_param1_bgc, only: ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isssc12,issso12,issssil,issster,ks,nsedtra use mo_sedmnt, only: sedhpl,burial,powtra,sedlay -#endif -#ifdef FB_BGC_OCE - use mo_biomod, only: abs_oce -#endif implicit none @@ -99,24 +78,18 @@ SUBROUTINE BELEG_VARS(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask, & ! local variables INTEGER :: i,j,k,l -#ifdef cisonew - REAL :: rco213,rco214,beta13,beta14 -#endif -#ifdef AGG - REAL :: snow -#endif - - -#ifdef FB_BGC_OCE - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - abs_oce(i,j,k)=1. - ENDDO - ENDDO - ENDDO -#endif + REAL :: rco213,rco214,beta13,beta14 ! cisonew + REAL :: snow ! AGG + if (use_FB_BGC_OCE) then + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + abs_oce(i,j,k)=1. + ENDDO + ENDDO + ENDDO + end if ! ! Initialisation of ocean tracers and sediment ! @@ -141,18 +114,18 @@ SUBROUTINE BELEG_VARS(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask, & ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)/prho(i,j,k) ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3) /prho(i,j,k) ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)/prho(i,j,k) -#ifdef cisonew - ! d13C based on Eide data is read in above (profile_gd) - ! Convert to 13C using model initial (ie GLODAP) total C - ! If restarting, this is redone with model total C from restart in aufr_bgc.F90 - beta13=ocetra(i,j,k,isco213)/1000.+1. - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco212)*beta13*re1312/(1.+beta13*re1312) + if (use_cisonew) then + ! d13C based on Eide data is read in above (profile_gd) + ! Convert to 13C using model initial (ie GLODAP) total C + ! If restarting, this is redone with model total C from restart in aufr_bgc.F90 + beta13=ocetra(i,j,k,isco213)/1000.+1. + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco212)*beta13*re1312/(1.+beta13*re1312) - ! 14C is read in as small delta14C (calculated from R. Key, 2003 and Eide et al. 2017) - ! Convert to 14C using model total C, and normalize by c14fac to prevent numerical errors - beta14=ocetra(i,j,k,isco214)/1000.+1. - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco212)*beta14*re14to/c14fac -#endif + ! 14C is read in as small delta14C (calculated from R. Key, 2003 and Eide et al. 2017) + ! Convert to 14C using model total C, and normalize by c14fac to prevent numerical errors + beta14=ocetra(i,j,k,isco214)/1000.+1. + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco212)*beta14*re14to/c14fac + end if ENDIF ENDDO ENDDO @@ -182,40 +155,40 @@ SUBROUTINE BELEG_VARS(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask, & hi(i,j,k) =1.e-8 co3(i,j,k) =0. co2star(i,j,k) =20.e-6 -#ifdef AGG -! calculate initial numbers from mass, to start with appropriate size distribution - snow = (ocetra(i,j,k,iphy)+ocetra(i,j,k,idet))*1.e+6 - ocetra(i,j,k,inos) = snow / cellmass / (FractDim+1.) - ocetra(i,j,k,iadust) =0. -#endif /*AGG*/ -#ifdef CFC - ocetra(i,j,k,icfc11) =0. - ocetra(i,j,k,icfc12) =0. - ocetra(i,j,k,isf6) =0. -#endif -#ifdef natDIC - nathi(i,j,k) =1.e-8 - natco3(i,j,k) =0. - ocetra(i,j,k,inatcalc) =0. -#endif -#ifdef cisonew - rco213=ocetra(i,j,k,isco213)/(ocetra(i,j,k,isco212)+safediv) - rco214=ocetra(i,j,k,isco214)/(ocetra(i,j,k,isco212)+safediv) - ocetra(i,j,k,iphy13) =ocetra(i,j,k,iphy)*rco213*bifr13 - ocetra(i,j,k,iphy14) =ocetra(i,j,k,iphy)*rco214*bifr14 - ocetra(i,j,k,izoo13) =ocetra(i,j,k,izoo)*rco213*bifr13 - ocetra(i,j,k,izoo14) =ocetra(i,j,k,izoo)*rco214*bifr14 - ocetra(i,j,k,idoc13) =ocetra(i,j,k,idoc)*rco213*bifr13 - ocetra(i,j,k,idoc14) =ocetra(i,j,k,idoc)*rco214*bifr14 - ocetra(i,j,k,idet13) =ocetra(i,j,k,idet)*rco213*bifr13 - ocetra(i,j,k,idet14) =ocetra(i,j,k,idet)*rco214*bifr14 - ocetra(i,j,k,icalc13)=ocetra(i,j,k,icalc)*rco213 - ocetra(i,j,k,icalc14)=ocetra(i,j,k,icalc)*rco214 -#endif -#ifdef BROMO -! Initialise to 0,01 pmol L-1 (Stemmler et al., 2015) => mol/kg - ocetra(i,j,k,ibromo)= 1.e-14/prho(i,j,k) -#endif + if (use_AGG) then + ! calculate initial numbers from mass, to start with appropriate size distribution + snow = (ocetra(i,j,k,iphy)+ocetra(i,j,k,idet))*1.e+6 + ocetra(i,j,k,inos) = snow / cellmass / (FractDim+1.) + ocetra(i,j,k,iadust) =0. + end if + if (use_CFC) then + ocetra(i,j,k,icfc11) =0. + ocetra(i,j,k,icfc12) =0. + ocetra(i,j,k,isf6) =0. + end if + if (use_natDIC) then + nathi(i,j,k) =1.e-8 + natco3(i,j,k) =0. + ocetra(i,j,k,inatcalc) =0. + end if + if (use_cisonew) then + rco213=ocetra(i,j,k,isco213)/(ocetra(i,j,k,isco212)+safediv) + rco214=ocetra(i,j,k,isco214)/(ocetra(i,j,k,isco212)+safediv) + ocetra(i,j,k,iphy13) =ocetra(i,j,k,iphy)*rco213*bifr13 + ocetra(i,j,k,iphy14) =ocetra(i,j,k,iphy)*rco214*bifr14 + ocetra(i,j,k,izoo13) =ocetra(i,j,k,izoo)*rco213*bifr13 + ocetra(i,j,k,izoo14) =ocetra(i,j,k,izoo)*rco214*bifr14 + ocetra(i,j,k,idoc13) =ocetra(i,j,k,idoc)*rco213*bifr13 + ocetra(i,j,k,idoc14) =ocetra(i,j,k,idoc)*rco214*bifr14 + ocetra(i,j,k,idet13) =ocetra(i,j,k,idet)*rco213*bifr13 + ocetra(i,j,k,idet14) =ocetra(i,j,k,idet)*rco214*bifr14 + ocetra(i,j,k,icalc13)=ocetra(i,j,k,icalc)*rco213 + ocetra(i,j,k,icalc14)=ocetra(i,j,k,icalc)*rco214 + end if + if (use_BROMO) then + ! Initialise to 0,01 pmol L-1 (Stemmler et al., 2015) => mol/kg + ocetra(i,j,k,ibromo)= 1.e-14/prho(i,j,k) + end if ENDIF ! omask > 0.5 ENDDO ENDDO @@ -236,69 +209,69 @@ SUBROUTINE BELEG_VARS(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask, & ! Initial values for sediment -#ifndef sedbypass - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - powtra(i,j,k,ipowaic)=ocetra(i,j,kbo(i,j),isco212) - powtra(i,j,k,ipowaal)=ocetra(i,j,kbo(i,j),ialkali) - powtra(i,j,k,ipowaph)=ocetra(i,j,kbo(i,j),iphosph) - powtra(i,j,k,ipowaox)=ocetra(i,j,kbo(i,j),ioxygen) - powtra(i,j,k,ipown2) =0. - powtra(i,j,k,ipowno3)=ocetra(i,j,kbo(i,j),iano3) - powtra(i,j,k,ipowasi)=ocetra(i,j,kbo(i,j),isilica) - sedlay(i,j,k,issso12)=1.e-8 - sedlay(i,j,k,isssc12)=1.e-8 - sedlay(i,j,k,issster)=30. - sedlay(i,j,k,issssil)=1.e-8 - sedhpl(i,j,k) =hi(i,j,kbo(i,j)) -#ifdef cisonew - rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) - powtra(i,j,k,ipowc13)=powtra(i,j,k,ipowaic)*rco213*bifr13 - powtra(i,j,k,ipowc14)=powtra(i,j,k,ipowaic)*rco214*bifr14 - sedlay(i,j,k,issso13)=sedlay(i,j,k,issso12)*rco213*bifr13 - sedlay(i,j,k,issso14)=sedlay(i,j,k,issso12)*rco214*bifr14 - sedlay(i,j,k,isssc13)=sedlay(i,j,k,isssc12)*rco213 - sedlay(i,j,k,isssc14)=sedlay(i,j,k,isssc12)*rco214 -#endif - ELSE - powtra(i,j,k,ipowno3)=rmasks - powtra(i,j,k,ipown2) =rmasks - powtra(i,j,k,ipowaic)=rmasks - powtra(i,j,k,ipowaal)=rmasks - powtra(i,j,k,ipowaph)=rmasks - powtra(i,j,k,ipowaox)=rmasks - powtra(i,j,k,ipowasi)=rmasks - sedlay(i,j,k,issso12)=rmasks - sedlay(i,j,k,isssc12)=rmasks - sedlay(i,j,k,issssil)=rmasks - sedlay(i,j,k,issster)=rmasks - sedlay(i,j,k,issssil)=rmasks - sedhpl(i,j,k) =rmasks -#ifdef cisonew - powtra(i,j,k,ipowc13)=rmasks - powtra(i,j,k,ipowc14)=rmasks - sedlay(i,j,k,issso13)=rmasks - sedlay(i,j,k,issso14)=rmasks - sedlay(i,j,k,isssc13)=rmasks - sedlay(i,j,k,isssc14)=rmasks -#endif - ENDIF - ENDDO - ENDDO - ENDDO + if (.not. use_sedbypass) then + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + powtra(i,j,k,ipowaic)=ocetra(i,j,kbo(i,j),isco212) + powtra(i,j,k,ipowaal)=ocetra(i,j,kbo(i,j),ialkali) + powtra(i,j,k,ipowaph)=ocetra(i,j,kbo(i,j),iphosph) + powtra(i,j,k,ipowaox)=ocetra(i,j,kbo(i,j),ioxygen) + powtra(i,j,k,ipown2) =0. + powtra(i,j,k,ipowno3)=ocetra(i,j,kbo(i,j),iano3) + powtra(i,j,k,ipowasi)=ocetra(i,j,kbo(i,j),isilica) + sedlay(i,j,k,issso12)=1.e-8 + sedlay(i,j,k,isssc12)=1.e-8 + sedlay(i,j,k,issster)=30. + sedlay(i,j,k,issssil)=1.e-8 + sedhpl(i,j,k) =hi(i,j,kbo(i,j)) + if (use_cisonew) then + rco213=ocetra(i,j,kbo(i,j),isco213)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + rco214=ocetra(i,j,kbo(i,j),isco214)/(ocetra(i,j,kbo(i,j),isco212)+safediv) + powtra(i,j,k,ipowc13)=powtra(i,j,k,ipowaic)*rco213*bifr13 + powtra(i,j,k,ipowc14)=powtra(i,j,k,ipowaic)*rco214*bifr14 + sedlay(i,j,k,issso13)=sedlay(i,j,k,issso12)*rco213*bifr13 + sedlay(i,j,k,issso14)=sedlay(i,j,k,issso12)*rco214*bifr14 + sedlay(i,j,k,isssc13)=sedlay(i,j,k,isssc12)*rco213 + sedlay(i,j,k,isssc14)=sedlay(i,j,k,isssc12)*rco214 + end if + ELSE + powtra(i,j,k,ipowno3)=rmasks + powtra(i,j,k,ipown2) =rmasks + powtra(i,j,k,ipowaic)=rmasks + powtra(i,j,k,ipowaal)=rmasks + powtra(i,j,k,ipowaph)=rmasks + powtra(i,j,k,ipowaox)=rmasks + powtra(i,j,k,ipowasi)=rmasks + sedlay(i,j,k,issso12)=rmasks + sedlay(i,j,k,isssc12)=rmasks + sedlay(i,j,k,issssil)=rmasks + sedlay(i,j,k,issster)=rmasks + sedlay(i,j,k,issssil)=rmasks + sedhpl(i,j,k) =rmasks + if (use_cisonew) then + powtra(i,j,k,ipowc13)=rmasks + powtra(i,j,k,ipowc14)=rmasks + sedlay(i,j,k,issso13)=rmasks + sedlay(i,j,k,issso14)=rmasks + sedlay(i,j,k,isssc13)=rmasks + sedlay(i,j,k,isssc14)=rmasks + end if + ENDIF + ENDDO + ENDDO + ENDDO - ! last and final sediment layer - DO l=1,nsedtra - DO j=1,kpje - DO i=1,kpie - burial(i,j,l)=0. - ENDDO - ENDDO - ENDDO -#endif + ! last and final sediment layer + DO l=1,nsedtra + DO j=1,kpje + DO i=1,kpie + burial(i,j,l)=0. + ENDDO + ENDDO + ENDDO + end if return !****************************************************************************** diff --git a/hamocc/carchm.F90 b/hamocc/carchm.F90 index b86cce9a..f5da6bbd 100644 --- a/hamocc/carchm.F90 +++ b/hamocc/carchm.F90 @@ -21,6 +21,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & pdlxp,pdlyp,pddpo,prho,pglat,omask, & psicomo,ppao,pfu10,ptho,psao) + !****************************************************************************** ! !**** *CARCHM* - . @@ -97,31 +98,20 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & use mo_carbch, only: atm,atmflx,co2fxd,co2fxu,co2star,co3,hi,keqb,kwco2sol,ocetra,omegaa,omegac,pco2d,satn2o,satoxy, & pco2m,kwco2d,co2sold,co2solm use mo_chemcon, only: al1,al2,al3,al4,an0,an1,an2,an3,an4,an5,an6,atn2o,bl1,bl2,bl3,calcon,ox0,ox1,ox2,ox3,ox4,ox5,ox6, & - & oxyco,tzero - use mo_control_bgc, only: dtbgc + oxyco,tzero + use mo_control_bgc, only: dtbgc,use_cisonew,use_natDIC,use_CFC,use_BROMO,use_cisonew,use_sedbypass use mo_param1_bgc, only: ialkali,iatmo2,iatmco2,iatmdms,iatmn2,iatmn2o,ian2o,icalc,idicsat,idms,igasnit,ioxygen,iphosph, & - & isco212,isilica + isco212,isilica, & + iatmf11,iatmf12,iatmsf6,icfc11,icfc12,isf6, & + iatmc13,iatmc14,icalc13,icalc14,idet14,idoc14,iphy14,isco213,isco214,izoo14,safediv, & + iatmnco2,inatalkali,inatcalc,inatsco212, & + ks,issso14,isssc14,ipowc14, & + iatmbromo,ibromo use mo_vgrid, only: dp_min,kmle,kbo,ptiestu - -#ifdef BROMO - use mo_param1_bgc, only: iatmbromo,ibromo -#endif -#ifdef CFC - use mo_carbch, only: atm_cfc11_nh,atm_cfc11_sh,atm_cfc12_nh,atm_cfc12_sh,atm_sf6_nh,atm_sf6_sh - use mo_param1_bgc, only: iatmf11,iatmf12,iatmsf6,icfc11,icfc12,isf6 -#endif -#ifdef cisonew - use mo_carbch, only: co213fxd,co213fxu,co214fxd,co214fxu,c14dec - use mo_param1_bgc, only: iatmc13,iatmc14,icalc13,icalc14,idet14,idoc14,iphy14,isco213,isco214,izoo14,safediv -#ifndef sedbypass - use mo_param1_bgc, only: ks,issso14,isssc14,ipowc14 + use mo_carbch, only: atm_cfc11_nh,atm_cfc11_sh,atm_cfc12_nh,atm_cfc12_sh,atm_sf6_nh,atm_sf6_sh, & + co213fxd,co213fxu,co214fxd,co214fxu,c14dec, & + atm_co2_nat,nathi,natco3,natpco2d,natomegaa,natomegac use mo_sedmnt, only: sedlay,powtra,burial -#endif -#endif -#ifdef natDIC - use mo_carbch, only: atm_co2_nat,nathi,natco3,natpco2d,natomegaa,natomegac - use mo_param1_bgc, only: iatmnco2,inatalkali,inatcalc,inatsco212 -#endif implicit none @@ -141,7 +131,6 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Local variables INTEGER :: i,j,k,l,js INTEGER, parameter :: niter=20 - REAL :: supsat, undsa, dissol REAL :: rpp0,fluxd,fluxu REAL :: kwco2,kwo2,kwn2,kwdms,kwn2o @@ -154,37 +143,29 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & REAL :: Kh,Khd,K1,K2,Kb,K1p,K2p,K3p,Ksi,Kw,Ks1,Kf,Kspc,Kspa REAL :: tc,ta,sit,pt,ah1,ac,cu,cb,cc,tc_sat REAL :: omega -#ifdef CFC - REAL :: atm_cfc11,atm_cfc12,atm_sf6,fact - REAL :: sch_11,sch_12,sch_sf,kw_11,kw_12,kw_sf - REAL :: flx11,flx12,flxsf,a_11,a_12,a_sf -#endif -#ifdef natDIC - REAL :: natcu,natcb,natcc - REAL :: natpco2,natfluxd,natfluxu,natomega - REAL :: natsupsat,natundsa,natdissol -#endif -#ifdef cisonew - REAL :: rco213,rco214 - REAL :: dissol13,dissol14 - REAL :: flux14d,flux14u,flux13d,flux13u - REAL :: atco213,atco214,pco213,pco214 - REAL :: frac_k,frac_aqg,frac_dicg -#endif -#ifdef BROMO - REAL :: flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub -#endif + REAL :: atm_cfc11,atm_cfc12,atm_sf6,fact ! CFC + REAL :: sch_11,sch_12,sch_sf,kw_11,kw_12,kw_sf ! CFC + REAL :: flx11,flx12,flxsf,a_11,a_12,a_sf ! CFC + REAL :: natcu,natcb,natcc ! natDIC + REAL :: natpco2,natfluxd,natfluxu,natomega ! natDIC + REAL :: natsupsat,natundsa,natdissol ! natDIC + REAL :: rco213,rco214 ! cisonew + REAL :: dissol13,dissol14 ! cisonew + REAL :: flux14d,flux14u,flux13d,flux13u ! cisonew + REAL :: atco213,atco214,pco213,pco214 ! cisonew + REAL :: frac_k,frac_aqg,frac_dicg ! cisonew + REAL :: flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub ! BROMO ! set variables for diagnostic output to zero atmflx (:,:,:)=0. co2fxd (:,:)=0. co2fxu (:,:)=0. -#ifdef cisonew - co213fxd (:,:)=0. - co213fxu (:,:)=0. - co214fxd (:,:)=0. - co214fxu (:,:)=0. -#endif + if (use_cisonew) then + co213fxd (:,:)=0. + co213fxu (:,:)=0. + co214fxd (:,:)=0. + co214fxu (:,:)=0. + end if pco2d (:,:)=0. pco2m (:,:)=0. kwco2d (:,:)=0. @@ -196,33 +177,25 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & satoxy (:,:,:)=0. omegaA (:,:,:)=0. omegaC (:,:,:)=0. -#ifdef natDIC - natpco2d (:,:)=0. - natco3 (:,:,:)=0. - natomegaA(:,:,:)=0. - natomegaC(:,:,:)=0. -#endif + if (use_natDIC) then + natpco2d (:,:)=0. + natco3 (:,:,:)=0. + natomegaA(:,:,:)=0. + natomegaC(:,:,:)=0. + end if !$OMP PARALLEL DO PRIVATE(t,t2,t3,t4,tk,tk100,s,rs,prb,Kh,Khd,K1,K2 & !$OMP ,Kb,K1p,K2p,K3p,Ksi,Kw,Ks1,Kf,Kspc,Kspa,tc,ta,sit,pt,ah1,ac & !$OMP ,cu,cb,cc,pco2,rpp0,scco2,scdms,sco2,oxy,ani,anisa,Xconvxa & !$OMP ,kwco2,kwdms,kwo2,atco2,ato2,atn2,fluxd,fluxu,oxflux,tc_sat & !$OMP ,niflux,n2oflux,dmsflux,omega,supsat,undsa,dissol & -#ifdef CFC !$OMP ,sch_11,sch_12,sch_sf,kw_11,kw_12,kw_sf,a_11,a_12,a_sf,flx11 & !$OMP ,flx12,flxsf,atm_cfc11,atm_cfc12,atm_sf6 & -#endif -#ifdef natDIC !$OMP ,natcu,natcb,natcc,natpco2,natfluxd,natfluxu,natomega & !$OMP ,natsupsat,natundsa,natdissol & -#endif -#ifdef cisonew !$OMP ,atco213,atco214,rco213,rco214,pco213,pco214,frac_aqg & !$OMP ,frac_dicg,flux13d,flux13u,flux14d,flux14u,dissol13,dissol14 & -#endif -#ifdef BROMO !$OMP ,flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub & -#endif !$OMP ,j,i) DO k=1,kpke DO j=1,kpje @@ -267,25 +240,25 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Carbonate ion concentration, convert from mol/kg to kmol/m^3 co3(i,j,k) = cc * rrho -#ifdef natDIC - tc = ocetra(i,j,k,inatsco212) / rrho ! convert to mol/kg - ta = ocetra(i,j,k,inatalkali) / rrho - ah1 = nathi(i,j,k) + if (use_natDIC) then + tc = ocetra(i,j,k,inatsco212) / rrho ! convert to mol/kg + ta = ocetra(i,j,k,inatalkali) / rrho + ah1 = nathi(i,j,k) - CALL CARCHM_SOLVE(s,tc,ta,sit,pt,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - ah1,ac,niter) + CALL CARCHM_SOLVE(s,tc,ta,sit,pt,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + ah1,ac,niter) - if(ah1.gt.0.) then - nathi(i,j,k)=max(1.e-20,ah1) - endif + if(ah1.gt.0.) then + nathi(i,j,k)=max(1.e-20,ah1) + endif -! Determine natural CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) - natcu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) - natcb = K1 * natcu / ah1 - natcc = K2 * natcb / ah1 -! Natural carbonate ion concentration, convert from mol/kg to kmol/m^3 - natco3(i,j,k) = natcc * rrho -#endif + ! Determine natural CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) + natcu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) + natcb = K1 * natcu / ah1 + natcc = K2 * natcb / ah1 + ! Natural carbonate ion concentration, convert from mol/kg to kmol/m^3 + natco3(i,j,k) = natcc * rrho + end if ! solubility of O2 (Weiss, R.F. 1970, Deep-Sea Res., 17, 721-735) for moist air ! at 1 atm; multiplication with oxyco converts to kmol/m^3/atm @@ -296,9 +269,9 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Determine CO2 pressure and fugacity (in micoatm) ! NOTE: equation below for pCO2 needs requires CO2 in mol/kg pco2 = cu * 1.e6 / Kh -#ifdef natDIC - natpco2 = natcu * 1.e6 / Kh -#endif + if (use_natDIC) then + natpco2 = natcu * 1.e6 / Kh + end if ! Schmidt numbers according to Wanninkhof (2014), Table 1 @@ -307,16 +280,16 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & scn2 = 2304.8 - 162.75*t + 6.2557*t2 - 0.13129 *t3 + 0.0011255 *t4 scdms = 2855.7 - 177.63*t + 6.0438*t2 - 0.11645 *t3 + 0.00094743*t4 scn2o = 2356.2 - 166.38*t + 6.3952*t2 - 0.13422 *t3 + 0.0011506 *t4 -#ifdef CFC - sch_11= 3579.2 - 222.63*t + 7.5749*t2 - 0.14595 *t3 + 0.0011874 *t4 - sch_12= 3828.1 - 249.86*t + 8.7603*t2 - 0.1716 *t3 + 0.001408 *t4 - sch_sf= 3177.5 - 200.57*t + 6.8865*t2 - 0.13335 *t3 + 0.0010877 *t4 -#endif -#ifdef BROMO -! Stemmler et al. (2015; Biogeosciences) Eq. (9); Quack and Wallace -! (2003; GBC) - sch_bromo= 4662.8 - 319.45*t + 9.9012*t2 - 0.1159*t3 -#endif + if (use_CFC) then + sch_11= 3579.2 - 222.63*t + 7.5749*t2 - 0.14595 *t3 + 0.0011874 *t4 + sch_12= 3828.1 - 249.86*t + 8.7603*t2 - 0.1716 *t3 + 0.001408 *t4 + sch_sf= 3177.5 - 200.57*t + 6.8865*t2 - 0.13335 *t3 + 0.0010877 *t4 + end if + if (use_BROMO) then + ! Stemmler et al. (2015; Biogeosciences) Eq. (9); Quack and Wallace + ! (2003; GBC) + sch_bromo= 4662.8 - 319.45*t + 9.9012*t2 - 0.1159*t3 + end if ! solubility of N2 (Weiss, R.F. 1970, Deep-Sea Res., 17, 721-735) for moist air ! at 1 atm; multiplication with oxyco converts to kmol/m^3/atm @@ -328,27 +301,27 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & rs=al1+al2/tk100+al3*log(tk100)+al4*tk100**2+s*(bl1+bl2*tk100+bl3*tk100**2) satn2o(i,j)=exp(rs) -#ifdef CFC + if (use_CFC) then ! solubility of cfc11,12 (mol/(l*atm)) (Warner and Weiss 1985) and ! sf6 from eq. 6 of Bullister et al. (2002) ! These are the alpha in (1b) of the ocmpic2 howto - a_11 = exp(-229.9261 + 319.6552*(100/tk) + 119.4471*log(tk100) & - & -1.39165*(tk100)**2 + s*(-0.142382 + 0.091459*(tk100) & - & -0.0157274*(tk100)**2)) - a_12 = exp(-218.0971 + 298.9702*(100/tk) + 113.8049*log(tk100) & - & -1.39165*(tk100)**2 + s*(-0.143566 + 0.091015*(tk100) & - & -0.0153924*(tk100)**2)) - a_sf = exp(-80.0343 + 117.232 *(100/tk) + 29.5817*log(tk100) & - & +s*(0.033518-0.0373942*(tk100)+0.00774862*(tk100)**2)) -! conversion from mol/(l * atm) to kmol/(m3 * pptv) - a_11 = 1e-12 * a_11 - a_12 = 1e-12 * a_12 - a_sf = 1e-12 * a_sf -#endif -#ifdef BROMO + a_11 = exp(-229.9261 + 319.6552*(100/tk) + 119.4471*log(tk100) & + & -1.39165*(tk100)**2 + s*(-0.142382 + 0.091459*(tk100) & + & -0.0157274*(tk100)**2)) + a_12 = exp(-218.0971 + 298.9702*(100/tk) + 113.8049*log(tk100) & + & -1.39165*(tk100)**2 + s*(-0.143566 + 0.091015*(tk100) & + & -0.0153924*(tk100)**2)) + a_sf = exp(-80.0343 + 117.232 *(100/tk) + 29.5817*log(tk100) & + & +s*(0.033518-0.0373942*(tk100)+0.00774862*(tk100)**2)) + ! conversion from mol/(l * atm) to kmol/(m3 * pptv) + a_11 = 1e-12 * a_11 + a_12 = 1e-12 * a_12 + a_sf = 1e-12 * a_sf + end if + if (use_BROMO) then !Henry's law constant [dimensionless] for Bromoform from Quack and Wallace (2003; GBC) - a_bromo = exp(13.16 - 4973*(1/tk)) -#endif + a_bromo = exp(13.16 - 4973*(1/tk)) + end if ! Transfer (piston) velocity kw according to Wanninkhof (2014), in units of ms-1 Xconvxa = 6.97e-07 ! Wanninkhof's a=0.251 converted from [cm hr-1]/[m s-1]^2 to [ms-1]/[m s-1]^2 @@ -357,28 +330,28 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & kwn2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scn2)**0.5 kwdms = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scdms)**0.5 kwn2o = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scn2o)**0.5 -#ifdef CFC - kw_11 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_11)**0.5 - kw_12 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_12)**0.5 - kw_sf = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_sf)**0.5 -#endif -#ifdef BROMO + if (use_CFC) then + kw_11 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_11)**0.5 + kw_12 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_12)**0.5 + kw_sf = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sch_sf)**0.5 + end if + if (use_BROMO) then ! Stemmler et al. (2015; Biogeosciences) Eq. (8) ! 1.e-2/3600 = conversion from [cm hr-1]/[m s-1]^2 to [ms-1]/[m s-1]^2 - kw_bromo=(1.-psicomo(i,j)) * 1.e-2/3600. * & - & (0.222*pfu10(i,j)**2+0.33*pfu10(i,j))*(660./sch_bromo)**0.5 -#endif + kw_bromo=(1.-psicomo(i,j)) * 1.e-2/3600. * & + & (0.222*pfu10(i,j)**2+0.33*pfu10(i,j))*(660./sch_bromo)**0.5 + end if atco2 = atm(i,j,iatmco2) ato2 = atm(i,j,iatmo2) atn2 = atm(i,j,iatmn2) -#ifdef cisonew - atco213 = atm(i,j,iatmc13) - atco214 = atm(i,j,iatmc14) -#endif -#ifdef BROMO - atbrf = atm(i,j,iatmbromo) -#endif + if (use_cisonew) then + atco213 = atm(i,j,iatmc13) + atco214 = atm(i,j,iatmc14) + end if + if (use_BROMO) then + atbrf = atm(i,j,iatmbromo) + end if ! Ratio P/P_0, where P is the local SLP and P_0 is standard pressure (1 atm). This is ! used in all surface flux calculations where atmospheric concentration is given as a @@ -389,11 +362,11 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & fluxu=pco2 *kwco2*dtbgc*Kh*1e-6*rrho ! to get fluxes in kmol/m^2 !JT set limit for CO2 outgassing to avoid negative DIC concentration, set minimum DIC concentration to 1e-5 kmol/m3 fluxu=min(fluxu,fluxd-(1e-5 - ocetra(i,j,k,isco212))*pddpo(i,j,1)) -#ifdef natDIC - natfluxd=atm_co2_nat*rpp0*kwco2*dtbgc*Kh*1e-6*rrho - natfluxu=natpco2 *kwco2*dtbgc*Kh*1e-6*rrho - natfluxu=min(natfluxu,natfluxd-(1e-5 - ocetra(i,j,k,inatsco212))*pddpo(i,j,1)) -#endif + if (use_natDIC) then + natfluxd=atm_co2_nat*rpp0*kwco2*dtbgc*Kh*1e-6*rrho + natfluxu=natpco2 *kwco2*dtbgc*Kh*1e-6*rrho + natfluxu=min(natfluxu,natfluxd-(1e-5 - ocetra(i,j,k,inatsco212))*pddpo(i,j,1)) + end if ! Calculate saturation DIC concentration in mixed layer ta = ocetra(i,j,k,ialkali) / rrho @@ -401,33 +374,33 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & Ksi,K1p,K2p,K3p,tc_sat,niter) ocetra(i,j,1:kmle(i,j),idicsat) = tc_sat * rrho ! convert mol/kg to kmlo/m^3 -#ifdef cisonew + if (use_cisonew ) then ! Ocean-Atmosphere fluxes for carbon isotopes - rco213=ocetra(i,j,1,isco213)/(ocetra(i,j,1,isco212)+safediv) ! Fraction DIC13 over total DIC - rco214=ocetra(i,j,1,isco214)/(ocetra(i,j,1,isco212)+safediv) ! Fraction DIC14 over total DIC + rco213=ocetra(i,j,1,isco213)/(ocetra(i,j,1,isco212)+safediv) ! Fraction DIC13 over total DIC + rco214=ocetra(i,j,1,isco214)/(ocetra(i,j,1,isco212)+safediv) ! Fraction DIC14 over total DIC - pco213 = pco2 * rco213 ! Determine water CO213 pressure and fugacity (microatm) - pco214 = pco2 * rco214 ! Determine water CO214 pressure and fugacity (microatm) + pco213 = pco2 * rco213 ! Determine water CO213 pressure and fugacity (microatm) + pco214 = pco2 * rco214 ! Determine water CO214 pressure and fugacity (microatm) ! fractionation factors for 13C during air-sea gas exchange (Zhang et al. 1995, Orr et al. 2017) - frac_k = 0.99912 !Constant kinetic fractionation - frac_aqg = (0.0049*t - 1.31)/1000. + 1. !Gas dissolution fractionation - frac_dicg = (0.0144*t*(cc/(cc+cu+cb)) - 0.107*t + 10.53)/1000. + 1. !DIC to CO2 frac - flux13d=atco213*rpp0*kwco2*dtbgc*Kh*1.e-6*rrho*frac_aqg*frac_k - flux13u=pco213 *kwco2*dtbgc*Kh*1.e-6*rrho*frac_aqg*frac_k/frac_dicg - flux14d=atco214*rpp0*kwco2*dtbgc*Kh*1.e-6*rrho*(frac_aqg**2)*(frac_k**2) - flux14u=pco214 *kwco2*dtbgc*Kh*1.e-6*rrho*(frac_aqg**2)*(frac_k**2)/(frac_dicg**2) -#endif + frac_k = 0.99912 !Constant kinetic fractionation + frac_aqg = (0.0049*t - 1.31)/1000. + 1. !Gas dissolution fractionation + frac_dicg = (0.0144*t*(cc/(cc+cu+cb)) - 0.107*t + 10.53)/1000. + 1. !DIC to CO2 frac + flux13d=atco213*rpp0*kwco2*dtbgc*Kh*1.e-6*rrho*frac_aqg*frac_k + flux13u=pco213 *kwco2*dtbgc*Kh*1.e-6*rrho*frac_aqg*frac_k/frac_dicg + flux14d=atco214*rpp0*kwco2*dtbgc*Kh*1.e-6*rrho*(frac_aqg**2)*(frac_k**2) + flux14u=pco214 *kwco2*dtbgc*Kh*1.e-6*rrho*(frac_aqg**2)*(frac_k**2)/(frac_dicg**2) + end if ! Update DIC ocetra(i,j,1,isco212)=ocetra(i,j,1,isco212)+(fluxd-fluxu)/pddpo(i,j,1) -#ifdef natDIC - ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) -#endif -#ifdef cisonew - ocetra(i,j,1,isco213)=ocetra(i,j,1,isco213)+(flux13d-flux13u)/pddpo(i,j,1) - ocetra(i,j,1,isco214)=ocetra(i,j,1,isco214)+(flux14d-flux14u)/pddpo(i,j,1) -#endif + if (use_natDIC) then + ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) + end if + if (use_cisonew) then + ocetra(i,j,1,isco213)=ocetra(i,j,1,isco213)+(flux13d-flux13u)/pddpo(i,j,1) + ocetra(i,j,1,isco214)=ocetra(i,j,1,isco214)+(flux14d-flux14u)/pddpo(i,j,1) + end if ! Surface flux of oxygen oxflux=kwo2*dtbgc*(ocetra(i,j,1,ioxygen)-satoxy(i,j,1)*(ato2/196800)*rpp0) @@ -438,7 +411,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Surface flux of laughing gas (same piston velocity as for O2 and N2) n2oflux=kwn2o*dtbgc*(ocetra(i,j,1,ian2o)-satn2o(i,j)*atn2o*rpp0) ocetra(i,j,1,ian2o)=ocetra(i,j,1,ian2o)-n2oflux/pddpo(i,j,1) -#ifdef CFC + if (use_CFC) then ! Surface fluxes for CFC: eqn. (1a) in ocmip2 howto doc(hyc) ! flux of CFC: downward direction (mol/m**2/s) ! flx11=kw_11*(a_11*cfc11_atm(i,j)*ppair/p0-trc(i,j,1,1)) @@ -446,92 +419,92 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! unit should be in [kmol cfc m-2] ! unit of [cfc11_atm(i,j)*ppair/p0] should be in [pptv] ! unit of [flx11-12] is in [kmol / m2] - - IF (pglat(i,j).GE.10) THEN - atm_cfc11=atm_cfc11_nh - atm_cfc12=atm_cfc12_nh - atm_sf6=atm_sf6_nh - ELSE IF (pglat(i,j).LE.-10) THEN - atm_cfc11=atm_cfc11_sh - atm_cfc12=atm_cfc12_sh - atm_sf6=atm_sf6_sh - ELSE - fact=(pglat(i,j)-(-10))/20. - atm_cfc11=fact*atm_cfc11_nh+(1-fact)*atm_cfc11_sh - atm_cfc12=fact*atm_cfc12_nh+(1-fact)*atm_cfc12_sh - atm_sf6=fact*atm_sf6_nh+(1-fact)*atm_sf6_sh - ENDIF + + IF (pglat(i,j).GE.10) THEN + atm_cfc11=atm_cfc11_nh + atm_cfc12=atm_cfc12_nh + atm_sf6=atm_sf6_nh + ELSE IF (pglat(i,j).LE.-10) THEN + atm_cfc11=atm_cfc11_sh + atm_cfc12=atm_cfc12_sh + atm_sf6=atm_sf6_sh + ELSE + fact=(pglat(i,j)-(-10))/20. + atm_cfc11=fact*atm_cfc11_nh+(1-fact)*atm_cfc11_sh + atm_cfc12=fact*atm_cfc12_nh+(1-fact)*atm_cfc12_sh + atm_sf6=fact*atm_sf6_nh+(1-fact)*atm_sf6_sh + ENDIF ! Use conversion of 9.86923e-6 [std atm / Pascal] ! Surface flux of cfc11 - flx11=kw_11*dtbgc* & - & (a_11*atm_cfc11*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,icfc11)) - ocetra(i,j,1,icfc11)=ocetra(i,j,1,icfc11)+flx11/pddpo(i,j,1) + flx11=kw_11*dtbgc* & + & (a_11*atm_cfc11*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,icfc11)) + ocetra(i,j,1,icfc11)=ocetra(i,j,1,icfc11)+flx11/pddpo(i,j,1) ! Surface flux of cfc12 - flx12=kw_12*dtbgc* & - & (a_12*atm_cfc12*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,icfc12)) - ocetra(i,j,1,icfc12)=ocetra(i,j,1,icfc12)+flx12/pddpo(i,j,1) + flx12=kw_12*dtbgc* & + & (a_12*atm_cfc12*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,icfc12)) + ocetra(i,j,1,icfc12)=ocetra(i,j,1,icfc12)+flx12/pddpo(i,j,1) ! Surface flux of sf6 - flxsf=kw_sf*dtbgc* & - & (a_sf*atm_sf6*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,isf6)) - ocetra(i,j,1,isf6)=ocetra(i,j,1,isf6)+flxsf/pddpo(i,j,1) -#endif + flxsf=kw_sf*dtbgc* & + & (a_sf*atm_sf6*ppao(i,j)*9.86923*1e-6-ocetra(i,j,1,isf6)) + ocetra(i,j,1,isf6)=ocetra(i,j,1,isf6)+flxsf/pddpo(i,j,1) + end if ! Surface flux of dms - dmsflux = kwdms*dtbgc*ocetra(i,j,1,idms) - ocetra(i,j,1,idms)=ocetra(i,j,1,idms)-dmsflux/pddpo(i,j,1) -#ifdef BROMO + ! Note that kwdms already has the open ocean fraction in the term + dmsflux = kwdms*dtbgc*ocetra(i,j,1,idms) + ocetra(i,j,1,idms) = ocetra(i,j,1,idms) - dmsflux/pddpo(i,j,1) + atmflx(i,j,iatmdms) = dmsflux ! positive to atmosphere [kmol dms m-2 timestep-1] + + if (use_BROMO) then ! Quack and Wallace (2003) eq. 1 ! flux = kw*(Cw - Ca/H) ; kw[m s-1]; Cw[kmol m-3]; ! Convert Ca(atbrf) from ! [pptv] to [ppp] by multiplying with 1e-12 (ppp = parts per part, dimensionless) ! [ppp] to [mol L-1] by multiplying with pressure[bar]/(SST[K]*R[L bar K-1 mol-1]); R=0,083 ! [mol L-1] to [kmol m-3] by multiplying with 1 - flx_bromo=kw_bromo*dtbgc* & - & (atbrf/a_bromo*1e-12*ppao(i,j)*1e-5/(tk*0.083) - ocetra(i,j,1,ibromo)) - ocetra(i,j,1,ibromo)=ocetra(i,j,1,ibromo)+flx_bromo/pddpo(i,j,1) -#endif - + + flx_bromo = kw_bromo*dtbgc* & + (atbrf/a_bromo*1e-12*ppao(i,j)*1e-5/(tk*0.083) - ocetra(i,j,1,ibromo)) + ocetra(i,j,1,ibromo) = ocetra(i,j,1,ibromo) + flx_bromo/pddpo(i,j,1) + atmflx(i,j,iatmbromo) = -flx_bromo + end if ! Save surface fluxes atmflx(i,j,iatmco2)=fluxu-fluxd atmflx(i,j,iatmo2)=oxflux atmflx(i,j,iatmn2)=niflux atmflx(i,j,iatmn2o)=n2oflux - atmflx(i,j,iatmdms)=dmsflux ! positive to atmosphere [kmol dms m-2 timestep-1] -#ifdef cisonew - atmflx(i,j,iatmc13)=flux13u-flux13d - atmflx(i,j,iatmc14)=flux14u-flux14d -#endif -#ifdef CFC - atmflx(i,j,iatmf11)=flx11 - atmflx(i,j,iatmf12)=flx12 - atmflx(i,j,iatmsf6)=flxsf -#endif -#ifdef natDIC - atmflx(i,j,iatmnco2)=natfluxu-natfluxd -#endif -#ifdef BROMO - atmflx(i,j,iatmbromo)=-flx_bromo -#endif + if (use_cisonew) then + atmflx(i,j,iatmc13)=flux13u-flux13d + atmflx(i,j,iatmc14)=flux14u-flux14d + end if + if (use_CFC) then + atmflx(i,j,iatmf11)=flx11 + atmflx(i,j,iatmf12)=flx12 + atmflx(i,j,iatmsf6)=flxsf + end if + if (use_natDIC) then + atmflx(i,j,iatmnco2)=natfluxu-natfluxd + end if ! Save up- and downward components of carbon fluxes for output co2fxd(i,j) = fluxd co2fxu(i,j) = fluxu -#ifdef cisonew - co213fxd(i,j)= flux13d - co213fxu(i,j)= flux13u - co214fxd(i,j)= flux14d - co214fxu(i,j)= flux14u -#endif + if (use_cisonew) then + co213fxd(i,j)= flux13d + co213fxu(i,j)= flux13u + co214fxd(i,j)= flux14d + co214fxu(i,j)= flux14u + end if ! Save pco2 w.r.t. dry air for output pco2d(i,j) = cu * 1.e6 / Khd !pCO2 wrt moist air pco2m(i,j) = cu * 1.e6 / Kh -#ifdef natDIC - natpco2d(i,j) = natcu * 1.e6 / Khd -#endif + if (use_natDIC) then + natpco2d(i,j) = natcu * 1.e6 / Khd + end if ! Save product of piston velocity and solubility for output kwco2sol(i,j) = kwco2*Kh*1e-6 !m/s mol/kg/muatm @@ -540,15 +513,16 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & co2solm(i,j) = Kh ! mol/kg/atm endif ! k==1 -#ifdef BROMO + + if (use_BROMO) then ! Degradation to hydrolysis (Eq. 2-4 of Stemmler et al., 2015) ! A1=1.23e17 mol min-1 => 2.05e12 kmol sec-1 - Kb1=2.05e12*exp(-1.073e5/(8.314*tk))*dtbgc - ocetra(i,j,k,ibromo)=ocetra(i,j,k,ibromo)*(1.-(Kb1*Kw/ah1)) + Kb1=2.05e12*exp(-1.073e5/(8.314*tk))*dtbgc + ocetra(i,j,k,ibromo)=ocetra(i,j,k,ibromo)*(1.-(Kb1*Kw/ah1)) ! Degradation to halogen substitution (Eq. 5-6 of Stemmler et al., 2015) - lsub=7.33e-10*exp(1.250713e4*(1/298.-1/tk))*dtbgc - ocetra(i,j,k,ibromo)=ocetra(i,j,k,ibromo)*(1.-lsub) -#endif + lsub=7.33e-10*exp(1.250713e4*(1/298.-1/tk))*dtbgc + ocetra(i,j,k,ibromo)=ocetra(i,j,k,ibromo)*(1.-lsub) + end if ! ----------------------------------------------------------------- ! Deep ocean processes @@ -562,43 +536,43 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & supsat=co3(i,j,k)-co3(i,j,k)/OmegaC(i,j,k) undsa=MAX(0.,-supsat) dissol=MIN(undsa,0.05*ocetra(i,j,k,icalc)) -#ifdef natDIC - natomega = ( calcon * s / 35. ) * natcc - natOmegaA(i,j,k) = natomega / Kspa - natOmegaC(i,j,k) = natomega / Kspc - natsupsat=natco3(i,j,k)-natco3(i,j,k)/natOmegaC(i,j,k) - natundsa=MAX(0.,-natsupsat) - natdissol=MIN(natundsa,0.05*ocetra(i,j,k,inatcalc)) -#endif -#ifdef cisonew - dissol13=dissol*ocetra(i,j,k,icalc13)/(ocetra(i,j,k,icalc)+safediv) - dissol14=dissol*ocetra(i,j,k,icalc14)/(ocetra(i,j,k,icalc)+safediv) -#endif + if (use_natDIC) then + natomega = ( calcon * s / 35. ) * natcc + natOmegaA(i,j,k) = natomega / Kspa + natOmegaC(i,j,k) = natomega / Kspc + natsupsat=natco3(i,j,k)-natco3(i,j,k)/natOmegaC(i,j,k) + natundsa=MAX(0.,-natsupsat) + natdissol=MIN(natundsa,0.05*ocetra(i,j,k,inatcalc)) + end if + if (use_cisonew) then + dissol13=dissol*ocetra(i,j,k,icalc13)/(ocetra(i,j,k,icalc)+safediv) + dissol14=dissol*ocetra(i,j,k,icalc14)/(ocetra(i,j,k,icalc)+safediv) + end if ocetra(i,j,k,icalc)=ocetra(i,j,k,icalc)-dissol ocetra(i,j,k,ialkali)=ocetra(i,j,k,ialkali)+2.*dissol ocetra(i,j,k,isco212)=ocetra(i,j,k,isco212)+dissol -#ifdef natDIC - ocetra(i,j,k,inatcalc)=ocetra(i,j,k,inatcalc)-natdissol - ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)+2.*natdissol - ocetra(i,j,k,inatsco212)=ocetra(i,j,k,inatsco212)+natdissol -#endif -#ifdef cisonew - ocetra(i,j,k,icalc13)=ocetra(i,j,k,icalc13)-dissol13 - ocetra(i,j,k,isco213)=ocetra(i,j,k,isco213)+dissol13 - ocetra(i,j,k,icalc14)=ocetra(i,j,k,icalc14)-dissol14 - ocetra(i,j,k,isco214)=ocetra(i,j,k,isco214)+dissol14 -#endif - - -#ifdef cisonew -! Decay of the ocean tracers that contain radioactive carbon 14C - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)*c14dec - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14) *c14dec - ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)*c14dec - ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)*c14dec - ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)*c14dec - ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)*c14dec -#endif + if (use_natDIC) then + ocetra(i,j,k,inatcalc)=ocetra(i,j,k,inatcalc)-natdissol + ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)+2.*natdissol + ocetra(i,j,k,inatsco212)=ocetra(i,j,k,inatsco212)+natdissol + end if + if (use_cisonew) then + ocetra(i,j,k,icalc13)=ocetra(i,j,k,icalc13)-dissol13 + ocetra(i,j,k,isco213)=ocetra(i,j,k,isco213)+dissol13 + ocetra(i,j,k,icalc14)=ocetra(i,j,k,icalc14)-dissol14 + ocetra(i,j,k,isco214)=ocetra(i,j,k,isco214)+dissol14 + end if + + + if (use_cisonew) then + ! Decay of the ocean tracers that contain radioactive carbon 14C + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)*c14dec + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14) *c14dec + ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)*c14dec + ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)*c14dec + ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)*c14dec + ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)*c14dec + end if ! Save bottom level dissociation konstants for use in sediment module if( k==kbo(i,j) ) then @@ -623,39 +597,34 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ENDDO !$OMP END PARALLEL DO - - -! C14 decay in the sediment (could be moved to sediment part) -#ifdef cisonew -#ifndef sedbypass - do k=1,ks -!$OMP PARALLEL DO PRIVATE(i) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - sedlay(i,j,k,issso14)=sedlay(i,j,k,issso14)*c14dec - sedlay(i,j,k,isssc14)=sedlay(i,j,k,isssc14)*c14dec - powtra(i,j,k,ipowc14)=powtra(i,j,k,ipowc14)*c14dec - endif - enddo - enddo -!$OMP END PARALLEL DO - enddo - -!$OMP PARALLEL DO PRIVATE(i) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - burial(i,j,issso14) = burial(i,j,issso14)*c14dec - burial(i,j,isssc14) = burial(i,j,isssc14)*c14dec - endif - enddo - enddo -!$OMP END PARALLEL DO -#endif -#endif - + ! C14 decay in the sediment (could be moved to sediment part) + if (use_cisonew .and. .not. use_sedbypass) then + do k=1,ks + !$OMP PARALLEL DO PRIVATE(i) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + sedlay(i,j,k,issso14)=sedlay(i,j,k,issso14)*c14dec + sedlay(i,j,k,isssc14)=sedlay(i,j,k,isssc14)*c14dec + powtra(i,j,k,ipowc14)=powtra(i,j,k,ipowc14)*c14dec + endif + enddo + enddo + !$OMP END PARALLEL DO + enddo + + !$OMP PARALLEL DO PRIVATE(i) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + burial(i,j,issso14) = burial(i,j,issso14)*c14dec + burial(i,j,isssc14) = burial(i,j,isssc14)*c14dec + endif + enddo + enddo + !$OMP END PARALLEL DO + end if ! end of use_cisonew and not use_sedbypass RETURN - END + END SUBROUTINE CARCHM diff --git a/hamocc/cyano.F90 b/hamocc/cyano.F90 index f3f696df..d80f8e85 100644 --- a/hamocc/cyano.F90 +++ b/hamocc/cyano.F90 @@ -65,9 +65,9 @@ SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) use mo_biomod, only: bluefix,intnfix,rnit,tf0,tf1,tf2,tff use mo_param1_bgc, only: ialkali,iano3,igasnit,iphosph,ioxygen use mo_vgrid, only: kmle -#ifdef natDIC + ! natDIC use mo_param1_bgc, only: inatalkali -#endif + use mo_control_bgc, only : use_natDIC implicit none @@ -113,9 +113,9 @@ SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) ! Nitrogen fixation followed by remineralisation and nitrification decreases ! alkalinity by 1 mole per mole nitrogen fixed (Wolf-Gladrow et al. 2007) ocetra(i,j,k,ialkali)=ocetra(i,j,k,ialkali)-dano3 -#ifdef natDIC - ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 -#endif + if (use_natDIC) then + ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 + end if intnfix(i,j) = intnfix(i,j) + & & (ocetra(i,j,k,iano3)-oldocetra)*pddpo(i,j,k) diff --git a/hamocc/dipowa.F90 b/hamocc/dipowa.F90 index f601b33b..28cb0345 100644 --- a/hamocc/dipowa.F90 +++ b/hamocc/dipowa.F90 @@ -59,12 +59,11 @@ subroutine dipowa(kpie,kpje,kpke,omask,lspin) use mo_sedmnt, only: powtra,porwat,porwah,sedict,seddw,seddzi,zcoefsu,zcoeflo use mo_param1_bgc, only: ks,npowtra,map_por2octra use mo_vgrid, only: kbo,bolay -#ifdef cisonew + ! cisonew use mo_param1_bgc, only: ipowc13,ipowc14,isco213,isco214 -#endif -#ifdef natDIC + ! natDIC use mo_param1_bgc, only: ialkali,inatalkali,inatsco212,isco212 -#endif + use mo_control_bgc, only: use_natDIC implicit none @@ -190,15 +189,15 @@ subroutine dipowa(kpie,kpje,kpke,omask,lspin) ! diffusive fluxes (positive downward) sedfluxo(i,j,iv) = sedfluxo(i,j,iv) & & -(ocetra(i,j,kbo(i,j),iv_oc) - aprior)* bolay(i,j) -#ifdef natDIC - ! workaround as long as natDIC is not implemented throughout the sediment module - if (iv_oc==isco212) ocetra(i,j,kbo(i,j),inatsco212) = & - & ocetra(i,j,kbo(i,j),inatsco212) + & - & ocetra(i,j,kbo(i,j),isco212) - aprior - if (iv_oc==ialkali) ocetra(i,j,kbo(i,j),inatalkali) = & - & ocetra(i,j,kbo(i,j),inatalkali) + & - & ocetra(i,j,kbo(i,j),ialkali) - aprior -#endif + if (use_natDIC) then + ! workaround as long as natDIC is not implemented throughout the sediment module + if (iv_oc==isco212) ocetra(i,j,kbo(i,j),inatsco212) = & + & ocetra(i,j,kbo(i,j),inatsco212) + & + & ocetra(i,j,kbo(i,j),isco212) - aprior + if (iv_oc==ialkali) ocetra(i,j,kbo(i,j),inatalkali) = & + & ocetra(i,j,kbo(i,j),inatalkali) + & + & ocetra(i,j,kbo(i,j),ialkali) - aprior + end if endif enddo enddo diff --git a/hamocc/hamocc4bcm.F90 b/hamocc/hamocc4bcm.F90 index b52fb632..458f866b 100644 --- a/hamocc/hamocc4bcm.F90 +++ b/hamocc/hamocc4bcm.F90 @@ -19,7 +19,7 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& pdlxp,pdlyp,pddpo,prho,pglat,omask, & - dust,rivin,ndep,oafx,pi_ph, & + dust,rivin,ndep,oafx,pi_ph, & pfswr,psicomo,ppao,pfu10,ptho,psao, & patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) !****************************************************************************** @@ -75,33 +75,28 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& ! *REAL* *psao* - salinity [psu.]. ! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in ! fully coupled mode (prognostic/diagnostic CO2). -! *REAL* *pflxco2* - CO2 flux [kg/m^2/s]. ! *REAL* *pflxdms* - DMS flux [kg/m^2/s]. +! *REAL* *pflxco2* - CO2 flux [kg/m^2/s]. ! *REAL* *patmbromo* - atmospheric bromoform concentration [ppt] used in ! fully coupled mode. -! *REAL* *pflxbromo* - Bromoform flux [kg/m^2/s]. ! !****************************************************************************** use mod_xc, only: mnproc - use mo_carbch, only: atmflx,ocetra,atm + use mo_carbch, only: atmflx,ocetra,atm,& + atm_cfc11_nh,atm_cfc11_sh,atm_cfc12_nh,atm_cfc12_sh,atm_sf6_nh,atm_sf6_sh use mo_biomod, only: strahl use mo_control_bgc, only: ldtrunbgc,dtbgc,ldtbgc,io_stdo_bgc,dtbgc,ndtdaybgc, & - do_sedspinup,sedspin_yr_s,sedspin_yr_e,sedspin_ncyc - use mo_param1_bgc, only: iatmco2,iatmdms,nocetra,nriv + do_sedspinup,sedspin_yr_s,sedspin_yr_e,sedspin_ncyc, & + use_PROGCO2,use_DIAGCO2,use_BROMO, use_CFC, use_PBGC_CK_TIMESTEP,& + use_BOXATM, use_sedbypass + use mo_param1_bgc, only: iatmco2,iatmdms,nocetra,nriv,iatmbromo use mo_vgrid, only: set_vgrid use mo_apply_fedep, only: apply_fedep use mo_apply_rivin, only: apply_rivin use mo_apply_ndep, only: apply_ndep use mo_apply_oafx, only: apply_oafx -#if defined(BOXATM) use mo_boxatm, only: update_boxatm -#endif -#ifdef BROMO - use mo_param1_bgc, only: iatmbromo -#endif -#ifdef CFC - use mo_carbch, only: atm_cfc11_nh,atm_cfc11_sh,atm_cfc12_nh,atm_cfc12_sh,atm_sf6_nh,atm_sf6_sh -#endif + implicit none INTEGER, intent(in) :: kpie,kpje,kpke,kbnd @@ -125,9 +120,9 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& REAL, intent(in) :: psao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) REAL, intent(in) :: patmco2(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) REAL, intent(out) :: pflxco2(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(out) :: pflxdms(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: patmbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(out) :: pflxbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(inout) :: pflxdms(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: patmbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(inout) :: pflxbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) INTEGER :: i,j,k,l INTEGER :: nspin,it @@ -171,45 +166,45 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& !-------------------------------------------------------------------- ! Pass atmospheric co2 if coupled to an active atmosphere model ! -#if defined(PROGCO2) || defined(DIAGCO2) -!$OMP PARALLEL DO PRIVATE(i) - DO j=1,kpje - DO i=1,kpie - atm(i,j,iatmco2)=patmco2(i,j) - ENDDO - ENDDO -!$OMP END PARALLEL DO - !if (mnproc.eq.1) write (io_stdo_bgc,*) 'iHAMOCC: getting co2 from atm' -#endif - -#ifdef BROMO -!$OMP PARALLEL DO PRIVATE(i) - DO j=1,kpje - DO i=1,kpie - IF (patmbromo(i,j).gt.0.) THEN - atm(i,j,iatmbromo)=patmbromo(i,j) - ENDIF - ENDDO - ENDDO -!$OMP END PARALLEL DO - if (mnproc.eq.1) write (io_stdo_bgc,*) 'iHAMOCC: getting bromoform from atm' -#endif + if (use_PROGCO2 .or. use_DIAGCO2) then + !$OMP PARALLEL DO PRIVATE(i) + DO j=1,kpje + DO i=1,kpie + atm(i,j,iatmco2)=patmco2(i,j) + ENDDO + ENDDO + !$OMP END PARALLEL DO + !if (mnproc.eq.1) write (io_stdo_bgc,*) 'iHAMOCC: getting co2 from atm' + end if + + if (use_BROMO) then + !$OMP PARALLEL DO PRIVATE(i) + DO j=1,kpje + DO i=1,kpie + IF (patmbromo(i,j).gt.0.) THEN + atm(i,j,iatmbromo)=patmbromo(i,j) + ENDIF + ENDDO + ENDDO + !$OMP END PARALLEL DO + if (mnproc.eq.1) write (io_stdo_bgc,*) 'iHAMOCC: getting bromoform from atm' + end if !-------------------------------------------------------------------- ! Read atmospheric cfc concentrations ! -#ifdef CFC - call get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & - atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) -#endif + if (use_CFC) then + call get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & + atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) + end if -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'before BGC: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'before BGC: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if !--------------------------------------------------------------------- @@ -224,13 +219,13 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& CALL OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after OCPROD: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after OCPROD: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if do l=1,nocetra @@ -247,83 +242,82 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& enddo enddo -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after LIMIT: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after LIMIT: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if CALL CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after CYANO: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif - + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after CYANO: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if CALL CARCHM(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,prho,pglat,omask, & psicomo,ppao,pfu10,ptho,psao) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after CARCHM: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after CARCHM: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! Apply n-deposition CALL apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after N deposition: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after N deposition: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! Apply riverine input of carbon and nutrients call apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after river input: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after river input: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! Apply alkalinity flux due to ocean alkalinization call apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after ocean alkalinization: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after ocean alkalinization: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! Update atmospheric pCO2 [ppm] -#if defined(BOXATM) - CALL update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) -#endif + if (use_BOXATM) then + CALL update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) + end if -#ifdef PBGC_CK_TIMESTEP - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after ATMOTR: call INVENTORY' - ENDIF - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif + if (use_PBGC_CK_TIMESTEP ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'after ATMOTR: call INVENTORY' + ENDIF + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! update preformed tracers CALL PREFTRC(kpie,kpje,omask) @@ -332,62 +326,62 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& !-------------------------------------------------------------------- ! Sediment module -#ifndef sedbypass -! jump over sediment if sedbypass is defined - - if(do_sedspinup .and. kplyear>=sedspin_yr_s & - .and. kplyear<=sedspin_yr_e) then - nspin = sedspin_ncyc - if(mnproc == 1) then - write(io_stdo_bgc,*) - write(io_stdo_bgc,*) 'iHAMOCC: sediment spinup activated with ', & - nspin, ' subcycles' - endif - else - nspin = 1 - endif - - ! Loop for sediment spinup. If deactivated then nspin=1 and lspin=.false. - do it=1,nspin - - if( it=sedspin_yr_s & + .and. kplyear<=sedspin_yr_e) then + nspin = sedspin_ncyc + if(mnproc == 1) then + write(io_stdo_bgc,*) + write(io_stdo_bgc,*) 'iHAMOCC: sediment spinup activated with ', & + nspin, ' subcycles' + endif + else + nspin = 1 + endif + + ! Loop for sediment spinup. If deactivated then nspin=1 and lspin=.false. + do it=1,nspin + + if( it_varid, and mean concentration zc__varid integer :: ztotvol_varid ! Total ocean volume @@ -744,7 +748,8 @@ subroutine write_netcdf(iogrp) integer :: zt_prefalk_varid, zc_prefalk_varid ! Preformed alkalinity integer :: zt_prefdic_varid, zc_prefdic_varid ! Preformed DIC integer :: zt_dicsat_varid, zc_dicsat_varid ! Saturated DIC -#ifdef cisonew + + ! cisonew integer :: zt_sco213_varid, zc_sco213_varid ! Dissolved CO2-C13 integer :: zt_sco214_varid, zc_sco214_varid ! Dissolved CO2-C14 integer :: zt_doc13_varid, zc_doc13_varid ! Dissolved organic carbon-C13 @@ -757,24 +762,24 @@ subroutine write_netcdf(iogrp) integer :: zt_grazer14_varid, zc_grazer14_varid ! Zooplankton concentration-C14 integer :: zt_calciu13_varid, zc_calciu13_varid ! Calcium carbonate-C13 integer :: zt_calciu14_varid, zc_calciu14_varid ! Calcium carbonate-C14 -#endif -#ifdef AGG + + ! AGG integer :: zt_snos_varid, zc_snos_varid ! Marine snow aggregates per g sea water integer :: zt_adust_varid, zc_adust_varid ! Aggregated dust -#endif -#ifdef CFC + + ! CFC integer :: zt_cfc11_varid, zc_cfc11_varid ! CFC-11 : Trichlorofluoromethane integer :: zt_cfc12_varid, zc_cfc12_varid ! CFC-12 : Dichlorodifluoromethane integer :: zt_sf6_varid, zc_sf6_varid ! SF6 : Sulfur hexafluoride -#endif -#ifdef natDIC + + ! natDIC integer :: zt_natsco212_varid, zc_natsco212_varid ! Natural dissolved CO2 integer :: zt_natalkali_varid, zc_natalkali_varid ! Natural alkalinity integer :: zt_natcalciu_varid, zc_natcalciu_varid ! Natural calcium carbonate -#endif -#ifdef BROMO + + ! BROMO integer :: zt_bromo_varid, zc_bromo_varid ! Bromoform -#endif + !--- sum of inventory integer :: totcarb_varid, totphos_varid, totsili_varid, totnitr_varid integer :: totoxyg_varid @@ -818,63 +823,63 @@ subroutine write_netcdf(iogrp) call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', timeunits) ) !--- Define dimensions -#ifndef sedbypass - call nccheck( NF90_DEF_DIM(ncid, 'npowtra', npowtra, npowtra_dimid) ) - call nccheck( NF90_DEF_DIM(ncid, 'nsedtra', nsedtra, nsedtra_dimid) ) -#endif + if (.not. use_sedbypass) then + call nccheck( NF90_DEF_DIM(ncid, 'npowtra', npowtra, npowtra_dimid) ) + call nccheck( NF90_DEF_DIM(ncid, 'nsedtra', nsedtra, nsedtra_dimid) ) + end if call nccheck( NF90_DEF_DIM(ncid, 'time', NF90_UNLIMITED, time_dimid) ) !--- Dimensions for arrays. !--- The unlimited "time" dimension must come last in the list of dimensions. -#ifndef sedbypass - zpowtra_dimids = (/ npowtra_dimid, time_dimid /) - zsedtra_dimids = (/ nsedtra_dimid, time_dimid /) -#endif + if (.not. use_sedbypass) then + zpowtra_dimids = (/ npowtra_dimid, time_dimid /) + zsedtra_dimids = (/ nsedtra_dimid, time_dimid /) + end if !--- Define variables : time call nccheck( NF90_DEF_VAR(ncid, 'time', NF90_DOUBLE, time_dimid, & & time_varid) ) call nccheck( NF90_PUT_ATT(ncid, time_varid, 'units', 'days') ) -#ifndef sedbypass - !--- aqueous sediment tracers - call nccheck( NF90_DEF_VAR(ncid, 'zsedtotvol', NF90_DOUBLE, time_dimid, & - & zsedtotvol_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zsedtotvol_varid, 'long_name', & - & 'Total sediment volume') ) - call nccheck( NF90_PUT_ATT(ncid, zsedtotvol_varid, 'units', 'L') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zpowtratot', NF90_DOUBLE, & - & zpowtra_dimids, zpowtratot_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zpowtratot_varid, 'long_name', & - & 'Total aqueous sediment tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zpowtratot_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zpowtratoc', NF90_DOUBLE, & - & zpowtra_dimids, zpowtratoc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zpowtratoc_varid, 'long_name', & - & 'Aqueous sediment concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zpowtratoc_varid, 'units', 'kmol/L') ) - - !--- non-aqueous sediment tracers - call nccheck( NF90_DEF_VAR(ncid, 'zsedlayto', NF90_DOUBLE, & - & zsedtra_dimids, zsedlayto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zsedlayto_varid, 'long_name', & - & 'Sediment layer tracers') ) - call nccheck( NF90_PUT_ATT(ncid, zsedlayto_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zburial', NF90_DOUBLE, & - & zsedtra_dimids, zburial_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zburial_varid, 'long_name', & - & 'Sediment burial tracers') ) - call nccheck( NF90_PUT_ATT(ncid, zburial_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zsedhplto', NF90_DOUBLE, time_dimid, & - & zsedhplto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zsedhplto_varid, 'long_name', & - & 'Total sediment accumulated hydrogen ions') ) - call nccheck( NF90_PUT_ATT(ncid, zsedhplto_varid, 'units', 'kmol') ) -#endif + if (.not. use_sedbypass) then + !--- aqueous sediment tracers + call nccheck( NF90_DEF_VAR(ncid, 'zsedtotvol', NF90_DOUBLE, time_dimid, & + & zsedtotvol_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zsedtotvol_varid, 'long_name', & + & 'Total sediment volume') ) + call nccheck( NF90_PUT_ATT(ncid, zsedtotvol_varid, 'units', 'L') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zpowtratot', NF90_DOUBLE, & + & zpowtra_dimids, zpowtratot_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zpowtratot_varid, 'long_name', & + & 'Total aqueous sediment tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zpowtratot_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zpowtratoc', NF90_DOUBLE, & + & zpowtra_dimids, zpowtratoc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zpowtratoc_varid, 'long_name', & + & 'Aqueous sediment concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zpowtratoc_varid, 'units', 'kmol/L') ) + + !--- non-aqueous sediment tracers + call nccheck( NF90_DEF_VAR(ncid, 'zsedlayto', NF90_DOUBLE, & + & zsedtra_dimids, zsedlayto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zsedlayto_varid, 'long_name', & + & 'Sediment layer tracers') ) + call nccheck( NF90_PUT_ATT(ncid, zsedlayto_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zburial', NF90_DOUBLE, & + & zsedtra_dimids, zburial_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zburial_varid, 'long_name', & + & 'Sediment burial tracers') ) + call nccheck( NF90_PUT_ATT(ncid, zburial_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zsedhplto', NF90_DOUBLE, time_dimid, & + & zsedhplto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zsedhplto_varid, 'long_name', & + & 'Total sediment accumulated hydrogen ions') ) + call nccheck( NF90_PUT_ATT(ncid, zsedhplto_varid, 'units', 'kmol') ) + end if !--- Define variables : oceanic tracers call nccheck( NF90_DEF_VAR(ncid, 'ztotvol', NF90_DOUBLE, time_dimid, & @@ -1147,272 +1152,272 @@ subroutine write_netcdf(iogrp) & 'Mean saturated DIC concentration') ) call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'units', 'kmol/m^3') ) -#ifdef cisonew - call nccheck( NF90_DEF_VAR(ncid, 'zt_sco213', NF90_DOUBLE, & - & time_dimid, zt_sco213_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco213_varid, 'long_name', & - & 'Total dissolved CO2-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco213_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_sco213', NF90_DOUBLE, & - & time_dimid, zc_sco213_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco213_varid, 'long_name', & - & 'Mean dissolved CO2-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco213_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_sco214', NF90_DOUBLE, & - & time_dimid, zt_sco214_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco214_varid, 'long_name', & - & 'Total dissolved CO2-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco214_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_sco214', NF90_DOUBLE, & - & time_dimid, zc_sco214_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco214_varid, 'long_name', & - & 'Mean dissolved CO2-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco214_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_doc13', NF90_DOUBLE, & - & time_dimid, zt_doc13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc13_varid, 'long_name', & - & 'Total dissolved organic carbon-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc13_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_doc13', NF90_DOUBLE, & - & time_dimid, zc_doc13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc13_varid, 'long_name', & - & 'Mean dissolved organic carbon-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc13_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_doc14', NF90_DOUBLE, & - & time_dimid, zt_doc14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc14_varid, 'long_name', & - & 'Total dissolved organic carbon-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc14_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_doc14', NF90_DOUBLE, & - & time_dimid, zc_doc14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc14_varid, 'long_name', & - & 'Mean dissolved organic carbon-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc14_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_poc13', NF90_DOUBLE, & - & time_dimid, zt_poc13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc13_varid, 'long_name', & - & 'Total particulate organic carbon-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc13_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_poc13', NF90_DOUBLE, & - & time_dimid, zc_poc13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc13_varid, 'long_name', & - & 'Mean particulate organic carbon-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc13_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_poc14', NF90_DOUBLE, & - & time_dimid, zt_poc14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc14_varid, 'long_name', & - & 'Total particulate organic carbon-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc14_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_poc14', NF90_DOUBLE, & - & time_dimid, zc_poc14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc14_varid, 'long_name', & - & 'Mean particulate organic carbon-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc14_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto13', NF90_DOUBLE, & - & time_dimid, zt_phyto13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto13_varid, 'long_name', & - & 'Total phytoplankton-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto13_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto13', NF90_DOUBLE, & - & time_dimid, zc_phyto13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto13_varid, 'long_name', & - & 'Mean phytoplankton-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto13_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto14', NF90_DOUBLE, & - & time_dimid, zt_phyto14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto14_varid, 'long_name', & - & 'Total phytoplankton-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto14_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto14', NF90_DOUBLE, & - & time_dimid, zc_phyto14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto14_varid, 'long_name', & - & 'Mean phytoplankton-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto14_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer13', NF90_DOUBLE, & - & time_dimid, zt_grazer13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer13_varid, 'long_name', & - & 'Total zooplankton-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer13_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer13', NF90_DOUBLE, & - & time_dimid, zc_grazer13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer13_varid, 'long_name', & - & 'Mean zooplankton-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer13_varid, 'units', & - & 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer14', NF90_DOUBLE, & - & time_dimid, zt_grazer14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer14_varid, 'long_name', & - & 'Total zooplankton-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer14_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer14', NF90_DOUBLE, & - & time_dimid, zc_grazer14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer14_varid, 'long_name', & - & 'Mean zooplankton-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer14_varid, 'units', & - & 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu13', NF90_DOUBLE, & - & time_dimid, zt_calciu13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu13_varid, 'long_name', & - & 'Total calcium carbonate-C13 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu13_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu13', NF90_DOUBLE, & - & time_dimid, zc_calciu13_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu13_varid, 'long_name', & - & 'Mean calcium carbonate-C13 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu13_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu14', NF90_DOUBLE, & - & time_dimid, zt_calciu14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu14_varid, 'long_name', & - & 'Total calcium carbonate-C14 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu14_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu14', NF90_DOUBLE, & - & time_dimid, zc_calciu14_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu14_varid, 'long_name', & - & 'Mean calcium carbonate-C14 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu14_varid, 'units', 'kmol/m^3') ) -#endif - -#ifdef AGG - call nccheck( NF90_DEF_VAR(ncid, 'zt_snos', NF90_DOUBLE, & - & time_dimid, zt_snos_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_snos_varid, 'long_name', & - & 'Total marine snow aggrerates tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_snos_varid, 'units', '---') ) ! What is the unit? - - call nccheck( NF90_DEF_VAR(ncid, 'zc_snos', NF90_DOUBLE, & - & time_dimid, zc_snos_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_snos_varid, 'long_name', & - & 'Mean marine snow aggregates concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_snos_varid, 'units', '---/m^3') ) ! What is the unit? - - call nccheck( NF90_DEF_VAR(ncid, 'zt_adust', NF90_DOUBLE, & - & time_dimid, zt_adust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_adust_varid, 'long_name', & - & 'Total aggregated dust tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_adust_varid, 'units', '---') ) ! What is the unit? - - call nccheck( NF90_DEF_VAR(ncid, 'zc_adust', NF90_DOUBLE, & - & time_dimid, zc_adust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_adust_varid, 'long_name', & - & 'Mean aggregated dust concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_adust_varid, 'units', '---/m^3') ) ! What is the unit? -#endif - -#ifdef CFC - call nccheck( NF90_DEF_VAR(ncid, 'zt_cfc11', NF90_DOUBLE, & - & time_dimid, zt_cfc11_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_cfc11_varid, 'long_name', & - & 'Total CFC-11 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_cfc11_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_cfc11', NF90_DOUBLE, & - & time_dimid, zc_cfc11_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_cfc11_varid, 'long_name', & - & 'Mean CFC-11 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_cfc11_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_cfc12', NF90_DOUBLE, & - & time_dimid, zt_cfc12_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_cfc12_varid, 'long_name', & - & 'Total CFC-12 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_cfc12_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_cfc12', NF90_DOUBLE, & - & time_dimid, zc_cfc12_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_cfc12_varid, 'long_name', & - & 'Mean CFC-12 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_cfc12_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_sf6', NF90_DOUBLE, & - & time_dimid, zt_sf6_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_sf6_varid, 'long_name', & - & 'Total SF6 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_sf6_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_sf6', NF90_DOUBLE, & - & time_dimid, zc_sf6_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_sf6_varid, 'long_name', & - & 'Mean SF6 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_sf6_varid, 'units', 'kmol/m^3') ) -#endif - -#ifdef natDIC - call nccheck( NF90_DEF_VAR(ncid, 'zt_natsco212', NF90_DOUBLE, & - & time_dimid, zt_natsco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_natsco212_varid, 'long_name', & - & 'Total natural dissolved CO2 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_natsco212_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_natsco212', NF90_DOUBLE, & - & time_dimid, zc_natsco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_natsco212_varid, 'long_name', & - & 'Mean natural dissolved CO2 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_natsco212_varid, 'units', & - & 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_natalkali', NF90_DOUBLE, & - & time_dimid, zt_natalkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_natalkali_varid, 'long_name', & - & 'Total natural alkalinity tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_natalkali_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_natalkali', NF90_DOUBLE, & - & time_dimid, zc_natalkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_natalkali_varid, 'long_name', & - & 'Mean natural alkalinity concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_natalkali_varid, 'units', & - & 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_natcalciu', NF90_DOUBLE, & - & time_dimid, zt_natcalciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_natcalciu_varid, 'long_name', & - & 'Total natural calcium carbonate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_natcalciu_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_natcalciu', NF90_DOUBLE, & - & time_dimid, zc_natcalciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_natcalciu_varid, 'long_name', & - & 'Mean natural calcium carbonate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_natcalciu_varid, 'units', & - & 'kmol/m^3') ) -#endif - -#ifdef BROMO - call nccheck( NF90_DEF_VAR(ncid, 'zt_bromo', NF90_DOUBLE, & - & time_dimid, zt_bromo_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_bromo_varid, 'long_name', & - & 'Total bromoform tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_bromo_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_bromo', NF90_DOUBLE, & - & time_dimid, zc_bromo_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_bromo_varid, 'long_name', & - & 'Mean bromoform concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_bromo_varid, 'units', 'kmol/m^3') ) -#endif + if (use_cisonew) then + call nccheck( NF90_DEF_VAR(ncid, 'zt_sco213', NF90_DOUBLE, & + & time_dimid, zt_sco213_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco213_varid, 'long_name', & + & 'Total dissolved CO2-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco213_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_sco213', NF90_DOUBLE, & + & time_dimid, zc_sco213_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco213_varid, 'long_name', & + & 'Mean dissolved CO2-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco213_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_sco214', NF90_DOUBLE, & + & time_dimid, zt_sco214_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco214_varid, 'long_name', & + & 'Total dissolved CO2-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco214_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_sco214', NF90_DOUBLE, & + & time_dimid, zc_sco214_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco214_varid, 'long_name', & + & 'Mean dissolved CO2-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco214_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_doc13', NF90_DOUBLE, & + & time_dimid, zt_doc13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc13_varid, 'long_name', & + & 'Total dissolved organic carbon-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc13_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_doc13', NF90_DOUBLE, & + & time_dimid, zc_doc13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc13_varid, 'long_name', & + & 'Mean dissolved organic carbon-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc13_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_doc14', NF90_DOUBLE, & + & time_dimid, zt_doc14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc14_varid, 'long_name', & + & 'Total dissolved organic carbon-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc14_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_doc14', NF90_DOUBLE, & + & time_dimid, zc_doc14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc14_varid, 'long_name', & + & 'Mean dissolved organic carbon-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc14_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_poc13', NF90_DOUBLE, & + & time_dimid, zt_poc13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc13_varid, 'long_name', & + & 'Total particulate organic carbon-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc13_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_poc13', NF90_DOUBLE, & + & time_dimid, zc_poc13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc13_varid, 'long_name', & + & 'Mean particulate organic carbon-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc13_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_poc14', NF90_DOUBLE, & + & time_dimid, zt_poc14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc14_varid, 'long_name', & + & 'Total particulate organic carbon-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc14_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_poc14', NF90_DOUBLE, & + & time_dimid, zc_poc14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc14_varid, 'long_name', & + & 'Mean particulate organic carbon-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc14_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto13', NF90_DOUBLE, & + & time_dimid, zt_phyto13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto13_varid, 'long_name', & + & 'Total phytoplankton-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto13_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto13', NF90_DOUBLE, & + & time_dimid, zc_phyto13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto13_varid, 'long_name', & + & 'Mean phytoplankton-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto13_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto14', NF90_DOUBLE, & + & time_dimid, zt_phyto14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto14_varid, 'long_name', & + & 'Total phytoplankton-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto14_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto14', NF90_DOUBLE, & + & time_dimid, zc_phyto14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto14_varid, 'long_name', & + & 'Mean phytoplankton-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto14_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer13', NF90_DOUBLE, & + & time_dimid, zt_grazer13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer13_varid, 'long_name', & + & 'Total zooplankton-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer13_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer13', NF90_DOUBLE, & + & time_dimid, zc_grazer13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer13_varid, 'long_name', & + & 'Mean zooplankton-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer13_varid, 'units', & + & 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer14', NF90_DOUBLE, & + & time_dimid, zt_grazer14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer14_varid, 'long_name', & + & 'Total zooplankton-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer14_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer14', NF90_DOUBLE, & + & time_dimid, zc_grazer14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer14_varid, 'long_name', & + & 'Mean zooplankton-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer14_varid, 'units', & + & 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu13', NF90_DOUBLE, & + & time_dimid, zt_calciu13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu13_varid, 'long_name', & + & 'Total calcium carbonate-C13 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu13_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu13', NF90_DOUBLE, & + & time_dimid, zc_calciu13_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu13_varid, 'long_name', & + & 'Mean calcium carbonate-C13 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu13_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu14', NF90_DOUBLE, & + & time_dimid, zt_calciu14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu14_varid, 'long_name', & + & 'Total calcium carbonate-C14 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu14_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu14', NF90_DOUBLE, & + & time_dimid, zc_calciu14_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu14_varid, 'long_name', & + & 'Mean calcium carbonate-C14 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu14_varid, 'units', 'kmol/m^3') ) + end if + + if (use_AGG) then + call nccheck( NF90_DEF_VAR(ncid, 'zt_snos', NF90_DOUBLE, & + & time_dimid, zt_snos_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_snos_varid, 'long_name', & + & 'Total marine snow aggrerates tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_snos_varid, 'units', '---') ) ! What is the unit? + + call nccheck( NF90_DEF_VAR(ncid, 'zc_snos', NF90_DOUBLE, & + & time_dimid, zc_snos_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_snos_varid, 'long_name', & + & 'Mean marine snow aggregates concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_snos_varid, 'units', '---/m^3') ) ! What is the unit? + + call nccheck( NF90_DEF_VAR(ncid, 'zt_adust', NF90_DOUBLE, & + & time_dimid, zt_adust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_adust_varid, 'long_name', & + & 'Total aggregated dust tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_adust_varid, 'units', '---') ) ! What is the unit? + + call nccheck( NF90_DEF_VAR(ncid, 'zc_adust', NF90_DOUBLE, & + & time_dimid, zc_adust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_adust_varid, 'long_name', & + & 'Mean aggregated dust concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_adust_varid, 'units', '---/m^3') ) ! What is the unit? + end if + + if (use_CFC) then + call nccheck( NF90_DEF_VAR(ncid, 'zt_cfc11', NF90_DOUBLE, & + & time_dimid, zt_cfc11_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_cfc11_varid, 'long_name', & + & 'Total CFC-11 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_cfc11_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_cfc11', NF90_DOUBLE, & + & time_dimid, zc_cfc11_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_cfc11_varid, 'long_name', & + & 'Mean CFC-11 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_cfc11_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_cfc12', NF90_DOUBLE, & + & time_dimid, zt_cfc12_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_cfc12_varid, 'long_name', & + & 'Total CFC-12 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_cfc12_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_cfc12', NF90_DOUBLE, & + & time_dimid, zc_cfc12_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_cfc12_varid, 'long_name', & + & 'Mean CFC-12 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_cfc12_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_sf6', NF90_DOUBLE, & + & time_dimid, zt_sf6_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_sf6_varid, 'long_name', & + & 'Total SF6 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_sf6_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_sf6', NF90_DOUBLE, & + & time_dimid, zc_sf6_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_sf6_varid, 'long_name', & + & 'Mean SF6 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_sf6_varid, 'units', 'kmol/m^3') ) + end if + + if (use_natDIC) then + call nccheck( NF90_DEF_VAR(ncid, 'zt_natsco212', NF90_DOUBLE, & + & time_dimid, zt_natsco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_natsco212_varid, 'long_name', & + & 'Total natural dissolved CO2 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_natsco212_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_natsco212', NF90_DOUBLE, & + & time_dimid, zc_natsco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_natsco212_varid, 'long_name', & + & 'Mean natural dissolved CO2 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_natsco212_varid, 'units', & + & 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_natalkali', NF90_DOUBLE, & + & time_dimid, zt_natalkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_natalkali_varid, 'long_name', & + & 'Total natural alkalinity tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_natalkali_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_natalkali', NF90_DOUBLE, & + & time_dimid, zc_natalkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_natalkali_varid, 'long_name', & + & 'Mean natural alkalinity concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_natalkali_varid, 'units', & + & 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_natcalciu', NF90_DOUBLE, & + & time_dimid, zt_natcalciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_natcalciu_varid, 'long_name', & + & 'Total natural calcium carbonate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_natcalciu_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_natcalciu', NF90_DOUBLE, & + & time_dimid, zc_natcalciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_natcalciu_varid, 'long_name', & + & 'Mean natural calcium carbonate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_natcalciu_varid, 'units', & + & 'kmol/m^3') ) + end if + + if (use_BROMO) then + call nccheck( NF90_DEF_VAR(ncid, 'zt_bromo', NF90_DOUBLE, & + & time_dimid, zt_bromo_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_bromo_varid, 'long_name', & + & 'Total bromoform tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_bromo_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_bromo', NF90_DOUBLE, & + & time_dimid, zc_bromo_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_bromo_varid, 'long_name', & + & 'Mean bromoform concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_bromo_varid, 'units', 'kmol/m^3') ) + end if !--- Define variables : sum of inventory call nccheck( NF90_DEF_VAR(ncid, 'totcarb', NF90_DOUBLE, time_dimid, & @@ -1492,22 +1497,24 @@ subroutine write_netcdf(iogrp) call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) !--- Inquire dimid call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) -#ifndef sedbypass - call nccheck( NF90_INQ_DIMID(ncid, 'npowtra', npowtra_dimid) ) - call nccheck( NF90_INQ_DIMID(ncid, 'nsedtra', nsedtra_dimid) ) -#endif + if (.not. use_sedbypass) then + call nccheck( NF90_INQ_DIMID(ncid, 'npowtra', npowtra_dimid) ) + call nccheck( NF90_INQ_DIMID(ncid, 'nsedtra', nsedtra_dimid) ) + end if !--- Inquire varid : time call nccheck( NF90_INQ_VARID(ncid, "time", time_varid) ) -#ifndef sedbypass - !--- aqueous sediment tracers - call nccheck( NF90_INQ_VARID(ncid, 'zsedtotvol', zsedtotvol_varid) ) - call nccheck( NF90_INQ_VARID(ncid, 'zpowtratot', zpowtratot_varid) ) - call nccheck( NF90_INQ_VARID(ncid, 'zpowtratoc', zpowtratoc_varid) ) - !--- non-aqueous sediment tracers - call nccheck( NF90_INQ_VARID(ncid, 'zsedlayto', zsedlayto_varid) ) - call nccheck( NF90_INQ_VARID(ncid, 'zburial', zburial_varid) ) - call nccheck( NF90_INQ_VARID(ncid, 'zsedhplto', zsedhplto_varid) ) -#endif + + if (.not. use_sedbypass) then + !--- aqueous sediment tracers + call nccheck( NF90_INQ_VARID(ncid, 'zsedtotvol', zsedtotvol_varid) ) + call nccheck( NF90_INQ_VARID(ncid, 'zpowtratot', zpowtratot_varid) ) + call nccheck( NF90_INQ_VARID(ncid, 'zpowtratoc', zpowtratoc_varid) ) + !--- non-aqueous sediment tracers + call nccheck( NF90_INQ_VARID(ncid, 'zsedlayto', zsedlayto_varid) ) + call nccheck( NF90_INQ_VARID(ncid, 'zburial', zburial_varid) ) + call nccheck( NF90_INQ_VARID(ncid, 'zsedhplto', zsedhplto_varid) ) + end if + !--- Inquire varid : ocean tracers call nccheck( NF90_INQ_VARID(ncid, "ztotvol", ztotvol_varid) ) call nccheck( NF90_INQ_VARID(ncid, "zt_sco212", zt_sco212_varid) ) @@ -1554,58 +1561,58 @@ subroutine write_netcdf(iogrp) call nccheck( NF90_INQ_VARID(ncid, "zc_prefdic", zc_prefdic_varid) ) call nccheck( NF90_INQ_VARID(ncid, "zt_dicsat", zt_dicsat_varid) ) call nccheck( NF90_INQ_VARID(ncid, "zc_dicsat", zc_dicsat_varid) ) -#ifdef cisonew - call nccheck( NF90_INQ_VARID(ncid, "zt_sco213", zt_sco213_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_sco213", zc_sco213_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_sco214", zt_sco214_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_sco214", zc_sco214_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_doc13", zt_doc13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_doc13", zc_doc13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_doc14", zt_doc14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_doc14", zc_doc14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_poc13", zt_poc13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_poc13", zc_poc13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_poc14", zt_poc14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_poc14", zc_poc14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phyto13", zt_phyto13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phyto13", zc_phyto13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phyto14", zt_phyto14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phyto14", zc_phyto14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_grazer13", zt_grazer13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_grazer13", zc_grazer13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_grazer14", zt_grazer14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_grazer14", zc_grazer14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_calciu13", zt_calciu13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_calciu13", zc_calciu13_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_calciu14", zt_calciu14_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_calciu14", zc_calciu14_varid) ) -#endif -#ifdef AGG - call nccheck( NF90_INQ_VARID(ncid, "zt_snos", zt_snos_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_snos", zc_snos_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_adust", zt_adust_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_adust", zc_adust_varid) ) -#endif -#ifdef CFC - call nccheck( NF90_INQ_VARID(ncid, "zt_cfc11", zt_cfc11_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_cfc11", zc_cfc11_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_cfc12", zt_cfc12_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_cfc12", zc_cfc12_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_sf6", zt_sf6_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_sf6", zc_sf6_varid) ) -#endif -#ifdef natDIC - call nccheck( NF90_INQ_VARID(ncid, "zt_natsco212", zt_natsco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_natsco212", zc_natsco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_natalkali", zt_natalkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_natalkali", zc_natalkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_natcalciu", zt_natcalciu_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_natcalciu", zc_natcalciu_varid) ) -#endif -#ifdef BROMO - call nccheck( NF90_INQ_VARID(ncid, "zt_bromo", zt_bromo_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_bromo", zc_bromo_varid) ) -#endif + if (use_cisonew) then + call nccheck( NF90_INQ_VARID(ncid, "zt_sco213", zt_sco213_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_sco213", zc_sco213_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_sco214", zt_sco214_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_sco214", zc_sco214_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_doc13", zt_doc13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_doc13", zc_doc13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_doc14", zt_doc14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_doc14", zc_doc14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_poc13", zt_poc13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_poc13", zc_poc13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_poc14", zt_poc14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_poc14", zc_poc14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phyto13", zt_phyto13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phyto13", zc_phyto13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phyto14", zt_phyto14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phyto14", zc_phyto14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_grazer13", zt_grazer13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_grazer13", zc_grazer13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_grazer14", zt_grazer14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_grazer14", zc_grazer14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_calciu13", zt_calciu13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_calciu13", zc_calciu13_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_calciu14", zt_calciu14_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_calciu14", zc_calciu14_varid) ) + end if + if (use_AGG) then + call nccheck( NF90_INQ_VARID(ncid, "zt_snos", zt_snos_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_snos", zc_snos_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_adust", zt_adust_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_adust", zc_adust_varid) ) + end if + if (use_CFC) then + call nccheck( NF90_INQ_VARID(ncid, "zt_cfc11", zt_cfc11_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_cfc11", zc_cfc11_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_cfc12", zt_cfc12_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_cfc12", zc_cfc12_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_sf6", zt_sf6_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_sf6", zc_sf6_varid) ) + end if + if (use_natDIC) then + call nccheck( NF90_INQ_VARID(ncid, "zt_natsco212", zt_natsco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_natsco212", zc_natsco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_natalkali", zt_natalkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_natalkali", zc_natalkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_natcalciu", zt_natcalciu_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_natcalciu", zc_natcalciu_varid) ) + end if + if (use_BROMO) then + call nccheck( NF90_INQ_VARID(ncid, "zt_bromo", zt_bromo_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_bromo", zc_bromo_varid) ) + end if !--- Inquire varid : sum of inventory call nccheck( NF90_INQ_VARID(ncid, "totcarb", totcarb_varid) ) call nccheck( NF90_INQ_VARID(ncid, "totphos", totphos_varid) ) @@ -1624,33 +1631,33 @@ subroutine write_netcdf(iogrp) !=== Increment record by 1, reset start and count arrays ncrec(iogrp) = ncrec(iogrp) + 1 wrstart = (/ ncrec(iogrp) /) -#ifndef sedbypass - zpowtra_wrstart = (/ 1, ncrec(iogrp) /) - zpowtra_count = (/ npowtra, 1 /) - zsedtra_wrstart = (/ 1, ncrec(iogrp) /) - zsedtra_count = (/ nsedtra, 1 /) -#endif + if (.not. use_sedbypass) then + zpowtra_wrstart = (/ 1, ncrec(iogrp) /) + zpowtra_count = (/ npowtra, 1 /) + zsedtra_wrstart = (/ 1, ncrec(iogrp) /) + zsedtra_count = (/ nsedtra, 1 /) + end if !=== Write output data to netCDF file !--- Write data : time datenum = time - time0 call nccheck( NF90_PUT_VAR(ncid, time_varid, datenum, start = wrstart) ) -#ifndef sedbypass - !--- aqueous sediment tracers - call nccheck( NF90_PUT_VAR(ncid, zsedtotvol_varid, zsedtotvol, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zpowtratot_varid, zpowtratot, & - & start = zpowtra_wrstart, count = zpowtra_count) ) - call nccheck( NF90_PUT_VAR(ncid, zpowtratoc_varid, zpowtratoc, & - & start = zpowtra_wrstart, count = zpowtra_count) ) - !--- non-aqueous sediment tracers - call nccheck( NF90_PUT_VAR(ncid, zsedlayto_varid, zsedlayto, & - & start = zsedtra_wrstart, count = zsedtra_count) ) - call nccheck( NF90_PUT_VAR(ncid, zburial_varid, zburial, & - & start = zsedtra_wrstart, count = zsedtra_count) ) - call nccheck( NF90_PUT_VAR(ncid, zsedhplto_varid, zsedhplto, & - & start = wrstart) ) -#endif + if (.not. use_sedbypass) then + !--- aqueous sediment tracers + call nccheck( NF90_PUT_VAR(ncid, zsedtotvol_varid, zsedtotvol, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zpowtratot_varid, zpowtratot, & + & start = zpowtra_wrstart, count = zpowtra_count) ) + call nccheck( NF90_PUT_VAR(ncid, zpowtratoc_varid, zpowtratoc, & + & start = zpowtra_wrstart, count = zpowtra_count) ) + !--- non-aqueous sediment tracers + call nccheck( NF90_PUT_VAR(ncid, zsedlayto_varid, zsedlayto, & + & start = zsedtra_wrstart, count = zsedtra_count) ) + call nccheck( NF90_PUT_VAR(ncid, zburial_varid, zburial, & + & start = zsedtra_wrstart, count = zsedtra_count) ) + call nccheck( NF90_PUT_VAR(ncid, zsedhplto_varid, zsedhplto, & + & start = wrstart) ) + end if !--- Write data : ocean tracers call nccheck( NF90_PUT_VAR(ncid, ztotvol_varid, ztotvol, start = wrstart) ) call nccheck( NF90_PUT_VAR(ncid, zt_sco212_varid, & @@ -1741,100 +1748,100 @@ subroutine write_netcdf(iogrp) & zocetratot(idicsat), start = wrstart) ) call nccheck( NF90_PUT_VAR(ncid, zc_dicsat_varid, & & zocetratoc(idicsat), start = wrstart) ) -#ifdef cisonew - call nccheck( NF90_PUT_VAR(ncid, zt_sco213_varid, & - & zocetratot(isco213), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_sco213_varid, & - & zocetratoc(isco213), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_sco214_varid, & - & zocetratot(isco214), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_sco214_varid, & - & zocetratoc(isco214), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_doc13_varid, & - & zocetratot(idoc13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_doc13_varid, & - & zocetratoc(idoc13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_doc14_varid, & - & zocetratot(idoc14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_doc14_varid, & - & zocetratoc(idoc14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_poc13_varid, & - & zocetratot(idet13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_poc13_varid, & - & zocetratoc(idet13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_poc14_varid, & - & zocetratot(idet14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_poc14_varid, & - & zocetratoc(idet14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phyto13_varid, & - & zocetratot(iphy13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phyto13_varid, & - & zocetratoc(iphy13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phyto14_varid, & - & zocetratot(iphy14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phyto14_varid, & - & zocetratoc(iphy14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_grazer13_varid, & - & zocetratot(izoo13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_grazer13_varid, & - & zocetratoc(izoo13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_grazer14_varid, & - & zocetratot(izoo14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_grazer14_varid, & - & zocetratoc(izoo14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_calciu13_varid, & - & zocetratot(icalc13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_calciu13_varid, & - & zocetratoc(icalc13), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_calciu14_varid, & - & zocetratot(icalc14), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_calciu14_varid, & - & zocetratoc(icalc14), start = wrstart) ) -#endif -#ifdef AGG - call nccheck( NF90_PUT_VAR(ncid, zt_snos_varid, & - & zocetratot(inos), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_snos_varid, & - & zocetratoc(inos), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_adust_varid, & - & zocetratot(iadust), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_adust_varid, & - & zocetratoc(iadust), start = wrstart) ) -#endif -#ifdef CFC - call nccheck( NF90_PUT_VAR(ncid, zt_cfc11_varid, & - & zocetratot(icfc11), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_cfc11_varid, & - & zocetratoc(icfc11), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_cfc12_varid, & - & zocetratot(icfc12), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_cfc12_varid, & - & zocetratoc(icfc12), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_sf6_varid, & - & zocetratot(isf6), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_sf6_varid, & - & zocetratoc(isf6), start = wrstart) ) -#endif -#ifdef natDIC - call nccheck( NF90_PUT_VAR(ncid, zt_natsco212_varid, & - & zocetratot(inatsco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_natsco212_varid, & - & zocetratoc(inatsco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_natalkali_varid, & - & zocetratot(inatalkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_natalkali_varid, & - & zocetratoc(inatalkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_natcalciu_varid, & - & zocetratot(inatcalc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_natcalciu_varid, & - & zocetratoc(inatcalc), start = wrstart) ) -#endif -#ifdef BROMO - call nccheck( NF90_PUT_VAR(ncid, zt_bromo_varid, & - & zocetratot(ibromo), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_bromo_varid, & - & zocetratoc(ibromo), start = wrstart) ) -#endif + if (use_cisonew) then + call nccheck( NF90_PUT_VAR(ncid, zt_sco213_varid, & + & zocetratot(isco213), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_sco213_varid, & + & zocetratoc(isco213), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_sco214_varid, & + & zocetratot(isco214), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_sco214_varid, & + & zocetratoc(isco214), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_doc13_varid, & + & zocetratot(idoc13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_doc13_varid, & + & zocetratoc(idoc13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_doc14_varid, & + & zocetratot(idoc14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_doc14_varid, & + & zocetratoc(idoc14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_poc13_varid, & + & zocetratot(idet13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_poc13_varid, & + & zocetratoc(idet13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_poc14_varid, & + & zocetratot(idet14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_poc14_varid, & + & zocetratoc(idet14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phyto13_varid, & + & zocetratot(iphy13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phyto13_varid, & + & zocetratoc(iphy13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phyto14_varid, & + & zocetratot(iphy14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phyto14_varid, & + & zocetratoc(iphy14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_grazer13_varid, & + & zocetratot(izoo13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_grazer13_varid, & + & zocetratoc(izoo13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_grazer14_varid, & + & zocetratot(izoo14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_grazer14_varid, & + & zocetratoc(izoo14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_calciu13_varid, & + & zocetratot(icalc13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_calciu13_varid, & + & zocetratoc(icalc13), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_calciu14_varid, & + & zocetratot(icalc14), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_calciu14_varid, & + & zocetratoc(icalc14), start = wrstart) ) + end if + if (use_AGG) then + call nccheck( NF90_PUT_VAR(ncid, zt_snos_varid, & + & zocetratot(inos), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_snos_varid, & + & zocetratoc(inos), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_adust_varid, & + & zocetratot(iadust), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_adust_varid, & + & zocetratoc(iadust), start = wrstart) ) + end if + if (use_CFC) then + call nccheck( NF90_PUT_VAR(ncid, zt_cfc11_varid, & + & zocetratot(icfc11), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_cfc11_varid, & + & zocetratoc(icfc11), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_cfc12_varid, & + & zocetratot(icfc12), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_cfc12_varid, & + & zocetratoc(icfc12), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_sf6_varid, & + & zocetratot(isf6), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_sf6_varid, & + & zocetratoc(isf6), start = wrstart) ) + end if + if (use_natDIC) then + call nccheck( NF90_PUT_VAR(ncid, zt_natsco212_varid, & + & zocetratot(inatsco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_natsco212_varid, & + & zocetratoc(inatsco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_natalkali_varid, & + & zocetratot(inatalkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_natalkali_varid, & + & zocetratoc(inatalkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_natcalciu_varid, & + & zocetratot(inatcalc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_natcalciu_varid, & + & zocetratoc(inatcalc), start = wrstart) ) + end if + if (use_BROMO) then + call nccheck( NF90_PUT_VAR(ncid, zt_bromo_varid, & + & zocetratot(ibromo), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_bromo_varid, & + & zocetratoc(ibromo), start = wrstart) ) + end if !--- Write data : sum of inventory call nccheck( NF90_PUT_VAR(ncid, totcarb_varid, totalcarbon, & & start = wrstart) ) @@ -1894,4 +1901,3 @@ end subroutine nccheck END SUBROUTINE INVENTORY_BGC - diff --git a/hamocc/mo_apply_ndep.F90 b/hamocc/mo_apply_ndep.F90 index 36d7159b..6a2e8f0c 100644 --- a/hamocc/mo_apply_ndep.F90 +++ b/hamocc/mo_apply_ndep.F90 @@ -88,6 +88,7 @@ subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) use mo_control_bgc, only: io_stdo_bgc,dtb,do_ndep use mo_carbch, only: ocetra,ndepflx use mo_param1_bgc, only: iano3,ialkali,inatalkali + use mo_control_bgc, only: use_natDIC implicit none @@ -113,9 +114,9 @@ subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) ndepflx(i,j) = ndep(i,j)*dtb/365. ocetra(i,j,1,iano3)=ocetra(i,j,1,iano3)+ndepflx(i,j)/pddpo(i,j,1) ocetra(i,j,1,ialkali)=ocetra(i,j,1,ialkali)-ndepflx(i,j)/pddpo(i,j,1) -#ifdef natDIC - ocetra(i,j,1,inatalkali)=ocetra(i,j,1,inatalkali)-ndepflx(i,j)/pddpo(i,j,1) -#endif + if (use_natDIC) then + ocetra(i,j,1,inatalkali)=ocetra(i,j,1,inatalkali)-ndepflx(i,j)/pddpo(i,j,1) + end if endif enddo enddo diff --git a/hamocc/mo_apply_rivin.F90 b/hamocc/mo_apply_rivin.F90 index d81999b7..f429fa78 100644 --- a/hamocc/mo_apply_rivin.F90 +++ b/hamocc/mo_apply_rivin.F90 @@ -86,16 +86,15 @@ subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) ! *REAL* *rivin* - riverine input field [kmol m-2 yr-1] ! !-------------------------------------------------------------------------------- - use mo_control_bgc, only: dtb,do_rivinpt + use mo_control_bgc, only: dtb,do_rivinpt,use_cisonew use mo_param1_bgc, only: nriv,irdin,irdip,irsi,iralk,iriron,irdoc,irdet, & iano3,iphosph,isilica,isco212,iiron,idoc,idet, & ialkali,inatsco212,inatalkali -#ifdef cisonew + ! cisonew use mo_param1_bgc, only: idet13,idet14,idoc13,idoc14,isco213,isco214,safediv -#endif - use mo_vgrid, only: kmle use mo_carbch, only: ocetra,rivinflx + use mo_control_bgc, only: use_natDIC implicit none @@ -128,28 +127,29 @@ subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) volij=volij+pddpo(i,j,k) ENDDO -#ifdef cisonew - ocetra(i,j,1:kmle(i,j),isco213) = ocetra(i,j,1:kmle(i,j),isco213) + & - ocetra(i,j,1:kmle(i,j),isco213)/(ocetra(i,j,1:kmle(i,j),isco212)+safediv)* & - (rivin(i,j,iralk)*fdt/volij + rivin(i,j,irdin)*fdt/volij + rivin(i,j,irdip)*fdt/volij) - ocetra(i,j,1:kmle(i,j),isco214) = ocetra(i,j,1:kmle(i,j),isco214) + & - ocetra(i,j,1:kmle(i,j),isco214)/(ocetra(i,j,1:kmle(i,j),isco212)+safediv)* & - (rivin(i,j,iralk)*fdt/volij + rivin(i,j,irdin)*fdt/volij + rivin(i,j,irdip)*fdt/volij) - - ocetra(i,j,1:kmle(i,j),idoc13) = ocetra(i,j,1:kmle(i,j),idoc13) + & - ocetra(i,j,1:kmle(i,j),idoc13)/(ocetra(i,j,1:kmle(i,j),idoc)+safediv)* & - rivin(i,j,irdoc)*fdt/volij - ocetra(i,j,1:kmle(i,j),idoc14) = ocetra(i,j,1:kmle(i,j),idoc14) + & - ocetra(i,j,1:kmle(i,j),idoc14)/(ocetra(i,j,1:kmle(i,j),idoc)+safediv)* & - rivin(i,j,irdoc)*fdt/volij - - ocetra(i,j,1:kmle(i,j),idet13) = ocetra(i,j,1:kmle(i,j),idet13) + & - ocetra(i,j,1:kmle(i,j),idet13)/(ocetra(i,j,1:kmle(i,j),idet)+safediv)* & - rivin(i,j,irdet)*fdt/volij - ocetra(i,j,1:kmle(i,j),idet14) = ocetra(i,j,1:kmle(i,j),idet14) + & - ocetra(i,j,1:kmle(i,j),idet14)/(ocetra(i,j,1:kmle(i,j),idet)+safediv)* & - rivin(i,j,irdet)*fdt/volij -#endif + if (use_cisonew) then + ocetra(i,j,1:kmle(i,j),isco213) = ocetra(i,j,1:kmle(i,j),isco213) + & + ocetra(i,j,1:kmle(i,j),isco213)/(ocetra(i,j,1:kmle(i,j),isco212)+safediv)* & + (rivin(i,j,iralk)*fdt/volij + rivin(i,j,irdin)*fdt/volij + rivin(i,j,irdip)*fdt/volij) + ocetra(i,j,1:kmle(i,j),isco214) = ocetra(i,j,1:kmle(i,j),isco214) + & + ocetra(i,j,1:kmle(i,j),isco214)/(ocetra(i,j,1:kmle(i,j),isco212)+safediv)* & + (rivin(i,j,iralk)*fdt/volij + rivin(i,j,irdin)*fdt/volij + rivin(i,j,irdip)*fdt/volij) + + ocetra(i,j,1:kmle(i,j),idoc13) = ocetra(i,j,1:kmle(i,j),idoc13) + & + ocetra(i,j,1:kmle(i,j),idoc13)/(ocetra(i,j,1:kmle(i,j),idoc)+safediv)* & + rivin(i,j,irdoc)*fdt/volij + ocetra(i,j,1:kmle(i,j),idoc14) = ocetra(i,j,1:kmle(i,j),idoc14) + & + ocetra(i,j,1:kmle(i,j),idoc14)/(ocetra(i,j,1:kmle(i,j),idoc)+safediv)* & + rivin(i,j,irdoc)*fdt/volij + + ocetra(i,j,1:kmle(i,j),idet13) = ocetra(i,j,1:kmle(i,j),idet13) + & + ocetra(i,j,1:kmle(i,j),idet13)/(ocetra(i,j,1:kmle(i,j),idet)+safediv)* & + rivin(i,j,irdet)*fdt/volij + ocetra(i,j,1:kmle(i,j),idet14) = ocetra(i,j,1:kmle(i,j),idet14) + & + ocetra(i,j,1:kmle(i,j),idet14)/(ocetra(i,j,1:kmle(i,j),idet)+safediv)* & + rivin(i,j,irdet)*fdt/volij + end if + ! DIC is updated using the assumtions that a_t=a_c+a_n and DIC=a_c (a_t: total ! alkalinity, a_c: carbonate alkalinity, a_n: contribution of nutrients to a_t). ocetra(i,j,1:kmle(i,j),iano3) = ocetra(i,j,1:kmle(i,j),iano3) + rivin(i,j,irdin)*fdt/volij @@ -159,12 +159,12 @@ subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + rivin(i,j,irdin)*fdt/volij & + rivin(i,j,irdip)*fdt/volij ocetra(i,j,1:kmle(i,j),ialkali) = ocetra(i,j,1:kmle(i,j),ialkali) + rivin(i,j,iralk)*fdt/volij -#ifdef natDIC - ocetra(i,j,1:kmle(i,j),inatsco212) = ocetra(i,j,1:kmle(i,j),inatsco212) + rivin(i,j,iralk)*fdt/volij & - + rivin(i,j,irdin)*fdt/volij & - + rivin(i,j,irdip)*fdt/volij - ocetra(i,j,1:kmle(i,j),inatalkali) = ocetra(i,j,1:kmle(i,j),inatalkali) + rivin(i,j,iralk)*fdt/volij -#endif + if (use_natDIC) then + ocetra(i,j,1:kmle(i,j),inatsco212) = ocetra(i,j,1:kmle(i,j),inatsco212) + rivin(i,j,iralk)*fdt/volij & + + rivin(i,j,irdin)*fdt/volij & + + rivin(i,j,irdip)*fdt/volij + ocetra(i,j,1:kmle(i,j),inatalkali) = ocetra(i,j,1:kmle(i,j),inatalkali) + rivin(i,j,iralk)*fdt/volij + end if ocetra(i,j,1:kmle(i,j),iiron) = ocetra(i,j,1:kmle(i,j),iiron) + rivin(i,j,iriron)*fdt/volij*dFe_frac ocetra(i,j,1:kmle(i,j),idoc) = ocetra(i,j,1:kmle(i,j),idoc) + rivin(i,j,irdoc)*fdt/volij ocetra(i,j,1:kmle(i,j),idet) = ocetra(i,j,1:kmle(i,j),idet) + rivin(i,j,irdet)*fdt/volij diff --git a/hamocc/mo_bgcmean.F90 b/hamocc/mo_bgcmean.F90 index 08cc202f..acb68e26 100644 --- a/hamocc/mo_bgcmean.F90 +++ b/hamocc/mo_bgcmean.F90 @@ -58,6 +58,7 @@ MODULE mo_bgcmean use mod_nctools, only: ncpack,nccomp,nccopa,ncwrtr use netcdf, only: nf90_fill_double use mo_param1_bgc, only: ks + use mo_control_bgc, only: use_sedbypass,use_cisonew,use_CFC,use_natDIC,use_BROMO,use_BOXATM,use_AGG IMPLICIT NONE @@ -676,62 +677,62 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) jcalflx4000(n)=i_bsc_m2d*min(1,FLX_CAL4000(n)) IF (FLX_CAL_BOT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 jcalflx_bot(n)=i_bsc_m2d*min(1,FLX_CAL_BOT(n)) -#ifndef sedbypass - IF (FLX_SEDIFFIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffic(n)=i_bsc_m2d*min(1,FLX_SEDIFFIC(n)) - IF (FLX_SEDIFFAL(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffal(n)=i_bsc_m2d*min(1,FLX_SEDIFFAL(n)) - IF (FLX_SEDIFFPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffph(n)=i_bsc_m2d*min(1,FLX_SEDIFFph(n)) - IF (FLX_SEDIFFOX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffox(n)=i_bsc_m2d*min(1,FLX_SEDIFFOX(n)) - IF (FLX_SEDIFFN2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffn2(n)=i_bsc_m2d*min(1,FLX_SEDIFFN2(n)) - IF (FLX_SEDIFFNO3(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffno3(n)=i_bsc_m2d*min(1,FLX_SEDIFFNO3(n)) - IF (FLX_SEDIFFSI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsediffsi(n)=i_bsc_m2d*min(1,FLX_SEDIFFSI(n)) -#endif -#ifdef cisonew - IF (SRF_CO213FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco213fxd(n)=i_bsc_m2d*min(1,SRF_CO213FXD(n)) - IF (SRF_CO213FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco213fxu(n)=i_bsc_m2d*min(1,SRF_CO213FXU(n)) - IF (SRF_CO214FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco214fxd(n)=i_bsc_m2d*min(1,SRF_CO214FXD(n)) - IF (SRF_CO214FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco214fxu(n)=i_bsc_m2d*min(1,SRF_CO214FXU(n)) -#endif -#ifdef CFC - IF (SRF_CFC11(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcfc11fx(n)=i_bsc_m2d*min(1,SRF_CFC11(n)) - IF (SRF_CFC12(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcfc12fx(n)=i_bsc_m2d*min(1,SRF_CFC12(n)) - IF (SRF_SF6(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsf6fx(n)=i_bsc_m2d*min(1,SRF_SF6(n)) -#endif -#ifdef natDIC - IF (SRF_NATDIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfnatdic(n)=i_bsc_m2d*min(1,SRF_NATDIC(n)) - IF (SRF_NATALKALI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfnatalk(n)=i_bsc_m2d*min(1,SRF_NATALKALI(n)) - IF (SRF_NATPCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jnatpco2(n)=i_bsc_m2d*min(1,SRF_NATPCO2(n)) - IF (SRF_NATCO2FX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jnatco2fx(n)=i_bsc_m2d*min(1,SRF_NATCO2FX(n)) - IF (SRF_NATPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfnatph(n)=i_bsc_m2d*min(1,SRF_NATPH(n)) -#endif -#ifdef BROMO - IF (SRF_BROMO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfbromo(n)=i_bsc_m2d*min(1,SRF_BROMO(n)) - IF (SRF_BROMOFX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbromofx(n)=i_bsc_m2d*min(1,SRF_BROMOFX(n)) - IF (INT_BROMOPRO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbromo_prod(n)=i_bsc_m2d*min(1,INT_BROMOPRO(n)) - IF (INT_BROMOUV(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbromo_uv(n)=i_bsc_m2d*min(1,INT_BROMOUV(n)) -#endif + if (.not. use_sedbypass) then + IF (FLX_SEDIFFIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffic(n)=i_bsc_m2d*min(1,FLX_SEDIFFIC(n)) + IF (FLX_SEDIFFAL(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffal(n)=i_bsc_m2d*min(1,FLX_SEDIFFAL(n)) + IF (FLX_SEDIFFPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffph(n)=i_bsc_m2d*min(1,FLX_SEDIFFph(n)) + IF (FLX_SEDIFFOX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffox(n)=i_bsc_m2d*min(1,FLX_SEDIFFOX(n)) + IF (FLX_SEDIFFN2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffn2(n)=i_bsc_m2d*min(1,FLX_SEDIFFN2(n)) + IF (FLX_SEDIFFNO3(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffno3(n)=i_bsc_m2d*min(1,FLX_SEDIFFNO3(n)) + IF (FLX_SEDIFFSI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsediffsi(n)=i_bsc_m2d*min(1,FLX_SEDIFFSI(n)) + end if + if (use_cisonew) then + IF (SRF_CO213FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco213fxd(n)=i_bsc_m2d*min(1,SRF_CO213FXD(n)) + IF (SRF_CO213FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco213fxu(n)=i_bsc_m2d*min(1,SRF_CO213FXU(n)) + IF (SRF_CO214FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco214fxd(n)=i_bsc_m2d*min(1,SRF_CO214FXD(n)) + IF (SRF_CO214FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco214fxu(n)=i_bsc_m2d*min(1,SRF_CO214FXU(n)) + end if + if (use_CFC) then + IF (SRF_CFC11(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcfc11fx(n)=i_bsc_m2d*min(1,SRF_CFC11(n)) + IF (SRF_CFC12(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcfc12fx(n)=i_bsc_m2d*min(1,SRF_CFC12(n)) + IF (SRF_SF6(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsf6fx(n)=i_bsc_m2d*min(1,SRF_SF6(n)) + end if + if (use_natDIC) then + IF (SRF_NATDIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfnatdic(n)=i_bsc_m2d*min(1,SRF_NATDIC(n)) + IF (SRF_NATALKALI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfnatalk(n)=i_bsc_m2d*min(1,SRF_NATALKALI(n)) + IF (SRF_NATPCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jnatpco2(n)=i_bsc_m2d*min(1,SRF_NATPCO2(n)) + IF (SRF_NATCO2FX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jnatco2fx(n)=i_bsc_m2d*min(1,SRF_NATCO2FX(n)) + IF (SRF_NATPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfnatph(n)=i_bsc_m2d*min(1,SRF_NATPH(n)) + end if + if (use_BROMO ) then + IF (SRF_BROMO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfbromo(n)=i_bsc_m2d*min(1,SRF_BROMO(n)) + IF (SRF_BROMOFX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbromofx(n)=i_bsc_m2d*min(1,SRF_BROMOFX(n)) + IF (INT_BROMOPRO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbromo_prod(n)=i_bsc_m2d*min(1,INT_BROMOPRO(n)) + IF (INT_BROMOUV(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbromo_uv(n)=i_bsc_m2d*min(1,INT_BROMOUV(n)) + end if ENDDO domassfluxes = any( & @@ -746,22 +747,22 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) DO n=1,nbgc IF (SRF_ATMCO2(n).GT.0) i_atm_m2d=i_atm_m2d+1 jatmco2(n)=i_atm_m2d*min(1,SRF_ATMCO2(n)) -#if defined(BOXATM) - IF (SRF_ATMO2(n).GT.0) i_atm_m2d=i_atm_m2d+1 - jatmo2(n)=i_atm_m2d*min(1,SRF_ATMO2(n)) - IF (SRF_ATMN2(n).GT.0) i_atm_m2d=i_atm_m2d+1 - jatmn2(n)=i_atm_m2d*min(1,SRF_ATMN2(n)) -#endif -#ifdef cisonew - IF (SRF_ATMC13(n).GT.0) i_atm_m2d=i_atm_m2d+1 - jatmc13(n)=i_atm_m2d*min(1,SRF_ATMC13(n)) - IF (SRF_ATMC14(n).GT.0) i_atm_m2d=i_atm_m2d+1 - jatmc14(n)=i_atm_m2d*min(1,SRF_ATMC14(n)) -#endif -#if defined(BROMO) - IF (SRF_ATMBROMO(n).GT.0) i_atm_m2d=i_atm_m2d+1 - jatmbromo(n)=i_atm_m2d*min(1,SRF_ATMBROMO(n)) -#endif + if (use_BOXATM) then + IF (SRF_ATMO2(n).GT.0) i_atm_m2d=i_atm_m2d+1 + jatmo2(n)=i_atm_m2d*min(1,SRF_ATMO2(n)) + IF (SRF_ATMN2(n).GT.0) i_atm_m2d=i_atm_m2d+1 + jatmn2(n)=i_atm_m2d*min(1,SRF_ATMN2(n)) + end if + if (use_cisonew) then + IF (SRF_ATMC13(n).GT.0) i_atm_m2d=i_atm_m2d+1 + jatmc13(n)=i_atm_m2d*min(1,SRF_ATMC13(n)) + IF (SRF_ATMC14(n).GT.0) i_atm_m2d=i_atm_m2d+1 + jatmc14(n)=i_atm_m2d*min(1,SRF_ATMC14(n)) + end if + if (use_BROMO ) then + IF (SRF_ATMBROMO(n).GT.0) i_atm_m2d=i_atm_m2d+1 + jatmbromo(n)=i_atm_m2d*min(1,SRF_ATMBROMO(n)) + end if ENDDO i_atm_m2d=i_atm_m2d-i_bsc_m2d @@ -822,68 +823,68 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) jdicsat(n)=i_bsc_m3d*min(1,LYR_DICSAT(n)) IF (LYR_DP(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 jdp(n)=i_bsc_m3d*min(1,LYR_DP(n)) -#ifdef CFC - IF (LYR_CFC11(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jcfc11(n)=i_bsc_m3d*min(1,LYR_CFC11(n)) - IF (LYR_CFC12(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jcfc12(n)=i_bsc_m3d*min(1,LYR_CFC12(n)) - IF (LYR_SF6(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jsf6(n)=i_bsc_m3d*min(1,LYR_SF6(n)) -#endif -#ifdef cisonew - IF (LYR_DIC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jdic13(n)=i_bsc_m3d*min(1,LYR_DIC13(n)) - IF (LYR_DIC14(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jdic14(n)=i_bsc_m3d*min(1,LYR_DIC14(n)) - IF (LYR_D13C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jd13c(n)=i_bsc_m3d*min(1,LYR_D13C(n)) - IF (LYR_D14C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jd14c(n)=i_bsc_m3d*min(1,LYR_D14C(n)) - IF (LYR_BIGD14C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jbigd14c(n)=i_bsc_m3d*min(1,LYR_BIGD14C(n)) - IF (LYR_POC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jpoc13(n)=i_bsc_m3d*min(1,LYR_POC13(n)) - IF (LYR_DOC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jdoc13(n)=i_bsc_m3d*min(1,LYR_DOC13(n)) - IF (LYR_CALC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jcalc13(n)=i_bsc_m3d*min(1,LYR_CALC13(n)) - IF (LYR_PHYTO13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jphyto13(n)=i_bsc_m3d*min(1,LYR_PHYTO13(n)) - IF (LYR_GRAZER13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jgrazer13(n)=i_bsc_m3d*min(1,LYR_GRAZER13(n)) -#endif -#ifdef AGG - IF (LYR_NOS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnos(n)=i_bsc_m3d*min(1,LYR_NOS(n)) - IF (LYR_WPHY(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jwphy(n)=i_bsc_m3d*min(1,LYR_WPHY(n)) - IF (LYR_WNOS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jwnos(n)=i_bsc_m3d*min(1,LYR_WNOS(n)) - IF (LYR_EPS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jeps(n)=i_bsc_m3d*min(1,LYR_EPS(n)) - IF (LYR_ASIZE(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jasize(n)=i_bsc_m3d*min(1,LYR_ASIZE(n)) -#endif -#ifdef natDIC - IF (LYR_NATCO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatco3(n)=i_bsc_m3d*min(1,LYR_NATCO3(n)) - IF (LYR_NATALKALI(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatalkali(n)=i_bsc_m3d*min(1,LYR_NATALKALI(n)) - IF (LYR_NATDIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatdic(n)=i_bsc_m3d*min(1,LYR_NATDIC(n)) - IF (LYR_NATCALC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatcalc(n)=i_bsc_m3d*min(1,LYR_NATCALC(n)) - IF (LYR_NATPH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatph(n)=i_bsc_m3d*min(1,LYR_NATPH(n)) - IF (LYR_NATOMEGAA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatomegaa(n)=i_bsc_m3d*min(1,LYR_NATOMEGAA(n)) - IF (LYR_NATOMEGAC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jnatomegac(n)=i_bsc_m3d*min(1,LYR_NATOMEGAC(n)) -#endif -#ifdef BROMO - IF (LYR_BROMO(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jbromo(n)=i_bsc_m3d*min(1,LYR_BROMO(n)) -#endif + if (use_CFC) then + IF (LYR_CFC11(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jcfc11(n)=i_bsc_m3d*min(1,LYR_CFC11(n)) + IF (LYR_CFC12(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jcfc12(n)=i_bsc_m3d*min(1,LYR_CFC12(n)) + IF (LYR_SF6(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jsf6(n)=i_bsc_m3d*min(1,LYR_SF6(n)) + end if + if (use_cisonew) then + IF (LYR_DIC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jdic13(n)=i_bsc_m3d*min(1,LYR_DIC13(n)) + IF (LYR_DIC14(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jdic14(n)=i_bsc_m3d*min(1,LYR_DIC14(n)) + IF (LYR_D13C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jd13c(n)=i_bsc_m3d*min(1,LYR_D13C(n)) + IF (LYR_D14C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jd14c(n)=i_bsc_m3d*min(1,LYR_D14C(n)) + IF (LYR_BIGD14C(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jbigd14c(n)=i_bsc_m3d*min(1,LYR_BIGD14C(n)) + IF (LYR_POC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jpoc13(n)=i_bsc_m3d*min(1,LYR_POC13(n)) + IF (LYR_DOC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jdoc13(n)=i_bsc_m3d*min(1,LYR_DOC13(n)) + IF (LYR_CALC13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jcalc13(n)=i_bsc_m3d*min(1,LYR_CALC13(n)) + IF (LYR_PHYTO13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jphyto13(n)=i_bsc_m3d*min(1,LYR_PHYTO13(n)) + IF (LYR_GRAZER13(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jgrazer13(n)=i_bsc_m3d*min(1,LYR_GRAZER13(n)) + end if + if (use_AGG) then + IF (LYR_NOS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnos(n)=i_bsc_m3d*min(1,LYR_NOS(n)) + IF (LYR_WPHY(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jwphy(n)=i_bsc_m3d*min(1,LYR_WPHY(n)) + IF (LYR_WNOS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jwnos(n)=i_bsc_m3d*min(1,LYR_WNOS(n)) + IF (LYR_EPS(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jeps(n)=i_bsc_m3d*min(1,LYR_EPS(n)) + IF (LYR_ASIZE(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jasize(n)=i_bsc_m3d*min(1,LYR_ASIZE(n)) + end if + if (use_natDIC) then + IF (LYR_NATCO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatco3(n)=i_bsc_m3d*min(1,LYR_NATCO3(n)) + IF (LYR_NATALKALI(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatalkali(n)=i_bsc_m3d*min(1,LYR_NATALKALI(n)) + IF (LYR_NATDIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatdic(n)=i_bsc_m3d*min(1,LYR_NATDIC(n)) + IF (LYR_NATCALC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatcalc(n)=i_bsc_m3d*min(1,LYR_NATCALC(n)) + IF (LYR_NATPH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatph(n)=i_bsc_m3d*min(1,LYR_NATPH(n)) + IF (LYR_NATOMEGAA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatomegaa(n)=i_bsc_m3d*min(1,LYR_NATOMEGAA(n)) + IF (LYR_NATOMEGAC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jnatomegac(n)=i_bsc_m3d*min(1,LYR_NATOMEGAC(n)) + end if + if (use_BROMO) then + IF (LYR_BROMO(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jbromo(n)=i_bsc_m3d*min(1,LYR_BROMO(n)) + end if IF (LVL_PHYTO(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 jlvlphyto(n)=ilvl_bsc_m3d*min(1,LVL_PHYTO(n)) @@ -935,68 +936,68 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) jlvlprefdic(n)=ilvl_bsc_m3d*min(1,LVL_PREFDIC(n)) IF (LVL_DICSAT(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 jlvldicsat(n)=ilvl_bsc_m3d*min(1,LVL_DICSAT(n)) -#ifdef CFC - IF (LVL_CFC11(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlcfc11(n)=ilvl_bsc_m3d*min(1,LVL_CFC11(n)) - IF (LVL_CFC12(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlcfc12(n)=ilvl_bsc_m3d*min(1,LVL_CFC12(n)) - IF (LVL_SF6(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlsf6(n)=ilvl_bsc_m3d*min(1,LVL_SF6(n)) -#endif -#ifdef cisonew - IF (LVL_DIC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvldic13(n)=ilvl_bsc_m3d*min(1,LVL_DIC13(n)) - IF (LVL_DIC14(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvldic14(n)=ilvl_bsc_m3d*min(1,LVL_DIC14(n)) - IF (LVL_D13C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvld13c(n)=ilvl_bsc_m3d*min(1,LVL_D13C(n)) - IF (LVL_D14C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvld14c(n)=ilvl_bsc_m3d*min(1,LVL_D14C(n)) - IF (LVL_BIGD14C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlbigd14c(n)=ilvl_bsc_m3d*min(1,LVL_BIGD14C(n)) - IF (LVL_POC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlpoc13(n)=ilvl_bsc_m3d*min(1,LVL_POC13(n)) - IF (LVL_DOC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvldoc13(n)=ilvl_bsc_m3d*min(1,LVL_DOC13(n)) - IF (LVL_CALC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlcalc13(n)=ilvl_bsc_m3d*min(1,LVL_CALC13(n)) - IF (LVL_PHYTO13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlphyto13(n)=ilvl_bsc_m3d*min(1,LVL_PHYTO13(n)) - IF (LVL_GRAZER13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlgrazer13(n)=ilvl_bsc_m3d*min(1,LVL_GRAZER13(n)) -#endif -#ifdef AGG - IF (LVL_NOS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnos(n)=ilvl_bsc_m3d*min(1,LVL_NOS(n)) - IF (LVL_WPHY(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlwphy(n)=ilvl_bsc_m3d*min(1,LVL_WPHY(n)) - IF (LVL_WNOS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlwnos(n)=ilvl_bsc_m3d*min(1,LVL_WNOS(n)) - IF (LVL_EPS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvleps(n)=ilvl_bsc_m3d*min(1,LVL_EPS(n)) - IF (LVL_ASIZE(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlasize(n)=ilvl_bsc_m3d*min(1,LVL_ASIZE(n)) -#endif -#ifdef natDIC - IF (LVL_NATCO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatco3(n)=ilvl_bsc_m3d*min(1,LVL_NATCO3(n)) - IF (LVL_NATALKALI(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatalkali(n)=ilvl_bsc_m3d*min(1,LVL_NATALKALI(n)) - IF (LVL_NATDIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatdic(n)=ilvl_bsc_m3d*min(1,LVL_NATDIC(n)) - IF (LVL_NATCALC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatcalc(n)=ilvl_bsc_m3d*min(1,LVL_NATCALC(n)) - IF (LVL_NATPH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatph(n)=ilvl_bsc_m3d*min(1,LVL_NATPH(n)) - IF (LVL_NATOMEGAA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatomegaa(n)=ilvl_bsc_m3d*min(1,LVL_NATOMEGAA(n)) - IF (LVL_NATOMEGAC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlnatomegac(n)=ilvl_bsc_m3d*min(1,LVL_NATOMEGAC(n)) -#endif -#ifdef BROMO - IF (LVL_BROMO(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlbromo(n)=ilvl_bsc_m3d*min(1,LVL_BROMO(n)) -#endif + if (use_CFC) then + IF (LVL_CFC11(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlcfc11(n)=ilvl_bsc_m3d*min(1,LVL_CFC11(n)) + IF (LVL_CFC12(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlcfc12(n)=ilvl_bsc_m3d*min(1,LVL_CFC12(n)) + IF (LVL_SF6(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlsf6(n)=ilvl_bsc_m3d*min(1,LVL_SF6(n)) + end if + if (use_cisonew) then + IF (LVL_DIC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvldic13(n)=ilvl_bsc_m3d*min(1,LVL_DIC13(n)) + IF (LVL_DIC14(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvldic14(n)=ilvl_bsc_m3d*min(1,LVL_DIC14(n)) + IF (LVL_D13C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvld13c(n)=ilvl_bsc_m3d*min(1,LVL_D13C(n)) + IF (LVL_D14C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvld14c(n)=ilvl_bsc_m3d*min(1,LVL_D14C(n)) + IF (LVL_BIGD14C(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlbigd14c(n)=ilvl_bsc_m3d*min(1,LVL_BIGD14C(n)) + IF (LVL_POC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlpoc13(n)=ilvl_bsc_m3d*min(1,LVL_POC13(n)) + IF (LVL_DOC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvldoc13(n)=ilvl_bsc_m3d*min(1,LVL_DOC13(n)) + IF (LVL_CALC13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlcalc13(n)=ilvl_bsc_m3d*min(1,LVL_CALC13(n)) + IF (LVL_PHYTO13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlphyto13(n)=ilvl_bsc_m3d*min(1,LVL_PHYTO13(n)) + IF (LVL_GRAZER13(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlgrazer13(n)=ilvl_bsc_m3d*min(1,LVL_GRAZER13(n)) + end if + if (use_AGG) then + IF (LVL_NOS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnos(n)=ilvl_bsc_m3d*min(1,LVL_NOS(n)) + IF (LVL_WPHY(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlwphy(n)=ilvl_bsc_m3d*min(1,LVL_WPHY(n)) + IF (LVL_WNOS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlwnos(n)=ilvl_bsc_m3d*min(1,LVL_WNOS(n)) + IF (LVL_EPS(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvleps(n)=ilvl_bsc_m3d*min(1,LVL_EPS(n)) + IF (LVL_ASIZE(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlasize(n)=ilvl_bsc_m3d*min(1,LVL_ASIZE(n)) + end if + if (use_natDIC) then + IF (LVL_NATCO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatco3(n)=ilvl_bsc_m3d*min(1,LVL_NATCO3(n)) + IF (LVL_NATALKALI(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatalkali(n)=ilvl_bsc_m3d*min(1,LVL_NATALKALI(n)) + IF (LVL_NATDIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatdic(n)=ilvl_bsc_m3d*min(1,LVL_NATDIC(n)) + IF (LVL_NATCALC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatcalc(n)=ilvl_bsc_m3d*min(1,LVL_NATCALC(n)) + IF (LVL_NATPH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatph(n)=ilvl_bsc_m3d*min(1,LVL_NATPH(n)) + IF (LVL_NATOMEGAA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatomegaa(n)=ilvl_bsc_m3d*min(1,LVL_NATOMEGAA(n)) + IF (LVL_NATOMEGAC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlnatomegac(n)=ilvl_bsc_m3d*min(1,LVL_NATOMEGAC(n)) + end if + if (use_BROMO) then + IF (LVL_BROMO(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlbromo(n)=ilvl_bsc_m3d*min(1,LVL_BROMO(n)) + end if IF (i_bsc_m3d.NE.0) checkdp(n)=1 ENDDO @@ -1012,43 +1013,43 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) i_bsc_sed=0 i_bsc_bur=0 -#ifndef sedbypass - DO n=1,nbgc - IF (SDM_POWAIC(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowaic(n)=i_bsc_sed*min(1,SDM_POWAIC(n)) - IF (SDM_POWAAL(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowaal(n)=i_bsc_sed*min(1,SDM_POWAAL(n)) - IF (SDM_POWAPH(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowaph(n)=i_bsc_sed*min(1,SDM_POWAPH(n)) - IF (SDM_POWAOX(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowaox(n)=i_bsc_sed*min(1,SDM_POWAOX(n)) - IF (SDM_POWN2(n) .GT.0) i_bsc_sed=i_bsc_sed+1 - jpown2(n) =i_bsc_sed*min(1,SDM_POWN2(n)) - IF (SDM_POWNO3(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowno3(n)=i_bsc_sed*min(1,SDM_POWNO3(n)) - IF (SDM_POWASI(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jpowasi(n)=i_bsc_sed*min(1,SDM_POWASI(n)) - IF (SDM_SSSO12(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jssso12(n)=i_bsc_sed*min(1,SDM_SSSO12(n)) - IF (SDM_SSSSIL(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jssssil(n)=i_bsc_sed*min(1,SDM_SSSSIL(n)) - IF (SDM_SSSC12(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jsssc12(n)=i_bsc_sed*min(1,SDM_SSSC12(n)) - IF (SDM_SSSTER(n).GT.0) i_bsc_sed=i_bsc_sed+1 - jssster(n)=i_bsc_sed*min(1,SDM_SSSTER(n)) - ENDDO - - DO n=1,nbgc - IF (BUR_SSSO12(n).GT.0) i_bsc_bur=i_bsc_bur+1 - jburssso12(n)=i_bsc_bur*min(1,BUR_SSSO12(n)) - IF (BUR_SSSC12(n).GT.0) i_bsc_bur=i_bsc_bur+1 - jbursssc12(n)=i_bsc_bur*min(1,BUR_SSSC12(n)) - IF (BUR_SSSSIL(n).GT.0) i_bsc_bur=i_bsc_bur+1 - jburssssil(n)=i_bsc_bur*min(1,BUR_SSSSIL(n)) - IF (BUR_SSSTER(n).GT.0) i_bsc_bur=i_bsc_bur+1 - jburssster(n)=i_bsc_bur*min(1,BUR_SSSTER(n)) - ENDDO -#endif + if (.not. use_sedbypass) then + DO n=1,nbgc + IF (SDM_POWAIC(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowaic(n)=i_bsc_sed*min(1,SDM_POWAIC(n)) + IF (SDM_POWAAL(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowaal(n)=i_bsc_sed*min(1,SDM_POWAAL(n)) + IF (SDM_POWAPH(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowaph(n)=i_bsc_sed*min(1,SDM_POWAPH(n)) + IF (SDM_POWAOX(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowaox(n)=i_bsc_sed*min(1,SDM_POWAOX(n)) + IF (SDM_POWN2(n) .GT.0) i_bsc_sed=i_bsc_sed+1 + jpown2(n) =i_bsc_sed*min(1,SDM_POWN2(n)) + IF (SDM_POWNO3(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowno3(n)=i_bsc_sed*min(1,SDM_POWNO3(n)) + IF (SDM_POWASI(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jpowasi(n)=i_bsc_sed*min(1,SDM_POWASI(n)) + IF (SDM_SSSO12(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jssso12(n)=i_bsc_sed*min(1,SDM_SSSO12(n)) + IF (SDM_SSSSIL(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jssssil(n)=i_bsc_sed*min(1,SDM_SSSSIL(n)) + IF (SDM_SSSC12(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jsssc12(n)=i_bsc_sed*min(1,SDM_SSSC12(n)) + IF (SDM_SSSTER(n).GT.0) i_bsc_sed=i_bsc_sed+1 + jssster(n)=i_bsc_sed*min(1,SDM_SSSTER(n)) + ENDDO + + DO n=1,nbgc + IF (BUR_SSSO12(n).GT.0) i_bsc_bur=i_bsc_bur+1 + jburssso12(n)=i_bsc_bur*min(1,BUR_SSSO12(n)) + IF (BUR_SSSC12(n).GT.0) i_bsc_bur=i_bsc_bur+1 + jbursssc12(n)=i_bsc_bur*min(1,BUR_SSSC12(n)) + IF (BUR_SSSSIL(n).GT.0) i_bsc_bur=i_bsc_bur+1 + jburssssil(n)=i_bsc_bur*min(1,BUR_SSSSIL(n)) + IF (BUR_SSSTER(n).GT.0) i_bsc_bur=i_bsc_bur+1 + jburssster(n)=i_bsc_bur*min(1,BUR_SSSTER(n)) + ENDDO + end if nbgcm2d = i_bsc_m2d+i_atm_m2d nbgcm3d = i_bsc_m3d @@ -1116,32 +1117,32 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) IF (errstat.NE.0) STOP 'not enough memory bgcm3dlvl' IF (nbgcm3dlvl.NE.0) bgcm3dlvl=0. -#ifndef sedbypass - IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgctsed ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgct_sed - ENDIF - - ALLOCATE (bgct_sed(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ks, & - & nbgct_sed),stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgct_sed' - IF (nbgct_sed.NE.0) bgct_sed=0. - - IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgctbur ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct_bur - ENDIF - - ALLOCATE (bgct_bur(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy, & - & nbgct_bur),stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgct_sed' - IF (nbgct_bur.NE.0) bgct_bur=0. -#endif + if (.not. use_sedbypass) then + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgctsed ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgct_sed + ENDIF + + ALLOCATE (bgct_sed(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ks, & + & nbgct_sed),stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgct_sed' + IF (nbgct_sed.NE.0) bgct_sed=0. + + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgctbur ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct_bur + ENDIF + + ALLOCATE (bgct_bur(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy, & + & nbgct_bur),stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgct_sed' + IF (nbgct_bur.NE.0) bgct_bur=0. + end if END SUBROUTINE ALLOC_MEM_BGCMEAN diff --git a/hamocc/mo_biomod.F90 b/hamocc/mo_biomod.F90 index 0703211d..a28e2dc6 100644 --- a/hamocc/mo_biomod.F90 +++ b/hamocc/mo_biomod.F90 @@ -51,9 +51,9 @@ MODULE mo_biomod implicit none REAL, DIMENSION (:,:), ALLOCATABLE :: strahl -#ifdef FB_BGC_OCE + ! FB_BGC_OCE REAL, DIMENSION (:,:,:), ALLOCATABLE :: abs_oce -#endif + ! REAL, DIMENSION (:,:), ALLOCATABLE :: expoor REAL, DIMENSION (:,:), ALLOCATABLE :: expoca REAL, DIMENSION (:,:), ALLOCATABLE :: exposi @@ -82,16 +82,16 @@ MODULE mo_biomod REAL, DIMENSION (:,:), ALLOCATABLE :: calflx4000 REAL, DIMENSION (:,:), ALLOCATABLE :: calflx_bot REAL, DIMENSION (:,:,:), ALLOCATABLE :: phosy3d -#ifdef AGG + + ! AGG REAL, DIMENSION (:,:,:), ALLOCATABLE :: wmass REAL, DIMENSION (:,:,:), ALLOCATABLE :: wnumb REAL, DIMENSION (:,:,:), ALLOCATABLE :: eps3d REAL, DIMENSION (:,:,:), ALLOCATABLE :: asize3d -#endif -#ifdef BROMO + + ! BROMO REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_prod REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_uv -#endif REAL :: phytomi,grami,grazra,pi_alpha REAL :: remido,dyphy,zinges,epsher,spemor,gammap,gammaz,ecan @@ -102,32 +102,29 @@ MODULE mo_biomod REAL :: drempoc,dremopal,dremn2o,dremsul REAL :: perc_diron, riron, fesoly, relaxfe, fetune, wdust REAL :: ctochl, atten_w, atten_c, atten_uv, atten_f -#ifdef cisonew + ! cisonew REAL :: c14fac REAL :: re1312,re14to,prei13,prei14 REAL :: bifr13,bifr14,growth_co2,bifr13_perm -#endif -#ifdef AGG + ! AGG REAL :: SinkExp, FractDim, Stick, cellmass, cellsink, fsh, fse REAL :: alow1, alow2,alow3,alar1,alar2,alar3,TSFac,TMFac REAL :: vsmall,safe,pupper,plower,zdis,nmldmin REAL :: dustd1,dustd2,dustd3,dustsink,calmax -#elif defined(WLIN) + ! WLIN REAL :: wmin,wmax,wlin -#endif -#ifdef BROMO + ! BROMO REAL :: rbro -#endif CONTAINS - SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) !****************************************************************************** ! ALLOC_MEM_BIOMOD - Allocate variables in this module !****************************************************************************** use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc + use mo_control_bgc, only: use_FB_BGC_OCE,use_AGG,use_BROMO INTEGER, intent(in) :: kpie,kpje,kpke INTEGER :: errstat @@ -151,20 +148,18 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) if(errstat.ne.0) stop 'not enough memory strahl' strahl(:,:) = 0.0 + if (use_FB_BGC_OCE ) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable abs_oce' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF -#ifdef FB_BGC_OCE - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable abs_oce' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (abs_oce(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory abs_oce' - abs_oce(:,:,:) = 0.0 -#endif - + ALLOCATE (abs_oce(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory abs_oce' + abs_oce(:,:,:) = 0.0 + end if IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable expoor ...' @@ -321,69 +316,65 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) if(errstat.ne.0) stop 'not enough memory phosy3d' phosy3d(:,:,:) = 0.0 - -#ifdef AGG - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable wmass ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (wmass(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory eps3d' - wmass(:,:,:) = 0.0 - - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable wnumb ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (wnumb(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory eps3d' - wnumb(:,:,:) = 0.0 - - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable eps3d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (eps3d(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory eps3d' - eps3d(:,:,:) = 0.0 - - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable asize3d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (asize3d(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory asize3d' - asize3d(:,:,:) = 0.0 -#endif - -#ifdef BROMO - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable int_chbr3_prod, int_chbr3_uv ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (int_chbr3_prod(kpie,kpje),stat=errstat) - ALLOCATE (int_chbr3_uv(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory int_chbr3_prod, int_chbr3_uv' - int_chbr3_prod(:,:) = 0.0 - int_chbr3_uv(:,:) = 0.0 -#endif + if (use_AGG) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable wmass ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (wmass(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory eps3d' + wmass(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable wnumb ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (wnumb(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory eps3d' + wnumb(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable eps3d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (eps3d(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory eps3d' + eps3d(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable asize3d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (asize3d(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory asize3d' + asize3d(:,:,:) = 0.0 + end if + + if (use_BROMO) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable int_chbr3_prod, int_chbr3_uv ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (int_chbr3_prod(kpie,kpje),stat=errstat) + ALLOCATE (int_chbr3_uv(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory int_chbr3_prod, int_chbr3_uv' + int_chbr3_prod(:,:) = 0.0 + int_chbr3_uv(:,:) = 0.0 + end if !****************************************************************************** END SUBROUTINE ALLOC_MEM_BIOMOD diff --git a/hamocc/mo_boxatm.F90 b/hamocc/mo_boxatm.F90 index 461fad45..3216dea1 100644 --- a/hamocc/mo_boxatm.F90 +++ b/hamocc/mo_boxatm.F90 @@ -4,16 +4,16 @@ ! This file is part of BLOM/iHAMOCC. ! ! BLOM is free software: you can redistribute it and/or modify it under the -! terms of the GNU Lesser General Public License as published by the Free -! Software Foundation, either version 3 of the License, or (at your option) -! any later version. +! terms of the GNU Lesser General Public License as published by the Free +! Software Foundation, either version 3 of the License, or (at your option) +! any later version. ! -! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY -! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -! more details. +! more details. ! -! You should have received a copy of the GNU Lesser General Public License +! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. @@ -24,7 +24,7 @@ module mo_boxatm ! ! Modified ! -------- -! A. Moree, *GFI, Bergen* 2019-10 +! A. Moree, *GFI, Bergen* 2019-10 ! - 14C source added to atmosphere as the sum of all 14C loss (decay) ! ! J. Schwinger, *NORCE, Bergen* 2023-08-02 @@ -33,18 +33,18 @@ module mo_boxatm ! ! Purpose ! ------- -! - This module contains the routine update_boxatm for updating a +! - This module contains the routine update_boxatm for updating a ! 1-D/scalar/box atmosphere ! ! ! Description ! ----------- ! The global sum of the air-sea C fluxes is calculated, then converted to ppm -! and added to the global atmospheric concentration. For C14, an atmospheric +! and added to the global atmospheric concentration. For C14, an atmospheric ! production term corresponding to the total decay in the ocean (plus sediment ! if activated) is assumed. ! -! +! !****************************************************************************** contains @@ -53,37 +53,28 @@ module mo_boxatm subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) !****************************************************************************** use mod_xc, only: mnproc,nbdy,ips,xcsum - use mo_control_bgc, only: io_stdo_bgc - use mo_carbch, only: atmflx, atm - use mo_param1_bgc, only: iatmco2 -#ifdef cisonew - use mo_param1_bgc, only: iatmc13,iatmc14,isco214,idet14,icalc14,idoc14, & + use mo_control_bgc, only: io_stdo_bgc, use_cisonew, use_sedbypass + use mo_carbch, only: atmflx, atm, c14dec, ocetra + use mo_param1_bgc, only: iatmco2,iatmc13,iatmc14,isco214,idet14,icalc14,idoc14, & iphy14,izoo14,ipowc14,issso14,isssc14 - use mo_carbch, only: c14dec, ocetra use mo_biomod, only: rcar -#ifndef sedbypass use mo_sedmnt, only: powtra,sedlay,seddw,porwat,porsol -#endif -#endif implicit none INTEGER,intent(in) :: kpie,kpje,kpke - REAL, intent(in) :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) - REAL, intent(in) :: pddpo(kpie,kpje,kpke),omask(kpie,kpje) + REAL, intent(in) :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) + REAL, intent(in) :: pddpo(kpie,kpje,kpke),omask(kpie,kpje) REAL, PARAMETER :: pg2ppm = 1.0/2.13 ! conversion factor PgC -> ppm CO2 - INTEGER :: i,j,k REAL :: ztmp1(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) REAL :: co2flux, co2flux_ppm -#ifdef cisonew - REAL :: ztmp2(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - REAL :: co213flux, co213flux_ppm - REAL :: co214flux, co214flux_ppm - REAL :: totc14dec, vol -#endif - + REAL :: ztmp2(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) ! cisonew + REAL :: co213flux, co213flux_ppm ! cisonew + REAL :: co214flux, co214flux_ppm ! cisonew + REAL :: totc14dec, vol ! cisonew + co2flux = 0.0 ! Calculate global total air-sea flux [kmol] @@ -106,71 +97,72 @@ subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) ENDDO ENDDO -#ifdef cisonew - co213flux = 0.0 - co214flux = 0.0 - - ! Calculate global total air-sea flux for C isotopes [kmol] - ztmp1(:,:) = 0.0 - ztmp2(:,:) = 0.0 - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = atmflx(i,j,iatmc13)*pdlxp(i,j)*pdlyp(i,j) ![kmol 13CO2/ m2] * [m] * [m] - ztmp2(i,j) = atmflx(i,j,iatmc14)*pdlxp(i,j)*pdlyp(i,j) ![kmol 14CO2/ m2] * [m] * [m] - ENDDO - ENDDO - - CALL xcsum(co213flux,ztmp1,ips) - CALL xcsum(co214flux,ztmp2,ips) - - ! Convert global CO2 isotope fluxes to ppm isotope fluxes - co213flux_ppm = co213flux*13.*1.e-12*pg2ppm*12./13. ! [kmol 13CO2] -> [ppm] - co214flux_ppm = co214flux*14.*1.e-12*pg2ppm*12./14. ! [kmol 14CO2] -> [ppm] - - ! Calculate sum of 14C decay. Only decay in ocean, so only ocean tracers. - totc14dec = 0.0 - ztmp1(:,:) = 0.0 - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - vol = pdlxp(i,j)*pdlyp(i,j)*pddpo(i,j,k)*omask(i,j) ! ocean volume - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,isco214)*vol*(1.0-c14dec) - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,idet14) *vol*(1.0-c14dec)*rcar - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,icalc14)*vol*(1.0-c14dec) - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,idoc14) *vol*(1.0-c14dec)*rcar - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,iphy14) *vol*(1.0-c14dec)*rcar - ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,izoo14) *vol*(1.0-c14dec)*rcar -#ifndef sedbypass - vol = seddw(k)*pdlxp(i,j)*pdlyp(i,j)*porwat(i,j,k)*omask(i,j) ! porewater volume - ztmp1(i,j) = ztmp1(i,j)+powtra(i,j,k,ipowc14) *vol*(1.0-c14dec) - vol = seddw(k)*pdlxp(i,j)*pdlyp(i,j)*porsol(i,j,k)*omask(i,j) ! sediment volume - ztmp1(i,j) = ztmp1(i,j)+sedlay(i,j,k,issso14) *vol*(1.0-c14dec)*rcar - ztmp1(i,j) = ztmp1(i,j)+sedlay(i,j,k,isssc14) *vol*(1.0-c14dec) -#endif - ENDDO - ENDDO - ENDDO - - CALL xcsum(totc14dec,ztmp1,ips) - - ! Update atmospheric p13CO2 and p14CO2 - DO j=1,kpje - DO i=1,kpie - atm(i,j,iatmc13)=atm(i,j,iatmc13) + co213flux_ppm - atm(i,j,iatmc14)=atm(i,j,iatmc14) + co214flux_ppm - atm(i,j,iatmc14)=atm(i,j,iatmc14) + totc14dec*14.*1.e-12*pg2ppm*12./14. ! add 14C decay (ppm) - ENDDO - ENDDO - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Boxatm fluxes (ppm)' - WRITE(io_stdo_bgc,*) ' co213flux_ppm: ',co213flux_ppm - WRITE(io_stdo_bgc,*) ' co214flux_ppm: ',co214flux_ppm - WRITE(io_stdo_bgc,*) ' totc14dec (ppm): ',(totc14dec*14.*1.e-12*pg2ppm*12./14.) - WRITE(io_stdo_bgc,*) ' ' - ENDIF -#endif /* cisonew */ + if (use_cisonew) then + co213flux = 0.0 + co214flux = 0.0 + + ! Calculate global total air-sea flux for C isotopes [kmol] + ztmp1(:,:) = 0.0 + ztmp2(:,:) = 0.0 + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = atmflx(i,j,iatmc13)*pdlxp(i,j)*pdlyp(i,j) ![kmol 13CO2/ m2] * [m] * [m] + ztmp2(i,j) = atmflx(i,j,iatmc14)*pdlxp(i,j)*pdlyp(i,j) ![kmol 14CO2/ m2] * [m] * [m] + ENDDO + ENDDO + + CALL xcsum(co213flux,ztmp1,ips) + CALL xcsum(co214flux,ztmp2,ips) + + ! Convert global CO2 isotope fluxes to ppm isotope fluxes + co213flux_ppm = co213flux*13.*1.e-12*pg2ppm*12./13. ! [kmol 13CO2] -> [ppm] + co214flux_ppm = co214flux*14.*1.e-12*pg2ppm*12./14. ! [kmol 14CO2] -> [ppm] + + ! Calculate sum of 14C decay. Only decay in ocean, so only ocean tracers. + totc14dec = 0.0 + ztmp1(:,:) = 0.0 + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + vol = pdlxp(i,j)*pdlyp(i,j)*pddpo(i,j,k)*omask(i,j) ! ocean volume + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,isco214)*vol*(1.0-c14dec) + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,idet14) *vol*(1.0-c14dec)*rcar + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,icalc14)*vol*(1.0-c14dec) + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,idoc14) *vol*(1.0-c14dec)*rcar + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,iphy14) *vol*(1.0-c14dec)*rcar + ztmp1(i,j) = ztmp1(i,j)+ocetra(i,j,k,izoo14) *vol*(1.0-c14dec)*rcar + if (.not. use_sedbypass) then + vol = seddw(k)*pdlxp(i,j)*pdlyp(i,j)*porwat(i,j,k)*omask(i,j) ! porewater volume + ztmp1(i,j) = ztmp1(i,j)+powtra(i,j,k,ipowc14) *vol*(1.0-c14dec) + vol = seddw(k)*pdlxp(i,j)*pdlyp(i,j)*porsol(i,j,k)*omask(i,j) ! sediment volume + ztmp1(i,j) = ztmp1(i,j)+sedlay(i,j,k,issso14) *vol*(1.0-c14dec)*rcar + ztmp1(i,j) = ztmp1(i,j)+sedlay(i,j,k,isssc14) *vol*(1.0-c14dec) + end if + ENDDO + ENDDO + ENDDO + + CALL xcsum(totc14dec,ztmp1,ips) + + ! Update atmospheric p13CO2 and p14CO2 + DO j=1,kpje + DO i=1,kpie + atm(i,j,iatmc13)=atm(i,j,iatmc13) + co213flux_ppm + atm(i,j,iatmc14)=atm(i,j,iatmc14) + co214flux_ppm + atm(i,j,iatmc14)=atm(i,j,iatmc14) + totc14dec*14.*1.e-12*pg2ppm*12./14. ! add 14C decay (ppm) + ENDDO + ENDDO + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Boxatm fluxes (ppm)' + WRITE(io_stdo_bgc,*) ' co213flux_ppm: ',co213flux_ppm + WRITE(io_stdo_bgc,*) ' co214flux_ppm: ',co214flux_ppm + WRITE(io_stdo_bgc,*) ' totc14dec (ppm): ',(totc14dec*14.*1.e-12*pg2ppm*12./14.) + WRITE(io_stdo_bgc,*) ' ' + ENDIF + + end if ! end of use_cisonew end subroutine update_boxatm diff --git a/hamocc/mo_carbch.F90 b/hamocc/mo_carbch.F90 index b2e7f0a8..04234e8a 100644 --- a/hamocc/mo_carbch.F90 +++ b/hamocc/mo_carbch.F90 @@ -82,34 +82,24 @@ MODULE mo_carbch REAL, DIMENSION (:,:), ALLOCATABLE :: co2solm REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxd REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxu -#ifdef cisonew REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxd REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxu REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxd REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxu -#endif REAL :: dmspar(6) -#ifdef natDIC REAL :: atm_co2_nat REAL, DIMENSION (:,:), ALLOCATABLE :: natpco2d REAL, DIMENSION (:,:,:), ALLOCATABLE :: nathi REAL, DIMENSION (:,:,:), ALLOCATABLE :: natco3 REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaA REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaC -#endif REAL :: atm_co2, atm_o2, atm_n2 REAL :: atm_c13, atm_c14 -#ifdef cisonew REAL :: c14_t_half, c14dec -#endif -#ifdef CFC REAL :: atm_cfc11_nh,atm_cfc11_sh REAL :: atm_cfc12_nh,atm_cfc12_sh REAL :: atm_sf6_nh,atm_sf6_sh -#endif -#ifdef BROMO REAL :: atm_bromo, fbro1, fbro2 -#endif CONTAINS @@ -120,10 +110,10 @@ SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc use mo_param1_bgc, only: nocetra,npowtra,natm,nriv + use mo_control_bgc, only: use_natDIC,use_cisonew INTEGER, intent(in) :: kpie,kpje,kpke INTEGER :: errstat - IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)' ' @@ -192,52 +182,52 @@ SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) OmegaA(:,:,:) = 0.0 OmegaC(:,:,:) = 0.0 -#ifdef natDIC - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable natpco2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (natpco2d(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory natpco2d' - natpco2d(:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable nathi ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (nathi(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory nathi' - nathi(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable natco3 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (natco3(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory natco3' - natco3(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable natOmegaA, natOmegaC ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF - - ALLOCATE (natOmegaA(kpie,kpje,kpke),stat=errstat) - ALLOCATE (natOmegaC(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory natOmegaA, natOmegaC' - natOmegaA(:,:,:) = 0.0 - natOmegaC(:,:,:) = 0.0 -#endif + if (use_natDIC) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable natpco2d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (natpco2d(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory natpco2d' + natpco2d(:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable nathi ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (nathi(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory nathi' + nathi(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable natco3 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (natco3(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory natco3' + natco3(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable natOmegaA, natOmegaC ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (natOmegaA(kpie,kpje,kpke),stat=errstat) + ALLOCATE (natOmegaC(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory natOmegaA, natOmegaC' + natOmegaA(:,:,:) = 0.0 + natOmegaC(:,:,:) = 0.0 + end if IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable sedfluxo ..' @@ -412,23 +402,23 @@ SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) co2fxd(:,:) = 0.0 co2fxu(:,:) = 0.0 -#ifdef cisonew - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co213fxd,..., co214fxu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (co213fxd(kpie,kpje),stat=errstat) - ALLOCATE (co213fxu(kpie,kpje),stat=errstat) - ALLOCATE (co214fxd(kpie,kpje),stat=errstat) - ALLOCATE (co214fxu(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co213fxd,..., co214fxu' - co213fxd(:,:) = 0.0 - co213fxu(:,:) = 0.0 - co214fxd(:,:) = 0.0 - co214fxu(:,:) = 0.0 -#endif + if (use_cisonew) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable co213fxd,..., co214fxu ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (co213fxd(kpie,kpje),stat=errstat) + ALLOCATE (co213fxu(kpie,kpje),stat=errstat) + ALLOCATE (co214fxd(kpie,kpje),stat=errstat) + ALLOCATE (co214fxu(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co213fxd,..., co214fxu' + co213fxd(:,:) = 0.0 + co213fxu(:,:) = 0.0 + co214fxd(:,:) = 0.0 + co214fxu(:,:) = 0.0 + end if !****************************************************************************** END SUBROUTINE ALLOC_MEM_CARBCH diff --git a/hamocc/mo_control_bgc.F90 b/hamocc/mo_control_bgc.F90 index c7058aa5..81c99d37 100644 --- a/hamocc/mo_control_bgc.F90 +++ b/hamocc/mo_control_bgc.F90 @@ -16,86 +16,151 @@ ! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. +MODULE mo_control_bgc + !*********************************************************************** + ! + !**** *MODULE mo_control_bgc* - control variables for bgc modules. + ! + ! S.Legutke, *MPI-MaD, HH* 28.02.02 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed unused variables + ! + ! Purpose + ! ------- + ! - declaration + ! + ! + !********************************************************************** + implicit none - MODULE mo_control_bgc -!*********************************************************************** -! -!**** *MODULE mo_control_bgc* - control variables for bgc modules. -! -! S.Legutke, *MPI-MaD, HH* 28.02.02 -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - removed unused variables -! -! Purpose -! ------- -! - declaration -! -! -!********************************************************************** - implicit none + ! Logical unit number for I/O. + INTEGER :: io_stdo_bgc ! standard out. + + ! File containing namelists + CHARACTER(LEN=:), ALLOCATABLE, PROTECTED :: bgc_namelist -! Logical unit number for I/O. - INTEGER, save :: io_stdo_bgc ! standard out. + ! Control variables + REAL :: dtbgc ! time step length [sec]. + REAL :: dtb ! time step length [days]. + INTEGER :: ndtdaybgc ! time steps per day. -! File containing namelists - CHARACTER(LEN=:), ALLOCATABLE, PROTECTED :: bgc_namelist + INTEGER :: ldtbgc ! time step number from bgc restart file + INTEGER :: ldtrunbgc ! actual time steps of run. -! Control variables - REAL, save :: dtbgc ! time step length [sec]. - REAL, save :: dtb ! time step length [days]. - INTEGER, save :: ndtdaybgc ! time steps per day. + INTEGER :: sedspin_yr_s = -1 + INTEGER :: sedspin_yr_e = -1 + INTEGER :: sedspin_ncyc = -1 - INTEGER, save :: ldtbgc ! time step number from bgc restart file - INTEGER, save :: ldtrunbgc ! actual time steps of run. + REAL :: rmasks = 0.0 ! value at wet cells in sediment. + REAL :: rmasko = 99999.00 ! value at wet cells in ocean. - INTEGER, save :: sedspin_yr_s = -1 - INTEGER, save :: sedspin_yr_e = -1 - INTEGER, save :: sedspin_ncyc = -1 + ! Logical switches set via namelist + LOGICAL :: l_3Dvarsedpor = .false. ! apply lon-lat-depth variable sediment porosity via input file + LOGICAL :: do_ndep =.true. ! apply n-deposition + LOGICAL :: do_rivinpt =.true. ! apply riverine input + LOGICAL :: do_sedspinup=.false. ! apply sediment spin-up + LOGICAL :: do_oalk =.false. ! apply ocean alkalinization + logical :: with_dmsph =.false. ! apply DMS with pH dependence - REAL, save :: rmasks = 0.0 ! value at wet cells in sediment. - REAL, save :: rmasko = 99999.00 ! value at wet cells in ocean. - -! Logical switches set via namelist - LOGICAL, save :: l_3Dvarsedpor = .false. ! apply lon-lat-depth variable sediment porosity via input file - LOGICAL, save :: do_ndep =.true. ! apply n-deposition - LOGICAL, save :: do_rivinpt =.true. ! apply riverine input - LOGICAL, save :: do_sedspinup=.false. ! apply sediment spin-up - LOGICAL, save :: do_oalk =.false. ! apply ocean alkalinization - logical, save :: with_dmsph =.false. ! apply DMS with pH dependence +#ifdef BROMO + logical, parameter :: use_BROMO = .true. +#else + logical, parameter :: use_BROMO = .false. +#endif +#ifdef AGG + logical, parameter :: use_AGG = .true. +#else + logical, parameter :: use_AGG = .false. +#endif +#ifdef WLIN + logical, parameter :: use_WLIN = .true. +#else + logical, parameter :: use_WLIN = .false. +#endif +#ifdef natDIC + logical, parameter :: use_natDIC = .true. +#else + logical, parameter :: use_natDIC = .false. +#endif +#ifdef CFC + logical, parameter :: use_CFC = .true. +#else + logical, parameter :: use_CFC = .false. +#endif +#ifdef cisonew + logical, parameter :: use_cisonew = .true. +#else + logical, parameter :: use_cisonew = .false. +#endif +#ifdef PBGC_OCNP_TIMESTEP + logical, parameter :: use_PBGC_OCNP_TIMESTEP = .true. +#else + logical, parameter :: use_PBGC_OCNP_TIMESTEP = .false. +#endif +#ifdef PBGC_CK_TIMESTEP + logical, parameter :: use_PBGC_CK_TIMESTEP = .true. +#else + logical, parameter :: use_PBGC_CK_TIMESTEP = .false. +#endif +#ifdef FB_BGC_OCE + logical, parameter :: use_FB_BGC_OCE = .true. +#else + logical, parameter :: use_FB_BGC_OCE = .false. +#endif +#ifdef BOXATM + logical, parameter :: use_BOXATM = .true. +#else + logical, parameter :: use_BOXATM = .false. +#endif +#ifdef sedbypass + logical, parameter :: use_sedbypass = .true. +#else + logical, parameter :: use_sedbypass = .false. +#endif +#ifdef PROGCO2 + logical, parameter :: use_PROGCO2 = .true. +#else + logical, parameter :: use_PROGCO2 = .false. +#endif +#ifdef DIAGCO2 + logical, parameter :: use_DIAGCO2 = .true. +#else + logical, parameter :: use_DIAGCO2 = .false. +#endif - contains +contains - subroutine get_bgc_namelist - !------------------------------------------------------------------------- - ! Get filename for namelist file - !------------------------------------------------------------------------- - use mod_config, only: inst_suffix - use mod_xc, only: xchalt + subroutine get_bgc_namelist + !------------------------------------------------------------------------- + ! Get filename for namelist file + !------------------------------------------------------------------------- + use mod_config, only: inst_suffix + use mod_xc, only: xchalt - implicit none + implicit none - logical :: exists + logical :: exists - if (.not. allocated(bgc_namelist)) then - inquire (file='ocn_in'//trim(inst_suffix), exist=exists) - if (exists) then - allocate(character(len=len('ocn_in'//trim(inst_suffix))) :: & - bgc_namelist) - bgc_namelist = 'ocn_in'//trim(inst_suffix) - else - inquire (file='limits', exist=exists) - if (exists) then - allocate(character(len=len('limits')) :: bgc_namelist) - bgc_namelist = 'limits' - else - call xchalt('cannot find limits file') - stop 'cannot find limits file' - endif - endif - endif - end subroutine get_bgc_namelist + if (.not. allocated(bgc_namelist)) then + inquire (file='ocn_in'//trim(inst_suffix), exist=exists) + if (exists) then + allocate(character(len=len('ocn_in'//trim(inst_suffix))) :: & + bgc_namelist) + bgc_namelist = 'ocn_in'//trim(inst_suffix) + else + inquire (file='limits', exist=exists) + if (exists) then + allocate(character(len=len('limits')) :: bgc_namelist) + bgc_namelist = 'limits' + else + call xchalt('cannot find limits file') + stop 'cannot find limits file' + endif + endif + endif + end subroutine get_bgc_namelist - END MODULE mo_control_bgc +END MODULE mo_control_bgc diff --git a/hamocc/mo_intfcblom.F90 b/hamocc/mo_intfcblom.F90 index e0d78b3b..2c6537b9 100644 --- a/hamocc/mo_intfcblom.F90 +++ b/hamocc/mo_intfcblom.F90 @@ -63,23 +63,25 @@ module mo_intfcblom ! *atm2* *REAL* - two time-level copy of atm ! !****************************************************************************** + use mo_control_bgc, only: use_sedbypass,use_BOXATM + implicit none - integer, parameter :: nphys=2 + integer, parameter :: nphys=2 - real, allocatable, save :: bgc_dx(:,:),bgc_dy(:,:) - real, allocatable, save :: bgc_dp(:,:,:) - real, allocatable, save :: bgc_rho(:,:,:) - real, allocatable, save :: omask(:,:) + real, allocatable :: bgc_dx(:,:),bgc_dy(:,:) + real, allocatable :: bgc_dp(:,:,:) + real, allocatable :: bgc_rho(:,:,:) + real, allocatable :: omask(:,:) ! Two time-level copy of sediment fields - real, allocatable, save :: sedlay2(:,:,:,:) - real, allocatable, save :: powtra2(:,:,:,:) - real, allocatable, save :: burial2(:,:,:,:) + real, allocatable :: sedlay2(:,:,:,:) + real, allocatable :: powtra2(:,:,:,:) + real, allocatable :: burial2(:,:,:,:) ! Two time level copy of prognostic atmosphere field ! used if BOXATM is activated - real, allocatable, save :: atm2(:,:,:,:) + real, allocatable :: atm2(:,:,:,:) contains !****************************************************************************** @@ -157,59 +159,58 @@ subroutine alloc_mem_intfcblom(kpie,kpje,kpke) if(errstat.ne.0) stop 'not enough memory omask' omask(:,:) = 0.0 -#ifndef sedbypass - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable sedlay2 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',2*ks - WRITE(io_stdo_bgc,*)'Fourth dimension : ',nsedtra - ENDIF - - ALLOCATE (sedlay2(kpie,kpje,2*ks,nsedtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory sedlay2' - sedlay2(:,:,:,:) = 0.0 - - - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable powtra2 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',2*ks - WRITE(io_stdo_bgc,*)'Fourth dimension : ',npowtra - ENDIF - - ALLOCATE (powtra2(kpie,kpje,2*ks,npowtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory powtra2' - powtra2(:,:,:,:) = 0.0 - - - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable burial2 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',2 - WRITE(io_stdo_bgc,*)'Fourth dimension : ',nsedtra - ENDIF - - ALLOCATE (burial2(kpie,kpje,2,nsedtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory burial2' - burial2(:,:,:,:) = 0.0 -#endif - -#if defined(BOXATM) - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable atm2 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',2 - WRITE(io_stdo_bgc,*)'Fourth dimension : ',natm - ENDIF - - ALLOCATE (atm2(kpie,kpje,2,natm),stat=errstat) - if(errstat.ne.0) stop 'not enough memory atm2' - atm2(:,:,:,:) = 0.0 -#endif + if (.not. use_sedbypass) then + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable sedlay2 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',2*ks + WRITE(io_stdo_bgc,*)'Fourth dimension : ',nsedtra + ENDIF + + ALLOCATE (sedlay2(kpie,kpje,2*ks,nsedtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory sedlay2' + sedlay2(:,:,:,:) = 0.0 + + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable powtra2 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',2*ks + WRITE(io_stdo_bgc,*)'Fourth dimension : ',npowtra + ENDIF + + ALLOCATE (powtra2(kpie,kpje,2*ks,npowtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory powtra2' + powtra2(:,:,:,:) = 0.0 + + + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable burial2 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',2 + WRITE(io_stdo_bgc,*)'Fourth dimension : ',nsedtra + ENDIF + + ALLOCATE (burial2(kpie,kpje,2,nsedtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory burial2' + burial2(:,:,:,:) = 0.0 + end if + + if (use_BOXATM) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable atm2 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',2 + WRITE(io_stdo_bgc,*)'Fourth dimension : ',natm + ENDIF + + ALLOCATE (atm2(kpie,kpje,2,natm),stat=errstat) + if(errstat.ne.0) stop 'not enough memory atm2' + atm2(:,:,:,:) = 0.0 + end if end subroutine alloc_mem_intfcblom !****************************************************************************** @@ -369,39 +370,39 @@ subroutine blom2hamocc(m,n,mm,nn) ! --- is kept outside HAMOCC) ! --- ------------------------------------------------------------------ -#ifndef sedbypass - nns=(n-1)*ks - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=1,ks - kn=k+nns - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - sedlay(i,j,k,:) = sedlay2(i,j,kn,:) - powtra(i,j,k,:) = powtra2(i,j,kn,:) - burial(i,j,:) = burial2(i,j,n,:) - enddo - enddo + if (.not. use_sedbypass) then + nns=(n-1)*ks + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i) + do k=1,ks + kn=k+nns + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + sedlay(i,j,k,:) = sedlay2(i,j,kn,:) + powtra(i,j,k,:) = powtra2(i,j,kn,:) + burial(i,j,:) = burial2(i,j,n,:) + enddo + enddo + enddo enddo - enddo -!$OMP END PARALLEL DO -#endif + !$OMP END PARALLEL DO + end if ! --- ------------------------------------------------------------------ ! --- pass atmosphere fields if required (a two time-level copy of ! --- atmosphere fields is kept outside HAMOCC) ! --- ------------------------------------------------------------------ -#if defined(BOXATM) -!$OMP PARALLEL DO PRIVATE(i) - do j=1,jj - do i=1,ii - atm(i,j,:) = atm2(i,j,n,:) - enddo - enddo -!$OMP END PARALLEL DO -#endif + if (use_BOXATM) then + !$OMP PARALLEL DO PRIVATE(i) + do j=1,jj + do i=1,ii + atm(i,j,:) = atm2(i,j,n,:) + enddo + enddo + !$OMP END PARALLEL DO + end if end subroutine blom2hamocc !****************************************************************************** @@ -472,71 +473,71 @@ subroutine hamocc2blom(m,n,mm,nn) ! --- apply time smoothing for sediment fields and pass them back ! --- ------------------------------------------------------------------ -#ifndef sedbypass - nns=(n-1)*ks - mms=(m-1)*ks - -!$OMP PARALLEL DO PRIVATE(k,km,kn,l,i) - do k=1,ks - km=k+mms - kn=k+nns - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) ! time smoothing (analog to tmsmt2.F) - sedlay2(i,j,km,:) = wts1*sedlay2(i,j,km,:) & ! mid timelevel - + wts2*sedlay2(i,j,kn,:) & ! old timelevel - + wts2*sedlay(i,j,k,:) ! new timelevel - powtra2(i,j,km,:) = wts1*powtra2(i,j,km,:) & - + wts2*powtra2(i,j,kn,:) & - + wts2*powtra(i,j,k,:) - burial2(i,j,m,:) = wts1*burial2(i,j,m,:) & - + wts2*burial2(i,j,n,:) & - + wts2*burial(i,j,:) - enddo - enddo - enddo - enddo -!$OMP END PARALLEL DO - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=1,ks - kn=k+nns - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - sedlay2(i,j,kn,:) = sedlay(i,j,k,:) ! new time level replaces old time level here - powtra2(i,j,kn,:) = powtra(i,j,k,:) - burial2(i,j,n,:) = burial(i,j,:) - enddo + if (.not. use_sedbypass) then + nns=(n-1)*ks + mms=(m-1)*ks + + !$OMP PARALLEL DO PRIVATE(k,km,kn,l,i) + do k=1,ks + km=k+mms + kn=k+nns + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) ! time smoothing (analog to tmsmt2.F) + sedlay2(i,j,km,:) = wts1*sedlay2(i,j,km,:) & ! mid timelevel + + wts2*sedlay2(i,j,kn,:) & ! old timelevel + + wts2*sedlay(i,j,k,:) ! new timelevel + powtra2(i,j,km,:) = wts1*powtra2(i,j,km,:) & + + wts2*powtra2(i,j,kn,:) & + + wts2*powtra(i,j,k,:) + burial2(i,j,m,:) = wts1*burial2(i,j,m,:) & + + wts2*burial2(i,j,n,:) & + + wts2*burial(i,j,:) + enddo + enddo + enddo enddo + !$OMP END PARALLEL DO + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i) + do k=1,ks + kn=k+nns + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + sedlay2(i,j,kn,:) = sedlay(i,j,k,:) ! new time level replaces old time level here + powtra2(i,j,kn,:) = powtra(i,j,k,:) + burial2(i,j,n,:) = burial(i,j,:) + enddo + enddo + enddo enddo - enddo -!$OMP END PARALLEL DO -#endif + !$OMP END PARALLEL DO + end if ! --- ------------------------------------------------------------------ ! --- apply time smoothing for atmosphere fields if required ! --- ------------------------------------------------------------------ -#if defined(BOXATM) -!$OMP PARALLEL DO PRIVATE(i) - do j=1,jj - do i=1,ii ! time smoothing (analog to tmsmt2.F) - atm2(i,j,m,:) = wts1*atm2(i,j,m,:) & ! mid timelevel - + wts2*atm2(i,j,n,:) & ! old timelevel - + wts2*atm(i,j,:) ! new timelevel - enddo - enddo -!$OMP END PARALLEL DO + if (use_BOXATM) then + !$OMP PARALLEL DO PRIVATE(i) + do j=1,jj + do i=1,ii ! time smoothing (analog to tmsmt2.F) + atm2(i,j,m,:) = wts1*atm2(i,j,m,:) & ! mid timelevel + + wts2*atm2(i,j,n,:) & ! old timelevel + + wts2*atm(i,j,:) ! new timelevel + enddo + enddo + !$OMP END PARALLEL DO -!$OMP PARALLEL DO PRIVATE(i) - do j=1,jj - do i=1,ii - atm2(i,j,n,:) = atm(i,j,:) ! new time level replaces old time level here - enddo - enddo -!$OMP END PARALLEL DO -#endif + !$OMP PARALLEL DO PRIVATE(i) + do j=1,jj + do i=1,ii + atm2(i,j,n,:) = atm(i,j,:) ! new time level replaces old time level here + enddo + enddo + !$OMP END PARALLEL DO + end if end subroutine hamocc2blom !****************************************************************************** diff --git a/hamocc/mo_param1_bgc.F90 b/hamocc/mo_param1_bgc.F90 index f18df794..ae3a4506 100644 --- a/hamocc/mo_param1_bgc.F90 +++ b/hamocc/mo_param1_bgc.F90 @@ -1,19 +1,19 @@ -! Copyright (C) 2003 P. Wetzel +! Copyright (C) 2003 P. Wetzel ! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger ! ! This file is part of BLOM/iHAMOCC. ! ! BLOM is free software: you can redistribute it and/or modify it under the -! terms of the GNU Lesser General Public License as published by the Free -! Software Foundation, either version 3 of the License, or (at your option) -! any later version. +! terms of the GNU Lesser General Public License as published by the Free +! Software Foundation, either version 3 of the License, or (at your option) +! any later version. ! -! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY -! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -! more details. +! more details. ! -! You should have received a copy of the GNU Lesser General Public License +! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. @@ -24,247 +24,391 @@ MODULE mo_param1_bgc ! ! Patrick Wetzel *MPI-Met, HH* 01.09.03 ! -! +! ! Modified ! -------- ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-26 ! -! - To facilitate easier use of 'only-lists' in use statements, make indices +! - To facilitate easier use of 'only-lists' in use statements, make indices ! always defined also in case they are inside a #ifdef directive. -! ! ! Purpose ! ------- ! - definition of indices in tracer arrays ! !****************************************************************************** + use mo_control_bgc, only: use_BROMO, use_AGG, use_WLIN, use_natDIC, use_CFC, & + use_cisonew, use_PBGC_OCNP_TIMESTEP, use_PBGC_CK_TIMESTEP, & + use_FB_BGC_OCE, use_BOXATM, use_sedbypass, & + use_PROGCO2, use_DIAGCO2 + implicit none - - INTEGER, PARAMETER :: ks=12,ksp=ks+1 ! ks: nb of sediment layers + public + INTEGER, PARAMETER :: ks=12,ksp=ks+1 ! ks: nb of sediment layers REAL, PARAMETER :: safediv = 1.0e-25 ! added to the denominator of isotopic ratios (avoid div. by zero) -! Tracer indices - INTEGER, PARAMETER :: i_base=22, & - & isco212 =1, & - & ialkali =2, & - & iphosph =3, & - & ioxygen =4, & - & igasnit =5, & - & iano3 =6, & - & isilica =7, & - & idoc =8, & - & iphy =9, & - & izoo =10, & - & idet =11, & - & icalc =12, & - & iopal =13, & - & ian2o =14, & - & idms =15, & - & iiron =16, & - & ifdust =17, & - & iprefo2 =18, & - & iprefpo4 =19, & - & iprefalk =20, & - & iprefdic =21, & - & idicsat =22 -#ifdef cisonew - INTEGER, PARAMETER :: i_iso=12, & - & isco213 = i_base+1, & - & isco214 = i_base+2, & - & idoc13 = i_base+3, & - & idoc14 = i_base+4, & - & iphy13 = i_base+5, & - & iphy14 = i_base+6, & - & izoo13 = i_base+7, & - & izoo14 = i_base+8, & - & idet13 = i_base+9, & - & idet14 = i_base+10, & - & icalc13 = i_base+11, & - & icalc14 = i_base+12 -#else - INTEGER, PARAMETER :: i_iso=0, & - & isco213 = -1, & - & isco214 = -1, & - & idoc13 = -1, & - & idoc14 = -1, & - & iphy13 = -1, & - & iphy14 = -1, & - & izoo13 = -1, & - & izoo14 = -1, & - & idet13 = -1, & - & idet14 = -1, & - & icalc13 = -1, & - & icalc14 = -1 -#endif -#ifdef CFC - INTEGER, PARAMETER :: i_cfc=3, & - & icfc11 = i_base+i_iso+1, & - & icfc12 = i_base+i_iso+2, & - & isf6 = i_base+i_iso+3 -#else - INTEGER, PARAMETER :: i_cfc=0, & - & icfc11 = -1, & - & icfc12 = -1, & - & isf6 = -1 -#endif -#ifdef AGG - INTEGER, PARAMETER :: i_agg=2, & - & inos = i_base+i_iso+i_cfc+1, & - & iadust = i_base+i_iso+i_cfc+2 -#else - INTEGER, PARAMETER :: i_agg=0, & - & inos = -1, & - & iadust = -1 -#endif -#ifdef natDIC - INTEGER, PARAMETER :: i_nat_dic=3, & - & inatsco212 = i_base+i_iso+i_cfc+i_agg+1, & - & inatalkali = i_base+i_iso+i_cfc+i_agg+2, & - & inatcalc = i_base+i_iso+i_cfc+i_agg+3 -#else - INTEGER, PARAMETER :: i_nat_dic=0, & - & inatsco212 = -1, & - & inatalkali = -1, & - & inatcalc = -1 -#endif -#ifdef BROMO - INTEGER, PARAMETER :: i_bromo=1, & - & ibromo=i_base+i_iso+i_cfc+i_agg+i_nat_dic+1 -#else - INTEGER, PARAMETER :: i_bromo=0, & - & ibromo=-1 -#endif - -! total number of advected tracers - INTEGER, PARAMETER :: nocetra=i_base+i_iso+i_cfc+i_agg+i_nat_dic & - +i_bromo - - -! ATMOSPHERE - INTEGER, PARAMETER :: i_base_atm=5, & - & iatmco2=1, & - & iatmo2 =2, & - & iatmn2 =3, & - & iatmn2o=4, & - & iatmdms=5 - -#ifdef cisonew - INTEGER, PARAMETER :: i_iso_atm = 2, & - & iatmc13 = i_base_atm+1, & - & iatmc14 = i_base_atm+2 -#else - INTEGER, PARAMETER :: i_iso_atm = 0, & - & iatmc13 = -1, & - & iatmc14 = -1 -#endif - -#ifdef CFC - INTEGER, PARAMETER :: i_cfc_atm = 3, & - & iatmf11 = i_base_atm+i_iso_atm+1, & - & iatmf12 = i_base_atm+i_iso_atm+2, & - & iatmsf6 = i_base_atm+i_iso_atm+3 -#else - INTEGER, PARAMETER :: i_cfc_atm = 0, & - & iatmf11 = -1, & - & iatmf12 = -1, & - & iatmsf6 = -1 -#endif - -#ifdef natDIC - INTEGER, PARAMETER :: i_ndic_atm = 1, & - & iatmnco2 = i_base_atm+i_iso_atm+i_cfc_atm+1 -#else - INTEGER, PARAMETER :: i_ndic_atm = 0, & - & iatmnco2 = -1 -#endif -#ifdef BROMO - INTEGER, PARAMETER :: i_bromo_atm=1, & - & iatmbromo=i_base_atm+i_iso_atm+i_cfc_atm+ & - & i_ndic_atm+1 -#else - INTEGER, PARAMETER :: i_bromo_atm=0, & - & iatmbromo=-1 -#endif - -! total number of atmosphere tracers - INTEGER, PARAMETER :: natm=i_base_atm+i_iso_atm+i_cfc_atm+i_ndic_atm+i_bromo_atm - - -! rivers - integer, parameter :: nriv =7 ! size of river input field - integer, parameter :: irdin =1, & ! dissolved inorganic nitrogen - & irdip =2, & ! dissolved inorganic phosphorous - & irsi =3, & ! dissolved silicate - & iralk =4, & ! alkalinity - & iriron =5, & ! dissolved bioavailable iron - & irdoc =6, & ! dissolved organic carbon - & irdet =7 ! particulate carbon - - -! --- sediment - ! sediment solid components - INTEGER, PARAMETER :: i_sed_base = 4 - INTEGER, PARAMETER :: issso12=1, & - & isssc12=2, & - & issssil=3, & - & issster=4 -#ifdef cisonew - INTEGER, PARAMETER :: i_sed_cisonew = 4 - INTEGER, PARAMETER :: issso13 = i_sed_base+1, & - & issso14 = i_sed_base+2, & - & isssc13 = i_sed_base+3, & - & isssc14 = i_sed_base+4 -#else - INTEGER, PARAMETER :: i_sed_cisonew = 0 - INTEGER, PARAMETER :: issso13 = -1, & - & issso14 = -1, & - & isssc13 = -1, & - & isssc14 = -1 -#endif - INTEGER, PARAMETER :: nsedtra = i_sed_base + i_sed_cisonew - - - ! sediment pore water components - INTEGER, PARAMETER :: i_pow_base=7 - INTEGER, PARAMETER :: ipowaic=1, & - & ipowaal=2, & - & ipowaph=3, & - & ipowaox=4, & - & ipown2 =5, & - & ipowno3=6, & - & ipowasi=7 -#ifdef cisonew - INTEGER, PARAMETER :: i_pow_cisonew = 2 - INTEGER, PARAMETER :: ipowc13=i_pow_base + 1, & - & ipowc14=i_pow_base + 2 -#else - INTEGER, PARAMETER :: i_pow_cisonew = 0 - INTEGER, PARAMETER :: ipowc13 = -1, & - & ipowc14 = -1 -#endif - INTEGER, PARAMETER :: npowtra = i_pow_base + i_pow_cisonew - - ! Mapping between pore water and ocean tracers needed for pore water diffusion - INTEGER, SAVE :: map_por2octra(npowtra) - - contains + ! ------------------ + ! Tracer indices + ! ------------------ + + integer :: i_base + integer, protected :: isco212 + integer, protected :: ialkali + integer, protected :: iphosph + integer, protected :: ioxygen + integer, protected :: igasnit + integer, protected :: iano3 + integer, protected :: isilica + integer, protected :: idoc + integer, protected :: iphy + integer, protected :: izoo + integer, protected :: idet + integer, protected :: icalc + integer, protected :: iopal + integer, protected :: ian2o + integer, protected :: idms + integer, protected :: iiron + integer, protected :: ifdust + integer, protected :: iprefo2 + integer, protected :: iprefpo4 + integer, protected :: iprefalk + integer, protected :: iprefdic + integer, protected :: idicsat + + ! cisonew + integer, protected :: i_iso + integer, protected :: isco213 + integer, protected :: isco214 + integer, protected :: idoc13 + integer, protected :: idoc14 + integer, protected :: iphy13 + integer, protected :: iphy14 + integer, protected :: izoo13 + integer, protected :: izoo14 + integer, protected :: idet13 + integer, protected :: idet14 + integer, protected :: icalc13 + integer, protected :: icalc14 + + !CFC + integer, protected :: i_cfc + integer, protected :: icfc11 + integer, protected :: icfc12 + integer, protected :: isf6 + + ! AGG + integer, protected :: i_agg + integer, protected :: inos + integer, protected :: iadust + + ! natDIC + integer, protected :: i_nat_dic + integer, protected :: inatsco212 + integer, protected :: inatalkali + integer, protected :: inatcalc + + ! BROMO + integer, protected :: i_bromo + integer, protected :: ibromo + + ! total number of advected tracers(set by allocate_tracers in mod_tracers.F90) + integer :: nocetra + + ! ------------------ + ! atmosphere + ! ------------------ + + integer, protected :: i_base_atm + integer, protected :: iatmco2 + integer, protected :: iatmo2 + integer, protected :: iatmn2 + integer, protected :: iatmn2o + integer, protected :: iatmdms + + ! cisonew atm + integer, protected :: i_iso_atm + integer, protected :: iatmc13 + integer, protected :: iatmc14 + + ! CFC atm + integer, protected :: i_cfc_atm + integer, protected :: iatmf11 + integer, protected :: iatmf12 + integer, protected :: iatmsf6 + + ! natDIC atm + integer, protected :: i_ndic_atm + integer, protected :: iatmnco2 + + ! BROMO atm + integer, protected :: i_bromo_atm + integer, protected :: iatmbromo + + integer, protected :: natm ! total number of atmosphere tracers + + ! ------------------ + ! rivers + ! ------------------ + + integer, protected :: nriv ! size of river input field + integer, protected :: irdin ! dissolved inorganic nitrogen + integer, protected :: irdip ! dissolved inorganic phosphorous + integer, protected :: irsi ! dissolved silicate + integer, protected :: iralk ! alkalinity + integer, protected :: iriron ! dissolved bioavailable iron + integer, protected :: irdoc ! dissolved organic carbon + integer, protected :: irdet ! particulate carbon + + ! ------------------ + ! sediment + ! ------------------ + ! sediment solid components + integer, protected :: i_sed_base + integer, protected :: issso12 + integer, protected :: isssc12 + integer, protected :: issssil + integer, protected :: issster + + ! ciso sediment + integer, protected :: i_sed_cisonew + integer, protected :: issso13 + integer, protected :: issso14 + integer, protected :: isssc13 + integer, protected :: isssc14 + integer, protected :: nsedtra + + ! sediment pore water components + integer, protected :: i_pow_base + integer, protected :: ipowaic + integer, protected :: ipowaal + integer, protected :: ipowaph + integer, protected :: ipowaox + integer, protected :: ipown2 + integer, protected :: ipowno3 + integer, protected :: ipowasi + integer, protected :: i_pow_cisonew + integer, protected :: ipowc13 + integer, protected :: ipowc14 + integer, protected :: npowtra ! computed in init_indices + + ! Mapping between pore water and ocean tracers needed for pore + ! water diffusion + integer, protected, allocatable :: map_por2octra(:) + + contains subroutine init_por2octra_mapping() - - map_por2octra(ipowaic) = isco212 - map_por2octra(ipowaal) = ialkali - map_por2octra(ipowaph) = iphosph - map_por2octra(ipowaox) = ioxygen - map_por2octra(ipown2) = igasnit - map_por2octra(ipowno3) = iano3 - map_por2octra(ipowasi) = isilica -#ifdef cisonew - map_por2octra(ipowc13) = isco213 - map_por2octra(ipowc14) = isco214 -#endif - + map_por2octra(ipowaic) = isco212 + map_por2octra(ipowaal) = ialkali + map_por2octra(ipowaph) = iphosph + map_por2octra(ipowaox) = ioxygen + map_por2octra(ipown2) = igasnit + map_por2octra(ipowno3) = iano3 + map_por2octra(ipowasi) = isilica + if (use_cisonew) then + map_por2octra(ipowc13) = isco213 + map_por2octra(ipowc14) = isco214 + end if end subroutine init_por2octra_mapping + subroutine init_indices() + + ! Tracer indices + i_base = 22 + isco212 = 1 + ialkali = 2 + iphosph = 3 + ioxygen = 4 + igasnit = 5 + iano3 = 6 + isilica = 7 + idoc = 8 + iphy = 9 + izoo = 10 + idet = 11 + icalc = 12 + iopal = 13 + ian2o = 14 + idms = 15 + iiron = 16 + ifdust = 17 + iprefo2 = 18 + iprefpo4 = 19 + iprefalk = 20 + iprefdic = 21 + idicsat = 22 + if (use_cisonew) then + i_iso = 12 + isco213 = i_base+1 + isco214 = i_base+2 + idoc13 = i_base+3 + idoc14 = i_base+4 + iphy13 = i_base+5 + iphy14 = i_base+6 + izoo13 = i_base+7 + izoo14 = i_base+8 + idet13 = i_base+9 + idet14 = i_base+10 + icalc13 = i_base+11 + icalc14 = i_base+12 + else + i_iso = 0 + isco213 = -1 + isco214 = -1 + idoc13 = -1 + idoc14 = -1 + iphy13 = -1 + iphy14 = -1 + izoo13 = -1 + izoo14 = -1 + idet13 = -1 + idet14 = -1 + icalc13 = -1 + icalc14 = -1 + end if + if (use_CFC) then + i_cfc=3 + icfc11 = i_base+i_iso+1 + icfc12 = i_base+i_iso+2 + isf6 = i_base+i_iso+3 + else + i_cfc=0 + icfc11 = -1 + icfc12 = -1 + isf6 = -1 + end if + if (use_AGG) then + i_agg=2 + inos = i_base+i_iso+i_cfc+1 + iadust = i_base+i_iso+i_cfc+2 + else + i_agg=0 + inos = -1 + iadust = -1 + end if + if (use_natDIC) then + i_nat_dic=3 + inatsco212 = i_base+i_iso+i_cfc+i_agg+1 + inatalkali = i_base+i_iso+i_cfc+i_agg+2 + inatcalc = i_base+i_iso+i_cfc+i_agg+3 + else + i_nat_dic=0 + inatsco212 = -1 + inatalkali = -1 + inatcalc = -1 + end if + if (use_BROMO) then + i_bromo=1 + ibromo=i_base+i_iso+i_cfc+i_agg+i_nat_dic+1 + else + i_bromo=0 + ibromo=-1 + end if + + ! total number of advected tracers + nocetra=i_base+i_iso+i_cfc+i_agg+i_nat_dic +i_bromo + + ! ATMOSPHERE + i_base_atm=5 + iatmco2=1 + iatmo2 =2 + iatmn2 =3 + iatmn2o=4 + iatmdms=5 + if (use_cisonew) then + i_iso_atm = 2 + iatmc13 = i_base_atm+1 + iatmc14 = i_base_atm+2 + else + i_iso_atm = 0 + iatmc13 = -1 + iatmc14 = -1 + end if + if (use_CFC) then + i_cfc_atm = 3 + iatmf11 = i_base_atm+i_iso_atm+1 + iatmf12 = i_base_atm+i_iso_atm+2 + iatmsf6 = i_base_atm+i_iso_atm+3 + else + i_cfc_atm = 0 + iatmf11 = -1 + iatmf12 = -1 + iatmsf6 = -1 + end if + if (use_natDIC) then + i_ndic_atm = 1 + iatmnco2 = i_base_atm+i_iso_atm+i_cfc_atm+1 + else + i_ndic_atm = 0 + iatmnco2 = -1 + end if + if (use_BROMO) then + i_bromo_atm=1 + iatmbromo=i_base_atm+i_iso_atm+i_cfc_atm+ i_ndic_atm+1 + else + i_bromo_atm=0 + iatmbromo=-1 + end if + + ! total number of atmosphere tracers + natm=i_base_atm+i_iso_atm+i_cfc_atm+i_ndic_atm+i_bromo_atm + + ! rivers + nriv =7 + irdin =1 + irdip =2 + irsi =3 + iralk =4 + iriron =5 + irdoc =6 + irdet =7 + + ! --- sediment + ! sediment solid components + i_sed_base = 4 + issso12 = 1 + isssc12 = 2 + issssil = 3 + issster = 4 + if (use_cisonew) then + i_sed_cisonew = 4 + issso13 = i_sed_base+1 + issso14 = i_sed_base+2 + isssc13 = i_sed_base+3 + isssc14 = i_sed_base+4 + else + i_sed_cisonew = 0 + issso13 = -1 + issso14 = -1 + isssc13 = -1 + isssc14 = -1 + end if + nsedtra = i_sed_base + i_sed_cisonew + + ! sediment pore water components + i_pow_base =7 + ipowaic =1 + ipowaal =2 + ipowaph =3 + ipowaox =4 + ipown2 =5 + ipowno3 =6 + ipowasi =7 + if (use_cisonew) then + i_pow_cisonew = 2 + ipowc13=i_pow_base + 1 + ipowc14=i_pow_base + 2 + else + i_pow_cisonew = 0 + ipowc13 = -1 + ipowc14 = -1 + end if + npowtra = i_pow_base + i_pow_cisonew + + allocate(map_por2octra(-1:npowtra)) + + end subroutine init_indices + !****************************************************************************** - END MODULE mo_param1_bgc + END MODULE mo_param1_bgc diff --git a/hamocc/mo_param_bgc.F90 b/hamocc/mo_param_bgc.F90 index 14319d83..ee201c39 100644 --- a/hamocc/mo_param_bgc.F90 +++ b/hamocc/mo_param_bgc.F90 @@ -5,16 +5,16 @@ ! This file is part of BLOM/iHAMOCC. ! ! BLOM is free software: you can redistribute it and/or modify it under the -! terms of the GNU Lesser General Public License as published by the Free -! Software Foundation, either version 3 of the License, or (at your option) -! any later version. +! terms of the GNU Lesser General Public License as published by the Free +! Software Foundation, either version 3 of the License, or (at your option) +! any later version. ! -! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY -! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -! more details. +! more details. ! -! You should have received a copy of the GNU Lesser General Public License +! You should have received a copy of the GNU Lesser General Public License ! along with BLOM. If not, see https://www.gnu.org/licenses/. module mo_param_bgc @@ -28,13 +28,13 @@ module mo_param_bgc ! -------- ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 ! -split the original BELEG_BGC in two parts, BELEG_PARM and BELEG_VARS -! jmaerz -! - rename beleg_parm to mo_param_bgc +! jmaerz +! - rename beleg_parm to mo_param_bgc ! ! Purpose ! ------- ! - set bgc parameter values. -! +! ! ! Parameter list: ! --------------- @@ -43,80 +43,60 @@ module mo_param_bgc ! !****************************************************************************** - use mo_carbch, only: atm,atm_co2,atm_n2,atm_o2,dmspar + use mo_carbch, only: atm,atm_co2,atm_n2,atm_o2,dmspar, & + atm_bromo,fbro1,fbro2,atm_c13, atm_c14,c14_t_half,c14dec,atm_co2_nat use mo_biomod, only: atten_c,atten_f,atten_uv,atten_w,bkopal,bkphy,bkopal,bkzoo,bluefix,ctochl,dremn2o,dremopal, & - & drempoc,dremsul,dyphy,ecan,epsher,fesoly,fetune,gammap,gammaz,grami,grazra,perc_diron,phytomi, & - & pi_alpha,rcalc,rcar, rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut, & - & ropal,spemor,tf0,tf1,tf2,tff,wcal,wdust,wopal,wpoc,zinges + drempoc,dremsul,dyphy,ecan,epsher,fesoly,fetune,gammap,gammaz,grami,grazra,perc_diron,phytomi, & + pi_alpha,rcalc,rcar, rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut, & + ropal,spemor,tf0,tf1,tf2,tff,wcal,wdust,wopal,wpoc,zinges, & + alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass,cellsink,dustd1,dustd2,dustd3,dustsink, & + fractdim,fse,fsh,nmldmin,plower,pupper,safe,sinkexp,stick,tmfac,tsfac,vsmall,zdis,wmin,wmax,wlin,rbro, & + bifr13,bifr14,c14fac,prei13,prei14,re1312,re14to use mo_sedmnt, only: claydens,o2ut,rno3 - use mo_control_bgc, only: io_stdo_bgc,bgc_namelist + use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,use_AGG,use_natDIC,use_BROMO,use_cisonew,use_WLIN use mo_param1_bgc, only: iatmco2,iatmnco2,iatmo2,iatmn2,iatmc13,iatmc14,iatmbromo use mod_xc, only: mnproc -#ifdef AGG - use mo_biomod, only: alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass,cellsink,dustd1,dustd2,dustd3,dustsink, & - & fractdim,fse,fsh,nmldmin,plower,pupper,safe,sinkexp,stick,tmfac,tsfac,vsmall,zdis -#elif defined(WLIN) - use mo_biomod, only: wmin,wmax,wlin -#endif -#ifdef BROMO - use mo_biomod, only: rbro - use mo_carbch, only: atm_bromo,fbro1,fbro2 -#endif -#ifdef cisonew - use mo_biomod, only: bifr13,bifr14,c14fac,prei13,prei14,re1312,re14to - use mo_carbch, only: atm_c13, atm_c14,c14_t_half,c14dec -#endif -#ifdef natDIC - use mo_carbch, only: atm_co2_nat -#endif - implicit none private - + public :: ini_parambgc - ! Module-wide parameters (used in more than one subroutine) -#ifndef AGG - REAL :: dustd1, dustd2, dustsink -#endif -#ifdef cisonew - REAL :: beta13, alpha14, d14cat, d13c_atm -#endif + ! Module-wide variables used in more than one subroutine + REAL :: beta13, alpha14, d14cat, d13c_atm ! cisonew contains !--------------------------------------------------------------------------------------------------------------------------------- subroutine ini_parambgc(kpie,kpje) ! - ! First, Initialze parameters of individual components with default values. + ! First, Initialze parameters of individual components with default values. ! The order of initialization can matter due to interdependcies. ! Then read the namelist and adjust rates to 'per time step' ! Re-adjust dependent parameter values ! Eventually write out the used parameters to the log file ! - implicit none + implicit none INTEGER, intent(in) :: kpie,kpje call ini_param_atm() ! Initialize default atmospheric parameters - call ini_stoichiometry() ! Initialize fixed stoichiometric parameters + call ini_stoichiometry() ! Initialize fixed stoichiometric parameters call ini_param_biol() ! initialize biological parameters -#ifdef AGG - call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) -#endif + if (use_AGG) then + call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) + end if call read_bgcnamelist() ! read the BGCPARAMS namelist call calc_param_atm() ! calculate atmospheric parameters after updating parameters via nml - call ini_fields_atm(kpie,kpje) ! initialize atmospheric fields with (updated) parameter values + call ini_fields_atm(kpie,kpje) ! initialize atmospheric fields with (updated) parameter values call readjust_param() ! potentially readjust namlist parameter-dependent parameters call rates_2_timestep() ! Converting rates from /d... to /dtb call write_parambgc() ! write out used parameters and calculate back rates from /dtb to /d.. end subroutine - !--------------------------------------------------------------------------------------------------------------------------------- subroutine ini_param_atm() ! @@ -125,50 +105,49 @@ subroutine ini_param_atm() atm_o2 = 196800. atm_n2 = 802000. -#ifdef natDIC - atm_co2_nat = 284.32 ! CMIP6 pre-industrial reference -#endif -#ifdef BROMO - !For now use 3.4ppt from Hense and Quack (2009; Biogeosciences) NEED TO - !BE UPDATED WITH Ziska et al. (2013) climatology database - atm_bromo = 3.4 -#endif -#ifdef cisonew - ! set standard carbon isotope ratios - re1312 = 0.0112372 - re14to = 1.170e-12 ! Karlen et al. 1965 / Orr et al. 2017 - ! set preindustr. d13c and bigd14C in atmosphere - prei13 = -6.5 - prei14 = 0. -#endif cisonew + if (use_natDIC) then + atm_co2_nat = 284.32 ! CMIP6 pre-industrial reference + end if + if (use_BROMO) then + !For now use 3.4ppt from Hense and Quack (2009; Biogeosciences) NEED TO + !BE UPDATED WITH Ziska et al. (2013) climatology database + atm_bromo = 3.4 + end if + if (use_cisonew) then + ! set standard carbon isotope ratios + re1312 = 0.0112372 + re14to = 1.170e-12 ! Karlen et al. 1965 / Orr et al. 2017 + ! set preindustr. d13c and bigd14C in atmosphere + prei13 = -6.5 + prei14 = 0. + end if end subroutine - !--------------------------------------------------------------------------------------------------------------------------------- subroutine calc_param_atm() ! ! AFTER having read the namelist: - ! calculate parameters for atmosphere from given parameters + ! calculate parameters for atmosphere from given parameters ! -#ifdef cisonew - beta13 = (prei13/1000.)+1. - alpha14 = 2.*(prei13+25.) - d14cat = (prei14+alpha14)/(1.-alpha14/1000.) - ! calculate atm_c13 and atm_c14 - atm_c13 = beta13*re1312*atm_co2/(1.+beta13*re1312) - d13C_atm = (((atm_c13/(atm_co2-atm_c13))/re1312)-1.)*1000. - ! absolute 14c concentration in preindustrial atmosphere - atm_c14 = ((d14cat/1000.)+1.)*re14to*atm_co2 - ! factor for normalizing 14C tracers (~1e-12) - c14fac = atm_c14/atm_co2 -#endif - end subroutine + if (use_cisonew) then + beta13 = (prei13/1000.)+1. + alpha14 = 2.*(prei13+25.) + d14cat = (prei14+alpha14)/(1.-alpha14/1000.) + ! calculate atm_c13 and atm_c14 + atm_c13 = beta13*re1312*atm_co2/(1.+beta13*re1312) + d13C_atm = (((atm_c13/(atm_co2-atm_c13))/re1312)-1.)*1000. + ! absolute 14c concentration in preindustrial atmosphere + atm_c14 = ((d14cat/1000.)+1.)*re14to*atm_co2 + ! factor for normalizing 14C tracers (~1e-12) + c14fac = atm_c14/atm_co2 + end if + end subroutine !--------------------------------------------------------------------------------------------------------------------------------- subroutine ini_fields_atm(kpie,kpje) - ! AFTER having read the nml: + ! AFTER having read the nml: ! Initialise atmosphere fields. We use a 2D representation of atmospheric - ! fields for simplicity, even for cases where actually only a scalar value + ! fields for simplicity, even for cases where actually only a scalar value ! is used. The overhead of this is small. If an atm-field is present in ! restart file (if BOXATM is activated), this will be overwritten later. @@ -176,22 +155,22 @@ subroutine ini_fields_atm(kpie,kpje) ! local variables INTEGER :: i,j - + DO j=1,kpje - DO i=1,kpie + DO i=1,kpie atm(i,j,iatmco2) = atm_co2 atm(i,j,iatmo2) = atm_o2 atm(i,j,iatmn2) = atm_n2 -#ifdef natDIC - atm(i,j,iatmnco2) = atm_co2_nat -#endif -#ifdef cisonew - atm(i,j,iatmc13) = atm_c13 - atm(i,j,iatmc14) = atm_c14/c14fac -#endif -#ifdef BROMO - atm(i,j,iatmbromo)= atm_bromo -#endif + if (use_natDIC) then + atm(i,j,iatmnco2) = atm_co2_nat + end if + if (use_cisonew) then + atm(i,j,iatmc13) = atm_c13 + atm(i,j,iatmc14) = atm_c14/c14fac + end if + if (use_BROMO) then + atm(i,j,iatmbromo)= atm_bromo + end if ENDDO ENDDO end subroutine @@ -204,7 +183,7 @@ subroutine ini_stoichiometry() ! extended redfield ratio declaration ! Note: stoichiometric ratios are based on Takahashi etal. (1985) ! P:N:C:-O2 + 1:16:122:172 - ro2ut = 172. + ro2ut = 172. rcar = 122. rnit = 16. rnoi = 1./rnit @@ -231,7 +210,7 @@ subroutine ini_param_biol() ! ! Initialize default biogeochemistry parameters. ! - ! Note that rates are initialized here in /d or equivalent and + ! Note that rates are initialized here in /d or equivalent and ! time step adjustment is done after reading the BGCPARAMS namelist ! !******************************************************************** @@ -240,38 +219,38 @@ subroutine ini_param_biol() phytomi = 1.e-11 !kmol/m3 - i.e. 1e-5 mmol P/m3 minimum concentration of phyto plankton (?js) pi_alpha= 0.02*0.4 ! initial slope of production vs irradiance curve (alpha) (0.002 for 10 steps per day) bkphy = 4.e-8 !kmol/m3 - i.e. 0.04 mmol P/m3 half saturation constant - dyphy = 0.004 !1/d -mortality rate of phytoplankton + dyphy = 0.004 !1/d -mortality rate of phytoplankton ! N2-Fixation following the parameterization in Kriest and Oschlies, 2015. - ! Factors tf2, tf1 and tf0 are a polynomial (2nd order) + ! Factors tf2, tf1 and tf0 are a polynomial (2nd order) ! approximation to the functional relationship by Breitbarth et al. (2007), ! for temperature dependence of Trichodesmium growth, their eq. (2) ! The relation will be scaled to their max. growth rate, tff. ! Note that the second order approx. is basically similar to their - ! function 2 for T-dependent nitrogen fixation multiplied by 4 + ! function 2 for T-dependent nitrogen fixation multiplied by 4 ! (2 [N atoms per mole] * 12 [light hrs per day]/6 [C-atoms per N-atoms]) bluefix = 0.005 !1/d ! nitrogen fixation rate by blue green algae (cyanobacteria) tf2 = -0.0042 tf1 = 0.2253 tf0 = -2.7819 - tff = 0.2395 - -#ifdef cisonew - ! Initial fractionation during photosynthesis - bifr13 = 0.98 - bifr14 = bifr13**2 - ! Decay parameter for sco214, HalfLive = 5730 years - c14_t_half = 5700.*365. ! Half life of 14C [days] -#endif -#ifdef BROMO - !Bromoform to phosphate ratio (Hense and Quack, 2009) - !JT: too little production: 0.25Gmol/yr rbro=6.72e-7*rnit - ! rbro=2.*6.72e-7*rnit - !JT Following discussion with B. Quack and D. Booge (01.07.2021), we agree to use 2.4e-6 - rbro = 2.4e-6*rnit - fbro1 = 1.0 - fbro2 = 1.0 -#endif + tff = 0.2395 + + if (use_cisonew) then + ! Initial fractionation during photosynthesis + bifr13 = 0.98 + bifr14 = bifr13**2 + ! Decay parameter for sco214, HalfLive = 5730 years + c14_t_half = 5700.*365. ! Half life of 14C [days] + end if + if (use_BROMO) then + !Bromoform to phosphate ratio (Hense and Quack, 2009) + !JT: too little production: 0.25Gmol/yr rbro=6.72e-7*rnit + ! rbro=2.*6.72e-7*rnit + !JT Following discussion with B. Quack and D. Booge (01.07.2021), we agree to use 2.4e-6 + rbro = 2.4e-6*rnit + fbro1 = 1.0 + fbro2 = 1.0 + end if !******************************************************************** ! Zooplankton parameters @@ -285,43 +264,43 @@ subroutine ini_param_biol() gammap = 0.04 !1/d -exudation rate gammaz = 0.06 !1/d -excretion rate ecan = 0.95 ! fraction of mortality as PO_4 -#ifdef AGG - zinges = 0.5 !dimensionless fraction -assimilation efficiency - epsher = 0.9 !dimensionless fraction -fraction of grazing egested -#elif defined(WLIN) - zinges = 0.7 !dimensionless fraction -assimilation efficiency - epsher = 0.85 !dimensionless fraction -fraction of grazing egested -#else - zinges = 0.6 !dimensionless fraction -assimilation efficiency - epsher = 0.8 !dimensionless fraction -fraction of grazing egest -#endif + if (use_AGG) then + zinges = 0.5 !dimensionless fraction -assimilation efficiency + epsher = 0.9 !dimensionless fraction -fraction of grazing egested + else if (use_WLIN) then + zinges = 0.7 !dimensionless fraction -assimilation efficiency + epsher = 0.85 !dimensionless fraction -fraction of grazing egested + else + zinges = 0.6 !dimensionless fraction -assimilation efficiency + epsher = 0.8 !dimensionless fraction -fraction of grazing egest + end if !******************************************************************** ! Shell production (CaCO3 and opal) parameters - !******************************************************************** - bkopal = 5.e-6 !kmol/m3 - i.e. 4.0 mmol Si/m3 half saturation constant -#ifdef AGG - rcalc = 14. ! calcium carbonate to organic phosphorous production ratio - ropal = 10.5 ! opal to organic phosphorous production ratio - calmax = 0.20 -#elif defined(WLIN) - rcalc = 33. ! calcium carbonate to organic phosphorous production ratio - ropal = 45. ! opal to organic phosphorous production ratio -#else - rcalc = 40. ! iris 40 !calcium carbonate to organic phosphorous production ratio - ropal = 30. ! iris 25 !opal to organic phosphorous production ratio -#endif - + !******************************************************************** + bkopal = 5.e-6 ! kmol/m3 - i.e. 4.0 mmol Si/m3 half saturation constant + if (use_AGG) then + rcalc = 14. ! calcium carbonate to organic phosphorous production ratio + ropal = 10.5 ! opal to organic phosphorous production ratio + calmax = 0.20 + else if (use_WLIN) then + rcalc = 33. ! calcium carbonate to organic phosphorous production ratio + ropal = 45. ! opal to organic phosphorous production ratio + else + rcalc = 40. ! iris 40 !calcium carbonate to organic phosphorous production ratio + ropal = 30. ! iris 25 !opal to organic phosphorous production ratio + end if + !******************************************************************** ! Remineralization and dissolution parameters (incl. DMS prod.) !******************************************************************** remido = 0.004 !1/d -remineralization rate (of DOM) ! deep sea remineralisation constants drempoc = 0.025 !1/d Aerob remineralization rate detritus - dremopal = 0.003 !1/d Dissolution rate for opal + dremopal = 0.003 !1/d Dissolution rate for opal dremn2o = 0.01 !1/d Remineralization rate of detritus on N2O - dremsul = 0.005 !1/d Remineralization rate for sulphate reduction - + dremsul = 0.005 !1/d Remineralization rate for sulphate reduction + ! Set constants for calculation of dms ( mo_carbch ) ! Parameters are a result from kettle optimisation 02.03.04 dmspar(6)=0.100000000E-07 !0 half saturation microbial @@ -337,12 +316,12 @@ subroutine ini_param_biol() !******************************************************************** ! parameters for sw-radiation attenuation ! Analog to Moore et al., Deep-Sea Research II 49 (2002), 403-462 - ! 1 kmolP = (122*12/60)*10^6 mg[Chlorophyl] + ! 1 kmolP = (122*12/60)*10^6 mg[Chlorophyl] ctochl = 60. ! C to Chlorophyl ratio atten_w = 0.04 ! yellow substances attenuation in 1/m - atten_c = 0.03*rcar*(12./ctochl)*1.e6 ! phytoplankton attenuation in 1/m - atten_uv= 0.33 ! - atten_f = 0.4 ! fraction of sw-radiation directly absorbed in surface layer + atten_c = 0.03*rcar*(12./ctochl)*1.e6 ! phytoplankton attenuation in 1/m + atten_uv= 0.33 ! + atten_f = 0.4 ! fraction of sw-radiation directly absorbed in surface layer ! (only if FB_BGC_OCE) [feedback bgc-ocean] !******************************************************************** @@ -352,7 +331,7 @@ subroutine ini_param_biol() ! the latter three values come from Johnson et al., 1997 fetune = 0.6 ! factor introduced to tune deposition/solubility perc_diron = fetune * 0.035 * 0.01 / 55.85 - fesoly = 0.5*1.e-9 ! max. diss. iron concentration in deep water + fesoly = 0.5*1.e-9 ! max. diss. iron concentration in deep water relaxfe = 0.05/365. ! 1/d complexation rate to relax iron concentration to fesoly !******************************************************************** @@ -361,19 +340,19 @@ subroutine ini_param_biol() wpoc = 5. !m/d Sinking speed of detritus iris : 5. wcal = 30. !m/d Sinking speed of CaCO3 shell material wopal = 30. !m/d Sinking speed of opal iris : 60 -#if defined(WLIN) && ! defined(AGG) - wmin = 1. !m/d minimum sinking speed - wmax = 60. !m/d maximum sinking speed - wlin = 60./2400. !m/d/m constant describing incr. with depth, r/a=1.0 -#endif -#ifndef AGG - dustd1 = 0.0001 !cm = 1 um, boundary between clay and silt - dustd2 = dustd1*dustd1 - dustsink = (9.81 * 86400. / 18. & ! g * sec per day / 18. - & * (claydens - 1025.) / 1.567 * 1000. & !excess density / dyn. visc. - & * dustd2 * 1.e-4) - wdust = dustsink -#endif + if (use_WLIN .and. .not. use_AGG) then + wmin = 1. !m/d minimum sinking speed + wmax = 60. !m/d maximum sinking speed + wlin = 60./2400. !m/d/m constant describing incr. with depth, r/a=1.0 + end if + if (.not. use_AGG) then + dustd1 = 0.0001 !cm = 1 um, boundary between clay and silt + dustd2 = dustd1*dustd1 + dustsink = (9.81 * 86400. / 18. & ! g * sec per day / 18. + & * (claydens - 1025.) / 1.567 * 1000. & !excess density / dyn. visc. + & * dustd2 * 1.e-4) + wdust = dustsink + end if end subroutine !--------------------------------------------------------------------------------------------------------------------------------- @@ -383,15 +362,12 @@ subroutine read_bgcnamelist() ! Note that afterward, i) rates need to be adjusted for timestep ! and some depending parameters need re-calculation ! - integer :: iounit - namelist /bgcparams/ bkphy,dyphy,bluefix,bkzoo,grazra,spemor,gammap,gammaz,ecan,zinges,epsher,bkopal,rcalc,ropal, & - & remido,drempoc,dremopal,dremn2o,dremsul,fetune,relaxfe,wpoc, & -#if defined(WLIN) && ! defined(AGG) - & wmin,wmax,wlin, & -#endif - & wcal,wopal + namelist /bgcparams/ bkphy,dyphy,bluefix,bkzoo,grazra,spemor,gammap,gammaz,ecan,zinges,epsher,bkopal,rcalc,ropal, & + remido,drempoc,dremopal,dremn2o,dremsul,fetune,relaxfe,wpoc, & + wmin,wmax,wlin, & ! use_WLIN and use_AGG + wcal,wopal open (newunit=iounit, file=bgc_namelist, status='old',action='read') read (unit=iounit, nml=BGCPARAMS) @@ -404,8 +380,8 @@ subroutine read_bgcnamelist() write(io_stdo_bgc,*) '------------------------------------------' endif - end subroutine - + end subroutine + !--------------------------------------------------------------------------------------------------------------------------------- subroutine readjust_param() ! @@ -428,14 +404,14 @@ subroutine rates_2_timestep() !******************************************************************** ! Phytoplankton parameters (incl. cyanobacteria) !******************************************************************** - dyphy = dyphy*dtb !1/d -mortality rate of phytoplankton + dyphy = dyphy*dtb !1/d -mortality rate of phytoplankton ! nitrogen fixation by blue green algae bluefix = bluefix*dtb !1/d -#ifdef cisonew - c14dec = 1.-(log(2.)/c14_t_half)*dtb ! lambda [1/day]; c14dec[-] -#endif + if (use_cisonew) then + c14dec = 1.-(log(2.)/c14_t_half)*dtb ! lambda [1/day]; c14dec[-] + end if !******************************************************************** ! Zooplankton parameters @@ -446,39 +422,38 @@ subroutine rates_2_timestep() gammaz = gammaz*dtb !1/d -excretion rate !******************************************************************** - ! Remineralization and dissolution parameters + ! Remineralization and dissolution parameters !******************************************************************** remido = remido*dtb !1/d -remineralization rate (of DOM) ! deep sea remineralisation constants drempoc = drempoc*dtb !1/d Aerob remineralization rate of detritus - dremopal = dremopal*dtb !1/d Dissolution rate of opal + dremopal = dremopal*dtb !1/d Dissolution rate of opal dremn2o = dremn2o*dtb !1/d Remineralization rate of detritus on N2O - dremsul = dremsul*dtb !1/d Remineralization rate for sulphate reduction + dremsul = dremsul*dtb !1/d Remineralization rate for sulphate reduction !******************************************************************** ! Dust deposition and iron solubility parameters !******************************************************************** relaxfe = relaxfe*dtb !1/d iron complexation rate - + !******************************************************************** ! Sinking parameters !******************************************************************** wpoc = wpoc*dtb !m/d Sinking speed detritusiris : 5. wcal = wcal*dtb !m/d Sinking speed CaCO3 wopal = wopal*dtb !m/d Sinking speed opal iris : 60 -#if defined(WLIN) && ! defined(AGG) - wmin = wmin*dtb !m/d minimum sinking speed - wmax = wmax*dtb !m/d maximum sinking speed - wlin = wlin*dtb !m/d/m constant describing incr. with depth, r/a=1.0 -#endif -#ifndef AGG - wdust = wdust*dtb !m/d dust sinking speed -#endif + if (use_WLIN .and. .not. use_AGG) then + wmin = wmin*dtb !m/d minimum sinking speed + wmax = wmax*dtb !m/d maximum sinking speed + wlin = wlin*dtb !m/d/m constant describing incr. with depth, r/a=1.0 + end if + if (.not. use_AGG) then + wdust = wdust*dtb !m/d dust sinking speed + end if end subroutine !--------------------------------------------------------------------------------------------------------------------------------- -#ifdef AGG subroutine ini_aggregation() ! ! parameters needed for the aggregation module @@ -508,8 +483,8 @@ subroutine ini_aggregation() ! alar1 = 1.0 !diameter of largest particle for size dependend aggregation and sinking [cm] ! alar1 = 0.75 !diameter of largest particle for size dependend aggregation and sinking [cm] alar1 = 0.5 !diameter of largest particle for size dependend aggregation and sinking [cm] - vsmall = 1.e-9 - safe = 1.e-6 + vsmall = 1.e-9 + safe = 1.e-6 pupper = safe/((FractDim+safe)*cellmass) plower = 1./(1.1*cellmass) zdis = 0.01 / ((FractDim + 0.01)*cellmass) @@ -524,18 +499,17 @@ subroutine ini_aggregation() dustd1 = 0.0001 !cm = 1 um, boundary between clay and silt dustd2 = dustd1*dustd1 dustd3 = dustd2*dustd1 - dustsink = (9.81 * 86400. / 18. & ! g * sec per day / 18. + dustsink = (9.81 * 86400. / 18. & ! g * sec per day / 18. & * (claydens - 1025.) / 1.567 * 1000. & !excess density / dyn. visc. & * dustd2 * 1.e-4)*dtb - if(dustsink.gt.cellsink) then + if(dustsink.gt.cellsink) then if (mnproc.eq.1)then write(io_stdo_bgc,*) ' dust sinking speed greater than cellsink' write(io_stdo_bgc,*) ' set dust sinking speed to cellsink' endif dustsink = cellsink endif - end subroutine -#endif + end subroutine !--------------------------------------------------------------------------------------------------------------------------------- subroutine write_parambgc() @@ -547,31 +521,31 @@ subroutine write_parambgc() REAL :: dtbinv dtbinv = 1./dtb - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*) '****************************************************************' WRITE(io_stdo_bgc,*) '* ' WRITE(io_stdo_bgc,*) '* Values of MO_PARAM_BGC variables : ' - WRITE(io_stdo_bgc,*) '* atm_co2 = ',atm_co2 -#ifdef cisonew - WRITE(io_stdo_bgc,*) '* atm_c13 = ',atm_c13 - WRITE(io_stdo_bgc,*) '* d13C_atm = ',d13C_atm - WRITE(io_stdo_bgc,*) '* atm_c14 = ',atm_c14 - WRITE(io_stdo_bgc,*) '* bifr13 = ',bifr13 - WRITE(io_stdo_bgc,*) '* bifr14 = ',bifr14 - WRITE(io_stdo_bgc,*) '* c14fac = ',c14fac - WRITE(io_stdo_bgc,*) '* prei13 = ',prei13 - WRITE(io_stdo_bgc,*) '* prei14 = ',prei14 - WRITE(io_stdo_bgc,*) '* re1312 = ',re1312 - WRITE(io_stdo_bgc,*) '* re14to = ',re14to - WRITE(io_stdo_bgc,*) '* c14_t_half = ',c14_t_half - WRITE(io_stdo_bgc,*) '* c14dec = ',c14dec - WRITE(io_stdo_bgc,*) '* beta13 = ',beta13 - WRITE(io_stdo_bgc,*) '* alpha14 = ',alpha14 - WRITE(io_stdo_bgc,*) '* d14cat = ',d14cat - WRITE(io_stdo_bgc,*) '* c14fac = ',c14fac -#endif - WRITE(io_stdo_bgc,*) '* atm_o2 = ',atm_o2 - WRITE(io_stdo_bgc,*) '* atm_n2 = ',atm_n2 + WRITE(io_stdo_bgc,*) '* atm_co2 = ',atm_co2 + if (use_cisonew) then + WRITE(io_stdo_bgc,*) '* atm_c13 = ',atm_c13 + WRITE(io_stdo_bgc,*) '* d13C_atm = ',d13C_atm + WRITE(io_stdo_bgc,*) '* atm_c14 = ',atm_c14 + WRITE(io_stdo_bgc,*) '* bifr13 = ',bifr13 + WRITE(io_stdo_bgc,*) '* bifr14 = ',bifr14 + WRITE(io_stdo_bgc,*) '* c14fac = ',c14fac + WRITE(io_stdo_bgc,*) '* prei13 = ',prei13 + WRITE(io_stdo_bgc,*) '* prei14 = ',prei14 + WRITE(io_stdo_bgc,*) '* re1312 = ',re1312 + WRITE(io_stdo_bgc,*) '* re14to = ',re14to + WRITE(io_stdo_bgc,*) '* c14_t_half = ',c14_t_half + WRITE(io_stdo_bgc,*) '* c14dec = ',c14dec + WRITE(io_stdo_bgc,*) '* beta13 = ',beta13 + WRITE(io_stdo_bgc,*) '* alpha14 = ',alpha14 + WRITE(io_stdo_bgc,*) '* d14cat = ',d14cat + WRITE(io_stdo_bgc,*) '* c14fac = ',c14fac + end if + WRITE(io_stdo_bgc,*) '* atm_o2 = ',atm_o2 + WRITE(io_stdo_bgc,*) '* atm_n2 = ',atm_n2 WRITE(io_stdo_bgc,*) '* phytomi = ',phytomi WRITE(io_stdo_bgc,*) '* grami = ',grami WRITE(io_stdo_bgc,*) '* remido = ',remido*dtbinv @@ -582,25 +556,25 @@ subroutine write_parambgc() WRITE(io_stdo_bgc,*) '* spemor = ',spemor*dtbinv WRITE(io_stdo_bgc,*) '* gammap = ',gammap*dtbinv WRITE(io_stdo_bgc,*) '* gammaz = ',gammaz*dtbinv - WRITE(io_stdo_bgc,*) '* ecan = ',ecan + WRITE(io_stdo_bgc,*) '* ecan = ',ecan WRITE(io_stdo_bgc,*) '* pi_alpha = ',pi_alpha WRITE(io_stdo_bgc,*) '* bkphy = ',bkphy - WRITE(io_stdo_bgc,*) '* bkzoo = ',bkzoo - WRITE(io_stdo_bgc,*) '* bkopal = ',bkopal + WRITE(io_stdo_bgc,*) '* bkzoo = ',bkzoo + WRITE(io_stdo_bgc,*) '* bkopal = ',bkopal WRITE(io_stdo_bgc,*) '* wpoc = ',wpoc*dtbinv - WRITE(io_stdo_bgc,*) '* wcal = ',wcal*dtbinv - WRITE(io_stdo_bgc,*) '* wopal = ',wopal*dtbinv - WRITE(io_stdo_bgc,*) '* drempoc = ',drempoc*dtbinv - WRITE(io_stdo_bgc,*) '* dremopal = ',dremopal*dtbinv - WRITE(io_stdo_bgc,*) '* dremn2o = ',dremn2o*dtbinv - WRITE(io_stdo_bgc,*) '* dremsul = ',dremsul*dtbinv - WRITE(io_stdo_bgc,*) '* bluefix = ',bluefix*dtbinv - WRITE(io_stdo_bgc,*) '* tf0 = ',tf0 - WRITE(io_stdo_bgc,*) '* tf1 = ',tf1 - WRITE(io_stdo_bgc,*) '* tf2 = ',tf2 - WRITE(io_stdo_bgc,*) '* tff = ',tff - WRITE(io_stdo_bgc,*) '* ro2ut = ',ro2ut - WRITE(io_stdo_bgc,*) '* rcar = ',rcar + WRITE(io_stdo_bgc,*) '* wcal = ',wcal*dtbinv + WRITE(io_stdo_bgc,*) '* wopal = ',wopal*dtbinv + WRITE(io_stdo_bgc,*) '* drempoc = ',drempoc*dtbinv + WRITE(io_stdo_bgc,*) '* dremopal = ',dremopal*dtbinv + WRITE(io_stdo_bgc,*) '* dremn2o = ',dremn2o*dtbinv + WRITE(io_stdo_bgc,*) '* dremsul = ',dremsul*dtbinv + WRITE(io_stdo_bgc,*) '* bluefix = ',bluefix*dtbinv + WRITE(io_stdo_bgc,*) '* tf0 = ',tf0 + WRITE(io_stdo_bgc,*) '* tf1 = ',tf1 + WRITE(io_stdo_bgc,*) '* tf2 = ',tf2 + WRITE(io_stdo_bgc,*) '* tff = ',tff + WRITE(io_stdo_bgc,*) '* ro2ut = ',ro2ut + WRITE(io_stdo_bgc,*) '* rcar = ',rcar WRITE(io_stdo_bgc,*) '* rnit = ',rnit WRITE(io_stdo_bgc,*) '* rnoi = ',rnoi WRITE(io_stdo_bgc,*) '* rdnit0 = ',rdnit0 @@ -627,60 +601,62 @@ subroutine write_parambgc() WRITE(io_stdo_bgc,*) '* dmspar(3) = ',dmspar(3) WRITE(io_stdo_bgc,*) '* dmspar(4) = ',dmspar(4) WRITE(io_stdo_bgc,*) '* dmspar(5) = ',dmspar(5) -#ifdef BROMO - WRITE(io_stdo_bgc,*) '* rbro = ',rbro - WRITE(io_stdo_bgc,*) '* atm_bromo = ',atm_bromo - WRITE(io_stdo_bgc,*) '* fbro1 = ',fbro1 - WRITE(io_stdo_bgc,*) '* fbro2 = ',fbro2 -#endif -#if defined(WLIN) && ! defined(AGG) - WRITE(io_stdo_bgc,*) '* wmin = ',wmin - WRITE(io_stdo_bgc,*) '* wmax = ',wmax - WRITE(io_stdo_bgc,*) '* wlin = ',wlin -#endif -#ifndef AGG - WRITE(io_stdo_bgc,*) '* dustd1 = ',dustd1 - WRITE(io_stdo_bgc,*) '* dustd2 = ',dustd2 - WRITE(io_stdo_bgc,*) '* dustsink = ',dustsink - WRITE(io_stdo_bgc,*) '* wdust = ',wdust*dtbinv -#else - write(io_stdo_bgc,*) - write(io_stdo_bgc,*) '****************************************************************' - write(io_stdo_bgc,*) 'HAMOCC aggregate sinking scheme:' - write(io_stdo_bgc,*) ' alar1 = ',alar1 - write(io_stdo_bgc,*) ' alar2 = ',alar2 - write(io_stdo_bgc,*) ' alar3 = ',alar3 - write(io_stdo_bgc,*) ' alow1 = ',alow1 - write(io_stdo_bgc,*) ' alow2 = ',alow2 - write(io_stdo_bgc,*) ' alow3 = ',alow3 - write(io_stdo_bgc,*) ' calmax = ',calmax - write(io_stdo_bgc,*) ' cellmass = ',cellmass - write(io_stdo_bgc,*) ' cellsink = ',cellsink - write(io_stdo_bgc,*) ' dustd1 = ',dustd1 - write(io_stdo_bgc,*) ' dustd2 = ',dustd2 - write(io_stdo_bgc,*) ' dustd3 = ',dustd3 - write(io_stdo_bgc,*) ' fractdim = ',fractdim - write(io_stdo_bgc,*) ' fse = ',fse - write(io_stdo_bgc,*) ' fsh = ',fsh - write(io_stdo_bgc,*) ' nmldmin = ',nmldmin - write(io_stdo_bgc,*) ' plower = ',plower - write(io_stdo_bgc,*) ' pupper = ',pupper - write(io_stdo_bgc,*) ' safe = ',safe - write(io_stdo_bgc,*) ' sinkexp = ',sinkexp - write(io_stdo_bgc,*) ' stick = ',stick - write(io_stdo_bgc,*) ' tmfac = ',tmfac - write(io_stdo_bgc,*) ' tsfac = ',tsfac - write(io_stdo_bgc,*) ' vsmall = ',vsmall - write(io_stdo_bgc,*) ' zdis = ',zdis - write(io_stdo_bgc,*) ' Maximum sinking speed for aggregates of ' - write(io_stdo_bgc,*) ' maximum size ', alar1, ' cm is ' - write(io_stdo_bgc,*) cellsink/dtb*(alar1/alow1)**SinkExp, ' m/day' - write(io_stdo_bgc,*) ' dust diameter (cm)', dustd1 - write(io_stdo_bgc,*) ' dust sinking speed (m/d)', dustsink / dtb - write(io_stdo_bgc,*) '****************************************************************' -#endif + if (use_BROMO) then + WRITE(io_stdo_bgc,*) '* rbro = ',rbro + WRITE(io_stdo_bgc,*) '* atm_bromo = ',atm_bromo + WRITE(io_stdo_bgc,*) '* fbro1 = ',fbro1 + WRITE(io_stdo_bgc,*) '* fbro2 = ',fbro2 + end if + if (use_WLIN .and. .not. use_AGG) then + WRITE(io_stdo_bgc,*) '* wmin = ',wmin + WRITE(io_stdo_bgc,*) '* wmax = ',wmax + WRITE(io_stdo_bgc,*) '* wlin = ',wlin + end if + if (.not. use_AGG) then + WRITE(io_stdo_bgc,*) '* dustd1 = ',dustd1 + WRITE(io_stdo_bgc,*) '* dustd2 = ',dustd2 + WRITE(io_stdo_bgc,*) '* dustsink = ',dustsink + WRITE(io_stdo_bgc,*) '* wdust = ',wdust*dtbinv + else + write(io_stdo_bgc,*) + write(io_stdo_bgc,*) '****************************************************************' + write(io_stdo_bgc,*) 'HAMOCC aggregate sinking scheme:' + write(io_stdo_bgc,*) ' alar1 = ',alar1 + write(io_stdo_bgc,*) ' alar2 = ',alar2 + write(io_stdo_bgc,*) ' alar3 = ',alar3 + write(io_stdo_bgc,*) ' alow1 = ',alow1 + write(io_stdo_bgc,*) ' alow2 = ',alow2 + write(io_stdo_bgc,*) ' alow3 = ',alow3 + write(io_stdo_bgc,*) ' calmax = ',calmax + write(io_stdo_bgc,*) ' cellmass = ',cellmass + write(io_stdo_bgc,*) ' cellsink = ',cellsink + write(io_stdo_bgc,*) ' dustd1 = ',dustd1 + write(io_stdo_bgc,*) ' dustd2 = ',dustd2 + write(io_stdo_bgc,*) ' dustd3 = ',dustd3 + write(io_stdo_bgc,*) ' fractdim = ',fractdim + write(io_stdo_bgc,*) ' fse = ',fse + write(io_stdo_bgc,*) ' fsh = ',fsh + write(io_stdo_bgc,*) ' nmldmin = ',nmldmin + write(io_stdo_bgc,*) ' plower = ',plower + write(io_stdo_bgc,*) ' pupper = ',pupper + write(io_stdo_bgc,*) ' safe = ',safe + write(io_stdo_bgc,*) ' sinkexp = ',sinkexp + write(io_stdo_bgc,*) ' stick = ',stick + write(io_stdo_bgc,*) ' tmfac = ',tmfac + write(io_stdo_bgc,*) ' tsfac = ',tsfac + write(io_stdo_bgc,*) ' vsmall = ',vsmall + write(io_stdo_bgc,*) ' zdis = ',zdis + write(io_stdo_bgc,*) ' Maximum sinking speed for aggregates of ' + write(io_stdo_bgc,*) ' maximum size ', alar1, ' cm is ' + write(io_stdo_bgc,*) cellsink/dtb*(alar1/alow1)**SinkExp, ' m/day' + write(io_stdo_bgc,*) ' dust diameter (cm)', dustd1 + write(io_stdo_bgc,*) ' dust sinking speed (m/d)', dustsink / dtb + write(io_stdo_bgc,*) '****************************************************************' + end if WRITE(io_stdo_bgc,*) '* claydens = ',claydens WRITE(io_stdo_bgc,*) '****************************************************************' - ENDIF - end subroutine + ENDIF + + end subroutine write_parambgc + end module mo_param_bgc diff --git a/hamocc/mo_sedmnt.F90 b/hamocc/mo_sedmnt.F90 index 7fab49b4..9b4a9db5 100644 --- a/hamocc/mo_sedmnt.F90 +++ b/hamocc/mo_sedmnt.F90 @@ -72,6 +72,7 @@ MODULE mo_sedmnt use mo_param1_bgc, only: ks,ksp,nsedtra,npowtra use mo_control_bgc, only: io_stdo_bgc use mod_xc, only: mnproc + use mo_control_bgc, only: use_sedbypass,use_cisonew implicit none @@ -188,11 +189,11 @@ SUBROUTINE ini_sedmnt(kpie,kpje,kpke,omask,sed_por) seddw(k) = 0.5 * (dzs(k) + dzs(k+1)) ! distance between grid cell centers (pressure points) enddo -#ifndef sedbypass - ! 2d and 3d fields are not allocated in case of sedbypass - ! so only initialize them if we are using the sediment - CALL ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) -#endif + if (.not. use_sedbypass) then + ! 2d and 3d fields are not allocated in case of sedbypass + ! so only initialize them if we are using the sediment + CALL ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) + end if END SUBROUTINE ini_sedmnt !======================================================================== @@ -320,14 +321,14 @@ SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) ALLOCATE (prorca(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prorca' prorca(:,:) = 0.0 -#ifdef cisonew - ALLOCATE (pror13(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory pror13' - pror13(:,:) = 0.0 - ALLOCATE (pror14(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory pror14' - pror14(:,:) = 0.0 -#endif + if (use_cisonew) then + ALLOCATE (pror13(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory pror13' + pror13(:,:) = 0.0 + ALLOCATE (pror14(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory pror14' + pror14(:,:) = 0.0 + end if IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable prcaca ...' @@ -338,14 +339,14 @@ SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) ALLOCATE (prcaca(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prcaca' prcaca(:,:) = 0.0 -#ifdef cisonew - ALLOCATE (prca13(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory prca13' - prca13(:,:) = 0.0 - ALLOCATE (prca14(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory prca14' - prca14(:,:) = 0.0 -#endif + if (use_cisonew) then + ALLOCATE (prca13(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory prca13' + prca13(:,:) = 0.0 + ALLOCATE (prca14(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory prca14' + prca14(:,:) = 0.0 + end if IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable produs ...' @@ -358,119 +359,119 @@ SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) produs(:,:) = 0.0 -#ifndef sedbypass - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable sedlay ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - WRITE(io_stdo_bgc,*)'Forth dimension : ',nsedtra - ENDIF - - ALLOCATE (sedlay(kpie,kpje,ks,nsedtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory sedlay' - sedlay(:,:,:,:) = 0.0 - - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable sedhpl ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (sedhpl(kpie,kpje,ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory sedhpl' - sedhpl(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable porsol ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (porsol(kpie,kpje,ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory porsol' - porsol(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable porwah ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (porwah(kpie,kpje,ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory porwah' - porwah(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable porwat ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (porwat(kpie,kpje,ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory porwat' - porwat(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable solfu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (solfu(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory solfu' - solfu(:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable zcoefsu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (zcoefsu(kpie,kpje,0:ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory zcoefsu' - zcoefsu(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable zcoeflo ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - ENDIF - - ALLOCATE (zcoeflo(kpie,kpje,0:ks),stat=errstat) - if(errstat.ne.0) stop 'not enough memory zcoeflo' - zcoeflo(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable burial ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nsedtra - ENDIF - - ALLOCATE (burial(kpie,kpje,nsedtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory burial' - burial(:,:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable powtra ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',ks - WRITE(io_stdo_bgc,*)'Forth dimension : ',npowtra - ENDIF - - ALLOCATE (powtra(kpie,kpje,ks,npowtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory powtra' - powtra(:,:,:,:) = 0.0 -#endif + if (.not. use_sedbypass) then + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable sedlay ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + WRITE(io_stdo_bgc,*)'Forth dimension : ',nsedtra + ENDIF + + ALLOCATE (sedlay(kpie,kpje,ks,nsedtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory sedlay' + sedlay(:,:,:,:) = 0.0 + + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable sedhpl ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (sedhpl(kpie,kpje,ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory sedhpl' + sedhpl(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable porsol ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (porsol(kpie,kpje,ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory porsol' + porsol(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable porwah ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (porwah(kpie,kpje,ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory porwah' + porwah(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable porwat ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (porwat(kpie,kpje,ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory porwat' + porwat(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable solfu ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (solfu(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory solfu' + solfu(:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable zcoefsu ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (zcoefsu(kpie,kpje,0:ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory zcoefsu' + zcoefsu(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable zcoeflo ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + ENDIF + + ALLOCATE (zcoeflo(kpie,kpje,0:ks),stat=errstat) + if(errstat.ne.0) stop 'not enough memory zcoeflo' + zcoeflo(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable burial ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',nsedtra + ENDIF + + ALLOCATE (burial(kpie,kpje,nsedtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory burial' + burial(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable powtra ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + WRITE(io_stdo_bgc,*)'Forth dimension : ',npowtra + ENDIF + + ALLOCATE (powtra(kpie,kpje,ks,npowtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory powtra' + powtra(:,:,:,:) = 0.0 + end if !****************************************************************************** diff --git a/hamocc/ncout_hamocc.F90 b/hamocc/ncout_hamocc.F90 index 7d29652e..dfb79d06 100644 --- a/hamocc/ncout_hamocc.F90 +++ b/hamocc/ncout_hamocc.F90 @@ -23,145 +23,133 @@ subroutine ncwrt_bgc(iogrp) ! --- output routine for HAMOCC diagnostic fields ! --- ------------------------------------------- ! - use mod_time, only: date0,date,calendar,nstep,nstep_in_day, & - & nday_of_year,time0,time + use mod_time, only: date0,date,calendar,nstep,nstep_in_day, & + nday_of_year,time0,time use mod_xc, only: kdm,mnproc,itdm,jtdm,lp use mod_grid, only: depths - use mod_dia, only: diafnm,sigmar1,iotype,ddm,depthslev, & - & depthslev_bnds - use mo_control_bgc, only: dtbgc + use mod_dia, only: diafnm,sigmar1,iotype,ddm,depthslev, & + depthslev_bnds + use mo_control_bgc, only: dtbgc,use_cisonew,use_AGG,use_CFC,use_natDIC, & + use_BROMO,use_sedbypass,use_BOXATM use mo_vgrid, only: k0100,k0500,k1000,k2000,k4000 use mo_param1_bgc, only: ks - use mod_nctools, only: ncwrt1,ncdims,nctime,ncfcls,ncfopn, & - & ncdimc - use mo_bgcmean, only: domassfluxes, & - & flx_ndep,flx_oalk, & - & flx_cal0100,flx_cal0500,flx_cal1000, & - & flx_cal2000,flx_cal4000,flx_cal_bot, & - & flx_car0100,flx_car0500,flx_car1000, & - & flx_car2000,flx_car4000,flx_car_bot, & - & flx_bsi0100,flx_bsi0500,flx_bsi1000, & - & flx_bsi2000,flx_bsi4000,flx_bsi_bot, & - & flx_sediffic,flx_sediffal,flx_sediffph, & - & flx_sediffox,flx_sediffn2,flx_sediffno3, & - & flx_sediffsi, & - & jsediffic,jsediffal,jsediffph,jsediffox, & - & jsediffn2,jsediffno3,jsediffsi, & - & jalkali,jano3,jasize,jatmco2, & - & jbsiflx0100,jbsiflx0500,jbsiflx1000, & - & jbsiflx2000,jbsiflx4000,jbsiflx_bot, & - & jcalc,jcalflx0100,jcalflx0500,jcalflx1000, & - & jcalflx2000,jcalflx4000,jcalflx_bot, & - & jcarflx0100,jcarflx0500,jcarflx1000, & - & jcarflx2000,jcarflx4000,jcarflx_bot, & - & jco2fxd,jco2fxu,jco3,jdic,jdicsat, & - & jdms,jdms_bac,jdms_uv,jdmsflux,jdmsprod, & - & jdoc,jdp,jeps,jexpoca,jexport,jexposi, & - & jgrazer, & - & jintdnit,jintnfix,jintphosy,jiron,jirsi, & - & jkwco2,jlvlalkali,jlvlano3,jlvlasize, & - & jlvlbigd14c,jlvlbromo,jlvlcalc,jlvlcalc13, & - & jlvlcfc11,jlvlcfc12,jlvlco3,jlvld13c, & - & jlvld14c,jlvldic,jlvldic13,jlvldic14, & - & jlvldicsat,jlvldoc,jlvldoc13,jlvleps, & - & jlvlgrazer,jlvlgrazer13,jlvliron,jlvln2o, & - & jlvlnatalkali,jlvlnatcalc,jlvlnatco3, & - & jlvlnatdic,jlvlnatomegaa,jlvlnatomegac, & - & jlvlnos,jlvlo2sat,jlvlomegaa,jlvlomegac, & - & jlvlopal,jlvloxygen,jlvlph,jlvlphosph, & - & jlvlphosy,jlvlphyto,jlvlphyto13,jlvlpoc, & - & jlvlpoc13,jlvlprefalk,jlvlprefdic, & - & jlvlprefo2,jlvlprefpo4,jlvlsf6,jlvlsilica, & - & jlvlwnos,jlvlwphy,jn2o, & - & jn2ofx,jndepfx,jniflux,jnos,joalkfx, & - & jo2sat,jomegaa,jomegac,jopal,joxflux,joxygen,jpco2, & - & jpco2m,jkwco2khm,jco2kh,jco2khm, & - & jph,jphosph,jphosy,jphyto,jpoc,jprefalk, & - & jprefdic,jprefo2,jprefpo4,jsilica, & - & jsrfalkali,jsrfano3,jsrfdic,jsrfiron, & - & jsrfoxygen,jsrfphosph,jsrfphyto,jsrfsilica,jsrfph, & - & jwnos,jwphy, & - & lyr_dp,lyr_dic,lyr_alkali,lyr_phosph, & - & lyr_oxygen,lyr_ano3,lyr_silica,lyr_doc, & - & lyr_phyto,lyr_grazer,lyr_poc,lyr_calc, & - & lyr_opal,lyr_iron,lyr_phosy,lyr_co3,lyr_ph, & - & lyr_omegaa,lyr_omegac,lyr_n2o,lyr_prefo2, & - & lyr_o2sat,lyr_prefpo4,lyr_prefalk, & - & lyr_prefdic,lyr_dicsat, & - & lvl_dic,lvl_alkali, & - & lvl_phosph,lvl_oxygen,lvl_ano3,lvl_silica, & - & lvl_doc,lvl_phyto,lvl_grazer,lvl_poc, & - & lvl_calc,lvl_opal,lvl_iron,lvl_phosy, & - & lvl_co3,lvl_ph,lvl_omegaa,lvl_omegac, & - & lvl_n2o,lvl_prefo2,lvl_o2sat,lvl_prefpo4, & - & lvl_prefalk,lvl_prefdic,lvl_dicsat, & - & lvl_o2sat,srf_n2ofx,srf_atmco2,srf_kwco2, & - & srf_kwco2khm,srf_co2kh,srf_co2khm,srf_pco2m, & - & srf_pco2,srf_dmsflux,srf_co2fxd, & - & srf_co2fxu,srf_oxflux,srf_niflux,srf_dms, & - & srf_dmsprod,srf_dms_bac,srf_dms_uv, & - & srf_export,srf_exposi,srf_expoca,srf_dic, & - & srf_alkali,srf_phosph,srf_oxygen,srf_ano3, & - & srf_silica,srf_iron,srf_phyto,srf_ph, & - & int_phosy,int_nfix,int_dnit, & - & nbgc,nacc_bgc,bgcwrt,glb_inventory,bgct2d, & - & nbgcmax,glb_ncformat,glb_compflag, & - & glb_fnametag,filefq_bgc,diagfq_bgc, & - & filemon_bgc,fileann_bgc,ip,wrtlyr,wrtlvl,wrtsrf, & - & loglyr,loglvl,logsrf,inilvl,inilyr,inisrf, & - & msklvl,msksrf,finlyr -#ifdef AGG - use mo_bgcmean, only: lyr_nos,lyr_wphy, lyr_wnos,lyr_eps, & - & lyr_asize,lvl_nos,lvl_wphy,lvl_wnos,lvl_eps, & - & lvl_asize -#endif -#ifdef BROMO - use mo_bgcmean, only: jbromo,jbromofx,jsrfbromo,jbromo_prod, & - & jbromo_uv,jatmbromo,lvl_bromo,srf_bromofx, & - & srf_bromo,int_bromopro,int_bromouv, & - & srf_atmbromo,lyr_bromo -#endif -#ifdef CFC - use mo_bgcmean,only: jcfc11,jcfc12,jsf6,jcfc11fx,jcfc12fx,jsf6fx, & - & lvl_cfc11,lvl_cfc12,lvl_sf6,srf_cfc11, & - & srf_cfc12,srf_sf6,lyr_cfc11,lyr_cfc12, & - & lyr_sf6 -#endif -#ifdef cisonew + use mod_nctools, only: ncwrt1,ncdims,nctime,ncfcls,ncfopn,ncdimc + use mo_bgcmean, only: domassfluxes, & + flx_ndep,flx_oalk, & + flx_cal0100,flx_cal0500,flx_cal1000, & + flx_cal2000,flx_cal4000,flx_cal_bot, & + flx_car0100,flx_car0500,flx_car1000, & + flx_car2000,flx_car4000,flx_car_bot, & + flx_bsi0100,flx_bsi0500,flx_bsi1000, & + flx_bsi2000,flx_bsi4000,flx_bsi_bot, & + flx_sediffic,flx_sediffal,flx_sediffph, & + flx_sediffox,flx_sediffn2,flx_sediffno3,flx_sediffsi, & + jsediffic,jsediffal,jsediffph,jsediffox, & + jsediffn2,jsediffno3,jsediffsi, & + jalkali,jano3,jasize,jatmco2, & + jbsiflx0100,jbsiflx0500,jbsiflx1000, & + jbsiflx2000,jbsiflx4000,jbsiflx_bot, & + jcalc,jcalflx0100,jcalflx0500,jcalflx1000, & + jcalflx2000,jcalflx4000,jcalflx_bot, & + jcarflx0100,jcarflx0500,jcarflx1000, & + jcarflx2000,jcarflx4000,jcarflx_bot, & + jco2fxd,jco2fxu,jco3,jdic,jdicsat, & + jdms,jdms_bac,jdms_uv,jdmsflux,jdmsprod, & + jdoc,jdp,jeps,jexpoca,jexport,jexposi, & + jgrazer, & + jintdnit,jintnfix,jintphosy,jiron,jirsi, & + jkwco2,jlvlalkali,jlvlano3,jlvlasize, & + jlvlbigd14c,jlvlbromo,jlvlcalc,jlvlcalc13, & + jlvlcfc11,jlvlcfc12,jlvlco3,jlvld13c, & + jlvld14c,jlvldic,jlvldic13,jlvldic14, & + jlvldicsat,jlvldoc,jlvldoc13,jlvleps, & + jlvlgrazer,jlvlgrazer13,jlvliron,jlvln2o, & + jlvlnatalkali,jlvlnatcalc,jlvlnatco3, & + jlvlnatdic,jlvlnatomegaa,jlvlnatomegac, & + jlvlnos,jlvlo2sat,jlvlomegaa,jlvlomegac, & + jlvlopal,jlvloxygen,jlvlph,jlvlphosph, & + jlvlphosy,jlvlphyto,jlvlphyto13,jlvlpoc, & + jlvlpoc13,jlvlprefalk,jlvlprefdic, & + jlvlprefo2,jlvlprefpo4,jlvlsf6,jlvlsilica, & + jlvlwnos,jlvlwphy,jn2o, & + jn2ofx,jndepfx,jniflux,jnos,joalkfx, & + jo2sat,jomegaa,jomegac,jopal,joxflux,joxygen,jpco2, & + jpco2m,jkwco2khm,jco2kh,jco2khm, & + jph,jphosph,jphosy,jphyto,jpoc,jprefalk, & + jprefdic,jprefo2,jprefpo4,jsilica, & + jsrfalkali,jsrfano3,jsrfdic,jsrfiron, & + jsrfoxygen,jsrfphosph,jsrfphyto,jsrfsilica,jsrfph, & + jwnos,jwphy, & + lyr_dp,lyr_dic,lyr_alkali,lyr_phosph, & + lyr_oxygen,lyr_ano3,lyr_silica,lyr_doc, & + lyr_phyto,lyr_grazer,lyr_poc,lyr_calc, & + lyr_opal,lyr_iron,lyr_phosy,lyr_co3,lyr_ph, & + lyr_omegaa,lyr_omegac,lyr_n2o,lyr_prefo2, & + lyr_o2sat,lyr_prefpo4,lyr_prefalk, & + lyr_prefdic,lyr_dicsat, & + lvl_dic,lvl_alkali, & + lvl_phosph,lvl_oxygen,lvl_ano3,lvl_silica, & + lvl_doc,lvl_phyto,lvl_grazer,lvl_poc, & + lvl_calc,lvl_opal,lvl_iron,lvl_phosy, & + lvl_co3,lvl_ph,lvl_omegaa,lvl_omegac, & + lvl_n2o,lvl_prefo2,lvl_o2sat,lvl_prefpo4, & + lvl_prefalk,lvl_prefdic,lvl_dicsat, & + lvl_o2sat,srf_n2ofx,srf_atmco2,srf_kwco2, & + srf_kwco2khm,srf_co2kh,srf_co2khm,srf_pco2m, & + srf_pco2,srf_dmsflux,srf_co2fxd, & + srf_co2fxu,srf_oxflux,srf_niflux,srf_dms, & + srf_dmsprod,srf_dms_bac,srf_dms_uv, & + srf_export,srf_exposi,srf_expoca,srf_dic, & + srf_alkali,srf_phosph,srf_oxygen,srf_ano3, & + srf_silica,srf_iron,srf_phyto,srf_ph, & + int_phosy,int_nfix,int_dnit, & + nbgc,nacc_bgc,bgcwrt,glb_inventory,bgct2d, & + nbgcmax,glb_ncformat,glb_compflag, & + glb_fnametag,filefq_bgc,diagfq_bgc, & + filemon_bgc,fileann_bgc,ip,wrtlyr,wrtlvl,wrtsrf, & + loglyr,loglvl,logsrf,inilvl,inilyr,inisrf, & + msklvl,msksrf,finlyr, & + lyr_nos,lyr_wphy, lyr_wnos,lyr_eps, & + lyr_asize,lvl_nos,lvl_wphy,lvl_wnos,lvl_eps, & + lvl_asize, & + jbromo,jbromofx,jsrfbromo,jbromo_prod, & + jbromo_uv,jatmbromo,lvl_bromo,srf_bromofx, & + srf_bromo,int_bromopro,int_bromouv, & + srf_atmbromo,lyr_bromo, & + jcfc11,jcfc12,jsf6,jcfc11fx,jcfc12fx,jsf6fx, & + lvl_cfc11,lvl_cfc12,lvl_sf6,srf_cfc11, & + srf_cfc12,srf_sf6,lyr_cfc11,lyr_cfc12, & + lyr_sf6, & + jdic13,jdic14,jd13c,jd14c,jbigd14c,jpoc13, & + jdoc13,jcalc13,jphyto13,jgrazer13,jco213fxd, & + jco213fxu,jco214fxd,jco214fxu,jatmc13, & + jatmc14,jdic13,jdic14,jd13c,jd14c,jbigd14c, & + srf_co213fxd,srf_co213fxu,srf_co214fxd, & + srf_co214fxu,srf_atmc13,srf_atmc14,lyr_dic13, & + lyr_dic14,lyr_d13c,lyr_d14c,lyr_bigd14c, & + lyr_poc13,lyr_doc13,lyr_calc13,lyr_phyto13, & + lyr_grazer13,lvl_dic13,lvl_dic14,lvl_d13c, & + lvl_d14c,lvl_bigd14c,lvl_poc13,lvl_doc13, & + lvl_calc13,lvl_phyto13,lvl_grazer13, & + jnatalkali,jnatdic,jnatcalc,jnatco3,jnatph, & + jnatomegaa,jnatomegac,jlvlnatph, & + jsrfnatdic,jsrfnatalk,jsrfnatph, & + jnatpco2,jnatco2fx,lyr_natco3, & + lyr_natalkali,lyr_natdic,lyr_natph,lyr_natcalc, & + lyr_natomegaa,lyr_natomegac,lvl_natco3, & + lvl_natalkali,lvl_natdic,lvl_natph,lvl_natcalc, & + lvl_natomegaa,lvl_natomegac,srf_natdic, & + srf_natalkali,srf_natpco2,srf_natco2fx,srf_natph, & + jpowaic,jpowaal,jpowaph,jpowaox,jpown2, & + jpowno3,jpowasi,jssso12,jssssil,jssster, & + jsssc12,jbursssc12,jburssssil,jburssster, & + sdm_powaic,sdm_powaal,sdm_powaph,sdm_powaox, & + sdm_pown2,sdm_powno3,sdm_powasi,sdm_ssso12, & + sdm_ssssil,sdm_sssc12,sdm_ssster,jburssso12, & + bur_sssc12,bur_ssssil,bur_ssster,bur_ssso12, & + inisdm,inibur,wrtsdm,accbur,accsdm,wrtbur, & + jatmco2,jatmn2,jatmo2,srf_atmo2,srf_atmn2 use mo_biomod, only: c14fac - use mo_bgcmean, only: jdic13,jdic14,jd13c,jd14c,jbigd14c,jpoc13, & - & jdoc13,jcalc13,jphyto13,jgrazer13,jco213fxd, & - & jco213fxu,jco214fxd,jco214fxu,jatmc13, & - & jatmc14,jdic13,jdic14,jd13c,jd14c,jbigd14c, & - & srf_co213fxd,srf_co213fxu,srf_co214fxd, & - & srf_co214fxu,srf_atmc13,srf_atmc14,lyr_dic13, & - & lyr_dic14,lyr_d13c,lyr_d14c,lyr_bigd14c, & - & lyr_poc13,lyr_doc13,lyr_calc13,lyr_phyto13, & - & lyr_grazer13,lvl_dic13,lvl_dic14,lvl_d13c, & - & lvl_d14c,lvl_bigd14c,lvl_poc13,lvl_doc13, & - & lvl_calc13,lvl_phyto13,lvl_grazer13 -#endif -#ifdef natDIC - use mo_bgcmean, only: jnatalkali,jnatdic,jnatcalc,jnatco3,jnatph, & - & jnatomegaa,jnatomegac,jlvlnatph, & - & jsrfnatdic,jsrfnatalk,jsrfnatph, & - & jnatpco2,jnatco2fx,lyr_natco3, & - & lyr_natalkali,lyr_natdic,lyr_natph,lyr_natcalc, & - & lyr_natomegaa,lyr_natomegac,lvl_natco3, & - & lvl_natalkali,lvl_natdic,lvl_natph,lvl_natcalc, & - & lvl_natomegaa,lvl_natomegac,srf_natdic, & - & srf_natalkali,srf_natpco2,srf_natco2fx,srf_natph -#endif -#ifndef sedbypass - use mo_bgcmean, only: jpowaic,jpowaal,jpowaph,jpowaox,jpown2, & - & jpowno3,jpowasi,jssso12,jssssil,jssster, & - & jsssc12,jbursssc12,jburssssil,jburssster, & - & sdm_powaic,sdm_powaal,sdm_powaph,sdm_powaox, & - & sdm_pown2,sdm_powno3,sdm_powasi,sdm_ssso12, & - & sdm_ssssil,sdm_sssc12,sdm_ssster,jburssso12, & - & bur_sssc12,bur_ssssil,bur_ssster,bur_ssso12, & - & inisdm,inibur,wrtsdm,accbur,accsdm,wrtbur -#endif implicit none @@ -267,42 +255,42 @@ subroutine ncwrt_bgc(iogrp) call finlyr(jprefalk(iogrp),jdp(iogrp)) call finlyr(jprefdic(iogrp),jdp(iogrp)) call finlyr(jdicsat(iogrp),jdp(iogrp)) -#ifdef cisonew - call finlyr(jdic13(iogrp),jdp(iogrp)) - call finlyr(jdic14(iogrp),jdp(iogrp)) - call finlyr(jd13c(iogrp),jdp(iogrp)) - call finlyr(jd14c(iogrp),jdp(iogrp)) - call finlyr(jbigd14c(iogrp),jdp(iogrp)) - call finlyr(jpoc13(iogrp),jdp(iogrp)) - call finlyr(jdoc13(iogrp),jdp(iogrp)) - call finlyr(jcalc13(iogrp),jdp(iogrp)) - call finlyr(jphyto13(iogrp),jdp(iogrp)) - call finlyr(jgrazer13(iogrp),jdp(iogrp)) -#endif -#ifdef AGG - call finlyr(jnos(iogrp),jdp(iogrp)) - call finlyr(jwphy(iogrp),jdp(iogrp)) - call finlyr(jwnos(iogrp),jdp(iogrp)) - call finlyr(jeps(iogrp),jdp(iogrp)) - call finlyr(jasize(iogrp),jdp(iogrp)) -#endif -#ifdef CFC - call finlyr(jcfc11(iogrp),jdp(iogrp)) - call finlyr(jcfc12(iogrp),jdp(iogrp)) - call finlyr(jsf6(iogrp),jdp(iogrp)) -#endif -#ifdef natDIC - call finlyr(jnatalkali(iogrp),jdp(iogrp)) - call finlyr(jnatdic(iogrp),jdp(iogrp)) - call finlyr(jnatcalc(iogrp),jdp(iogrp)) - call finlyr(jnatco3(iogrp),jdp(iogrp)) - call finlyr(jnatph(iogrp),jdp(iogrp)) - call finlyr(jnatomegaa(iogrp),jdp(iogrp)) - call finlyr(jnatomegac(iogrp),jdp(iogrp)) -#endif -#ifdef BROMO - call finlyr(jbromo(iogrp),jdp(iogrp)) -#endif + if (use_cisonew) then + call finlyr(jdic13(iogrp),jdp(iogrp)) + call finlyr(jdic14(iogrp),jdp(iogrp)) + call finlyr(jd13c(iogrp),jdp(iogrp)) + call finlyr(jd14c(iogrp),jdp(iogrp)) + call finlyr(jbigd14c(iogrp),jdp(iogrp)) + call finlyr(jpoc13(iogrp),jdp(iogrp)) + call finlyr(jdoc13(iogrp),jdp(iogrp)) + call finlyr(jcalc13(iogrp),jdp(iogrp)) + call finlyr(jphyto13(iogrp),jdp(iogrp)) + call finlyr(jgrazer13(iogrp),jdp(iogrp)) + end if + if (use_AGG) then + call finlyr(jnos(iogrp),jdp(iogrp)) + call finlyr(jwphy(iogrp),jdp(iogrp)) + call finlyr(jwnos(iogrp),jdp(iogrp)) + call finlyr(jeps(iogrp),jdp(iogrp)) + call finlyr(jasize(iogrp),jdp(iogrp)) + end if + if (use_CFC) then + call finlyr(jcfc11(iogrp),jdp(iogrp)) + call finlyr(jcfc12(iogrp),jdp(iogrp)) + call finlyr(jsf6(iogrp),jdp(iogrp)) + end if + if (use_natDIC) then + call finlyr(jnatalkali(iogrp),jdp(iogrp)) + call finlyr(jnatdic(iogrp),jdp(iogrp)) + call finlyr(jnatcalc(iogrp),jdp(iogrp)) + call finlyr(jnatco3(iogrp),jdp(iogrp)) + call finlyr(jnatph(iogrp),jdp(iogrp)) + call finlyr(jnatomegaa(iogrp),jdp(iogrp)) + call finlyr(jnatomegac(iogrp),jdp(iogrp)) + end if + if (use_BROMO) then + call finlyr(jbromo(iogrp),jdp(iogrp)) + end if ! --- Mask sea floor in mass fluxes call msksrf(jcarflx0100(iogrp),k0100) @@ -347,52 +335,52 @@ subroutine ncwrt_bgc(iogrp) call msklvl(jlvlprefalk(iogrp),depths) call msklvl(jlvlprefdic(iogrp),depths) call msklvl(jlvldicsat(iogrp),depths) -#ifdef cisonew - call msklvl(jlvldic13(iogrp),depths) - call msklvl(jlvldic14(iogrp),depths) - call msklvl(jlvld13c(iogrp),depths) - call msklvl(jlvld14c(iogrp),depths) - call msklvl(jlvlbigd14c(iogrp),depths) - call msklvl(jlvlpoc13(iogrp),depths) - call msklvl(jlvldoc13(iogrp),depths) - call msklvl(jlvlcalc13(iogrp),depths) - call msklvl(jlvlphyto13(iogrp),depths) - call msklvl(jlvlgrazer13(iogrp),depths) -#endif -#ifdef AGG - call msklvl(jlvlnos(iogrp),depths) - call msklvl(jlvlwphy(iogrp),depths) - call msklvl(jlvlwnos(iogrp),depths) - call msklvl(jlvleps(iogrp),depths) - call msklvl(jlvlasize(iogrp),depths) -#endif -#ifdef CFC - call msklvl(jlvlcfc11(iogrp),depths) - call msklvl(jlvlcfc12(iogrp),depths) - call msklvl(jlvlsf6(iogrp),depths) -#endif -#ifdef natDIC - call msklvl(jlvlnatalkali(iogrp),depths) - call msklvl(jlvlnatdic(iogrp),depths) - call msklvl(jlvlnatcalc(iogrp),depths) - call msklvl(jlvlnatco3(iogrp),depths) - call msklvl(jlvlnatph(iogrp),depths) - call msklvl(jlvlnatomegaa(iogrp),depths) - call msklvl(jlvlnatomegac(iogrp),depths) -#endif -#ifdef BROMO - call msklvl(jlvlbromo(iogrp),depths) -#endif + if (use_cisonew) then + call msklvl(jlvldic13(iogrp),depths) + call msklvl(jlvldic14(iogrp),depths) + call msklvl(jlvld13c(iogrp),depths) + call msklvl(jlvld14c(iogrp),depths) + call msklvl(jlvlbigd14c(iogrp),depths) + call msklvl(jlvlpoc13(iogrp),depths) + call msklvl(jlvldoc13(iogrp),depths) + call msklvl(jlvlcalc13(iogrp),depths) + call msklvl(jlvlphyto13(iogrp),depths) + call msklvl(jlvlgrazer13(iogrp),depths) + end if + if (use_AGG) then + call msklvl(jlvlnos(iogrp),depths) + call msklvl(jlvlwphy(iogrp),depths) + call msklvl(jlvlwnos(iogrp),depths) + call msklvl(jlvleps(iogrp),depths) + call msklvl(jlvlasize(iogrp),depths) + end if + if (use_CFC) then + call msklvl(jlvlcfc11(iogrp),depths) + call msklvl(jlvlcfc12(iogrp),depths) + call msklvl(jlvlsf6(iogrp),depths) + end if + if (use_natDIC) then + call msklvl(jlvlnatalkali(iogrp),depths) + call msklvl(jlvlnatdic(iogrp),depths) + call msklvl(jlvlnatcalc(iogrp),depths) + call msklvl(jlvlnatco3(iogrp),depths) + call msklvl(jlvlnatph(iogrp),depths) + call msklvl(jlvlnatomegaa(iogrp),depths) + call msklvl(jlvlnatomegac(iogrp),depths) + end if + if (use_BROMO) then + call msklvl(jlvlbromo(iogrp),depths) + end if ! --- Compute log10 of pH if (SRF_PH(iogrp).ne.0) call logsrf(jsrfph(iogrp),rnacc,0.) if (LYR_PH(iogrp).ne.0) call loglyr(jph(iogrp),1.,0.) if (LVL_PH(iogrp).ne.0) call loglvl(jlvlph(iogrp),rnacc,0.) -#ifdef natDIC - if (SRF_NATPH(iogrp).ne.0) call logsrf(jsrfnatph(iogrp),rnacc,0.) - if (LYR_NATPH(iogrp).ne.0) call loglyr(jnatph(iogrp),1.,0.) - if (LVL_NATPH(iogrp).ne.0) call loglvl(jlvlnatph(iogrp),rnacc,0.) -#endif + if (use_natDIC) then + if (SRF_NATPH(iogrp).ne.0) call logsrf(jsrfnatph(iogrp),rnacc,0.) + if (LYR_NATPH(iogrp).ne.0) call loglyr(jnatph(iogrp),1.,0.) + if (LVL_NATPH(iogrp).ne.0) call loglvl(jlvlnatph(iogrp),rnacc,0.) + end if ! --- Store 2d fields call wrtsrf(jkwco2(iogrp), SRF_KWCO2(iogrp), rnacc, 0.,cmpflg,'kwco2') @@ -446,49 +434,49 @@ subroutine ncwrt_bgc(iogrp) call wrtsrf(jcalflx2000(iogrp), FLX_CAL2000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx2000') call wrtsrf(jcalflx4000(iogrp), FLX_CAL4000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx4000') call wrtsrf(jcalflx_bot(iogrp), FLX_CAL_BOT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx_bot') -#ifndef sedbypass - call wrtsrf(jsediffic(iogrp), FLX_SEDIFFIC(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfdic') - call wrtsrf(jsediffal(iogrp), FLX_SEDIFFAL(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfalk') - call wrtsrf(jsediffph(iogrp), FLX_SEDIFFPH(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfpho') - call wrtsrf(jsediffox(iogrp), FLX_SEDIFFOX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfox') - call wrtsrf(jsediffn2(iogrp), FLX_SEDIFFN2(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfn2') - call wrtsrf(jsediffno3(iogrp), FLX_SEDIFFNO3(iogrp),rnacc*1e3/dtbgc,0.,cmpflg,'sedfno3') - call wrtsrf(jsediffsi(iogrp), FLX_SEDIFFSI(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfsi') -#endif -#ifdef cisonew - call wrtsrf(jco213fxd(iogrp), SRF_CO213FXD(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co213fxd') - call wrtsrf(jco213fxu(iogrp), SRF_CO213FXU(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co213fxu') - call wrtsrf(jco214fxd(iogrp), SRF_CO214FXD(iogrp), rnacc*12.*c14fac/dtbgc,0.,cmpflg,'co214fxd') - call wrtsrf(jco214fxu(iogrp), SRF_CO214FXU(iogrp), rnacc*12.*c14fac/dtbgc,0.,cmpflg,'co214fxu') -#endif -#ifdef CFC - call wrtsrf(jcfc11fx(iogrp), SRF_CFC11(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'cfc11flux') - call wrtsrf(jcfc12fx(iogrp), SRF_CFC12(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'cfc12flux') - call wrtsrf(jsf6fx(iogrp), SRF_SF6(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sf6flux') -#endif -#ifdef natDIC - call wrtsrf(jsrfnatdic(iogrp), SRF_NATDIC(iogrp), rnacc*1e3, 0.,cmpflg,'srfnatdissic') - call wrtsrf(jsrfnatalk(iogrp), SRF_NATALKALI(iogrp),rnacc*1e3, 0.,cmpflg,'srfnattalk') - call wrtsrf(jnatpco2(iogrp), SRF_NATPCO2(iogrp), rnacc, 0.,cmpflg,'natpco2') - call wrtsrf(jnatco2fx(iogrp), SRF_NATCO2FX(iogrp), rnacc*12./dtbgc,0.,cmpflg,'natco2fx') - call wrtsrf(jsrfnatph(iogrp), SRF_NATPH(iogrp), -1., 0.,cmpflg,'srfnatph') -#endif -#ifdef BROMO - call wrtsrf(jbromofx(iogrp), SRF_BROMOFX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bromofx') - call wrtsrf(jsrfbromo(iogrp), SRF_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'srfbromo') - call wrtsrf(jbromo_prod(iogrp), INT_BROMOPRO(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'intbromoprod') - call wrtsrf(jbromo_uv(iogrp), INT_BROMOUV(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'intbromouv') - call wrtsrf(jatmbromo(iogrp), SRF_ATMBROMO(iogrp), rnacc, 0.,cmpflg,'atmbromo') -#endif + if (.not. use_sedbypass) then + call wrtsrf(jsediffic(iogrp), FLX_SEDIFFIC(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfdic') + call wrtsrf(jsediffal(iogrp), FLX_SEDIFFAL(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfalk') + call wrtsrf(jsediffph(iogrp), FLX_SEDIFFPH(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfpho') + call wrtsrf(jsediffox(iogrp), FLX_SEDIFFOX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfox') + call wrtsrf(jsediffn2(iogrp), FLX_SEDIFFN2(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfn2') + call wrtsrf(jsediffno3(iogrp), FLX_SEDIFFNO3(iogrp),rnacc*1e3/dtbgc,0.,cmpflg,'sedfno3') + call wrtsrf(jsediffsi(iogrp), FLX_SEDIFFSI(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sedfsi') + end if + if (use_cisonew) then + call wrtsrf(jco213fxd(iogrp), SRF_CO213FXD(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co213fxd') + call wrtsrf(jco213fxu(iogrp), SRF_CO213FXU(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co213fxu') + call wrtsrf(jco214fxd(iogrp), SRF_CO214FXD(iogrp), rnacc*12.*c14fac/dtbgc,0.,cmpflg,'co214fxd') + call wrtsrf(jco214fxu(iogrp), SRF_CO214FXU(iogrp), rnacc*12.*c14fac/dtbgc,0.,cmpflg,'co214fxu') + end if + if (use_CFC) then + call wrtsrf(jcfc11fx(iogrp), SRF_CFC11(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'cfc11flux') + call wrtsrf(jcfc12fx(iogrp), SRF_CFC12(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'cfc12flux') + call wrtsrf(jsf6fx(iogrp), SRF_SF6(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'sf6flux') + end if + if (use_natDIC) then + call wrtsrf(jsrfnatdic(iogrp), SRF_NATDIC(iogrp), rnacc*1e3, 0.,cmpflg,'srfnatdissic') + call wrtsrf(jsrfnatalk(iogrp), SRF_NATALKALI(iogrp),rnacc*1e3, 0.,cmpflg,'srfnattalk') + call wrtsrf(jnatpco2(iogrp), SRF_NATPCO2(iogrp), rnacc, 0.,cmpflg,'natpco2') + call wrtsrf(jnatco2fx(iogrp), SRF_NATCO2FX(iogrp), rnacc*12./dtbgc,0.,cmpflg,'natco2fx') + call wrtsrf(jsrfnatph(iogrp), SRF_NATPH(iogrp), -1., 0.,cmpflg,'srfnatph') + end if + if (use_BROMO) then + call wrtsrf(jbromofx(iogrp), SRF_BROMOFX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bromofx') + call wrtsrf(jsrfbromo(iogrp), SRF_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'srfbromo') + call wrtsrf(jbromo_prod(iogrp), INT_BROMOPRO(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'intbromoprod') + call wrtsrf(jbromo_uv(iogrp), INT_BROMOUV(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'intbromouv') + call wrtsrf(jatmbromo(iogrp), SRF_ATMBROMO(iogrp), rnacc, 0.,cmpflg,'atmbromo') + end if call wrtsrf(jatmco2(iogrp), SRF_ATMCO2(iogrp), rnacc, 0.,cmpflg,'atmco2') -#if defined(BOXATM) - call wrtsrf(jatmo2(iogrp), SRF_ATMO2(iogrp), rnacc, 0.,cmpflg,'atmo2') - call wrtsrf(jatmn2(iogrp), SRF_ATMN2(iogrp), rnacc, 0.,cmpflg,'atmn2') -#endif -#ifdef cisonew - call wrtsrf(jatmc13(iogrp), SRF_ATMC13(iogrp), rnacc, 0.,cmpflg,'atmc13') - call wrtsrf(jatmc14(iogrp), SRF_ATMC14(iogrp), rnacc, 0.,cmpflg,'atmc14') -#endif + if (use_BOXATM) then + call wrtsrf(jatmo2(iogrp), SRF_ATMO2(iogrp), rnacc, 0.,cmpflg,'atmo2') + call wrtsrf(jatmn2(iogrp), SRF_ATMN2(iogrp), rnacc, 0.,cmpflg,'atmn2') + end if + if (use_cisonew) then + call wrtsrf(jatmc13(iogrp), SRF_ATMC13(iogrp), rnacc, 0.,cmpflg,'atmc13') + call wrtsrf(jatmc14(iogrp), SRF_ATMC14(iogrp), rnacc, 0.,cmpflg,'atmc14') + end if ! --- Store 3d layer fields call wrtlyr(jdp(iogrp), LYR_DP(iogrp), rnacc, 0.,cmpflg,'pddpo') @@ -517,42 +505,42 @@ subroutine ncwrt_bgc(iogrp) call wrtlyr(jprefalk(iogrp), LYR_PREFALK(iogrp), 1e3, 0.,cmpflg,'p_talk') call wrtlyr(jprefdic(iogrp), LYR_PREFDIC(iogrp), 1e3, 0.,cmpflg,'p_dic') call wrtlyr(jdicsat(iogrp), LYR_DICSAT(iogrp), 1e3, 0.,cmpflg,'sat_dic') -#ifdef cisonew - call wrtlyr(jdic13(iogrp), LYR_DIC13(iogrp), 1.e3, 0.,cmpflg,'dissic13') - call wrtlyr(jdic14(iogrp), LYR_DIC14(iogrp), 1.e3*c14fac, 0.,cmpflg,'dissic14') - call wrtlyr(jd13c(iogrp), LYR_D13C(iogrp), 1., 0.,cmpflg,'delta13c') - call wrtlyr(jd14c(iogrp), LYR_D14C(iogrp), 1., 0.,cmpflg,'delta14c') - call wrtlyr(jbigd14c(iogrp), LYR_BIGD14C(iogrp), 1., 0.,cmpflg,'bigdelta14c') - call wrtlyr(jpoc13(iogrp), LYR_POC13(iogrp), 1e3, 0.,cmpflg,'detoc13') - call wrtlyr(jdoc13(iogrp), LYR_DOC13(iogrp), 1e3, 0.,cmpflg,'dissoc13') - call wrtlyr(jcalc13(iogrp), LYR_CALC13(iogrp), 1e3, 0.,cmpflg,'calc13') - call wrtlyr(jphyto13(iogrp), LYR_PHYTO13(iogrp), 1e3, 0.,cmpflg,'phyc13') - call wrtlyr(jgrazer13(iogrp), LYR_GRAZER13(iogrp), 1e3, 0.,cmpflg,'zooc13') -#endif -#ifdef AGG - call wrtlyr(jnos(iogrp), LYR_NOS(iogrp), 1., 0.,cmpflg,'nos') - call wrtlyr(jwphy(iogrp), LYR_WPHY(iogrp), 1., 0.,cmpflg,'wphy') - call wrtlyr(jwnos(iogrp), LYR_WNOS(iogrp), 1., 0.,cmpflg,'wnos') - call wrtlyr(jeps(iogrp), LYR_EPS(iogrp), 1., 0.,cmpflg,'eps') - call wrtlyr(jasize(iogrp), LYR_ASIZE(iogrp), 1., 0.,cmpflg,'asize') -#endif -#ifdef CFC - call wrtlyr(jcfc11(iogrp), LYR_CFC11(iogrp), 1e3, 0.,cmpflg,'cfc11') - call wrtlyr(jcfc12(iogrp), LYR_CFC12(iogrp), 1e3, 0.,cmpflg,'cfc12') - call wrtlyr(jsf6(iogrp), LYR_SF6(iogrp), 1e3, 0.,cmpflg,'sf6') -#endif -#ifdef natDIC - call wrtlyr(jnatco3(iogrp), LYR_NATCO3(iogrp), 1e3, 0.,cmpflg,'natco3') - call wrtlyr(jnatalkali(iogrp), LYR_NATALKALI(iogrp),1e3, 0.,cmpflg,'nattalk') - call wrtlyr(jnatdic(iogrp), LYR_NATDIC(iogrp), 1e3, 0.,cmpflg,'natdissic') - call wrtlyr(jnatcalc(iogrp), LYR_NATCALC(iogrp), 1e3, 0.,cmpflg,'natcalc') - call wrtlyr(jnatph(iogrp), LYR_NATPH(iogrp), -1., 0.,cmpflg,'natph') - call wrtlyr(jnatomegaa(iogrp), LYR_NATOMEGAA(iogrp),1., 0.,cmpflg,'natomegaa') - call wrtlyr(jnatomegac(iogrp), LYR_NATOMEGAC(iogrp),1., 0.,cmpflg,'natomegac') -#endif -#ifdef BROMO - call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') -#endif + if (use_cisonew) then + call wrtlyr(jdic13(iogrp), LYR_DIC13(iogrp), 1.e3, 0.,cmpflg,'dissic13') + call wrtlyr(jdic14(iogrp), LYR_DIC14(iogrp), 1.e3*c14fac, 0.,cmpflg,'dissic14') + call wrtlyr(jd13c(iogrp), LYR_D13C(iogrp), 1., 0.,cmpflg,'delta13c') + call wrtlyr(jd14c(iogrp), LYR_D14C(iogrp), 1., 0.,cmpflg,'delta14c') + call wrtlyr(jbigd14c(iogrp), LYR_BIGD14C(iogrp), 1., 0.,cmpflg,'bigdelta14c') + call wrtlyr(jpoc13(iogrp), LYR_POC13(iogrp), 1e3, 0.,cmpflg,'detoc13') + call wrtlyr(jdoc13(iogrp), LYR_DOC13(iogrp), 1e3, 0.,cmpflg,'dissoc13') + call wrtlyr(jcalc13(iogrp), LYR_CALC13(iogrp), 1e3, 0.,cmpflg,'calc13') + call wrtlyr(jphyto13(iogrp), LYR_PHYTO13(iogrp), 1e3, 0.,cmpflg,'phyc13') + call wrtlyr(jgrazer13(iogrp), LYR_GRAZER13(iogrp), 1e3, 0.,cmpflg,'zooc13') + end if + if (use_AGG) then + call wrtlyr(jnos(iogrp), LYR_NOS(iogrp), 1., 0.,cmpflg,'nos') + call wrtlyr(jwphy(iogrp), LYR_WPHY(iogrp), 1., 0.,cmpflg,'wphy') + call wrtlyr(jwnos(iogrp), LYR_WNOS(iogrp), 1., 0.,cmpflg,'wnos') + call wrtlyr(jeps(iogrp), LYR_EPS(iogrp), 1., 0.,cmpflg,'eps') + call wrtlyr(jasize(iogrp), LYR_ASIZE(iogrp), 1., 0.,cmpflg,'asize') + end if + if (use_CFC) then + call wrtlyr(jcfc11(iogrp), LYR_CFC11(iogrp), 1e3, 0.,cmpflg,'cfc11') + call wrtlyr(jcfc12(iogrp), LYR_CFC12(iogrp), 1e3, 0.,cmpflg,'cfc12') + call wrtlyr(jsf6(iogrp), LYR_SF6(iogrp), 1e3, 0.,cmpflg,'sf6') + end if + if (use_natDIC) then + call wrtlyr(jnatco3(iogrp), LYR_NATCO3(iogrp), 1e3, 0.,cmpflg,'natco3') + call wrtlyr(jnatalkali(iogrp), LYR_NATALKALI(iogrp),1e3, 0.,cmpflg,'nattalk') + call wrtlyr(jnatdic(iogrp), LYR_NATDIC(iogrp), 1e3, 0.,cmpflg,'natdissic') + call wrtlyr(jnatcalc(iogrp), LYR_NATCALC(iogrp), 1e3, 0.,cmpflg,'natcalc') + call wrtlyr(jnatph(iogrp), LYR_NATPH(iogrp), -1., 0.,cmpflg,'natph') + call wrtlyr(jnatomegaa(iogrp), LYR_NATOMEGAA(iogrp),1., 0.,cmpflg,'natomegaa') + call wrtlyr(jnatomegac(iogrp), LYR_NATOMEGAC(iogrp),1., 0.,cmpflg,'natomegac') + end if + if (use_BROMO) then + call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') + end if ! --- Store 3d level fields call wrtlvl(jlvldic(iogrp), LVL_DIC(iogrp), rnacc*1e3, 0.,cmpflg,'dissiclvl') @@ -580,63 +568,63 @@ subroutine ncwrt_bgc(iogrp) call wrtlvl(jlvlprefalk(iogrp), LVL_PREFALK(iogrp), rnacc*1e3, 0.,cmpflg,'p_talklvl') call wrtlvl(jlvlprefdic(iogrp), LVL_PREFDIC(iogrp), rnacc*1e3, 0.,cmpflg,'p_diclvl') call wrtlvl(jlvldicsat(iogrp), LVL_DICSAT(iogrp), rnacc*1e3, 0.,cmpflg,'sat_diclvl') -#ifdef cisonew - call wrtlvl(jlvldic13(iogrp), LVL_DIC13(iogrp), rnacc*1.e3, 0.,cmpflg,'dissic13lvl') - call wrtlvl(jlvldic14(iogrp), LVL_DIC14(iogrp), rnacc*1.e3*c14fac,0.,cmpflg,'dissic14lvl') - call wrtlvl(jlvld13c(iogrp), LVL_D13C(iogrp), rnacc, 0.,cmpflg,'delta13clvl') - call wrtlvl(jlvld14c(iogrp), LVL_D14C(iogrp), rnacc, 0.,cmpflg,'delta14clvl') - call wrtlvl(jlvlbigd14c(iogrp), LVL_BIGD14C(iogrp), rnacc, 0.,cmpflg,'bigdelta14clvl') - call wrtlvl(jlvlpoc13(iogrp), LVL_POC13(iogrp), rnacc*1e3, 0.,cmpflg,'detoc13lvl') - call wrtlvl(jlvldoc13(iogrp), LVL_DOC13(iogrp), rnacc*1e3, 0.,cmpflg,'dissoc13lvl') - call wrtlvl(jlvlcalc13(iogrp), LVL_CALC13(iogrp), rnacc*1e3, 0.,cmpflg,'calc13lvl') - call wrtlvl(jlvlphyto13(iogrp), LVL_PHYTO13(iogrp), rnacc*1e3, 0.,cmpflg,'phyc13lvl') - call wrtlvl(jlvlgrazer13(iogrp), LVL_GRAZER13(iogrp), rnacc*1e3, 0.,cmpflg,'zooc13lvl') -#endif -#ifdef AGG - call wrtlvl(jlvlnos(iogrp), LVL_NOS(iogrp), rnacc, 0.,cmpflg,'noslvl') - call wrtlvl(jlvlwphy(iogrp), LVL_WPHY(iogrp), rnacc, 0.,cmpflg,'wphylvl') - call wrtlvl(jlvlwnos(iogrp), LVL_WNOS(iogrp), rnacc, 0.,cmpflg,'wnoslvl') - call wrtlvl(jlvleps(iogrp), LVL_EPS(iogrp), rnacc, 0.,cmpflg,'epslvl') - call wrtlvl(jlvlasize(iogrp), LVL_ASIZE(iogrp), rnacc, 0.,cmpflg,'asizelvl') -#endif -#ifdef CFC - call wrtlvl(jlvlcfc11(iogrp), LVL_CFC11(iogrp), rnacc*1e3, 0.,cmpflg,'cfc11lvl') - call wrtlvl(jlvlcfc12(iogrp), LVL_CFC12(iogrp), rnacc*1e3, 0.,cmpflg,'cfc12lvl') - call wrtlvl(jlvlsf6(iogrp), LVL_SF6(iogrp), rnacc*1e3, 0.,cmpflg,'sf6lvl') -#endif -#ifdef natDIC - call wrtlvl(jlvlnatco3(iogrp), LVL_NATCO3(iogrp), rnacc*1e3, 0.,cmpflg,'natco3lvl') - call wrtlvl(jlvlnatalkali(iogrp),LVL_NATALKALI(iogrp),rnacc*1e3, 0.,cmpflg,'nattalklvl') - call wrtlvl(jlvlnatdic(iogrp), LVL_NATDIC(iogrp), rnacc*1e3, 0.,cmpflg,'natdissiclvl') - call wrtlvl(jlvlnatcalc(iogrp), LVL_NATCALC(iogrp), rnacc*1e3, 0.,cmpflg,'natcalclvl') - call wrtlvl(jlvlnatph(iogrp), LVL_NATPH(iogrp), -1., 0.,cmpflg,'natphlvl') - call wrtlvl(jlvlnatomegaa(iogrp),LVL_NATOMEGAA(iogrp),rnacc, 0.,cmpflg,'natomegaalvl') - call wrtlvl(jlvlnatomegac(iogrp),LVL_NATOMEGAC(iogrp),rnacc, 0.,cmpflg,'natomegaclvl') -#endif -#ifdef BROMO - call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') -#endif + if (use_cisonew) then + call wrtlvl(jlvldic13(iogrp), LVL_DIC13(iogrp), rnacc*1.e3, 0.,cmpflg,'dissic13lvl') + call wrtlvl(jlvldic14(iogrp), LVL_DIC14(iogrp), rnacc*1.e3*c14fac,0.,cmpflg,'dissic14lvl') + call wrtlvl(jlvld13c(iogrp), LVL_D13C(iogrp), rnacc, 0.,cmpflg,'delta13clvl') + call wrtlvl(jlvld14c(iogrp), LVL_D14C(iogrp), rnacc, 0.,cmpflg,'delta14clvl') + call wrtlvl(jlvlbigd14c(iogrp), LVL_BIGD14C(iogrp), rnacc, 0.,cmpflg,'bigdelta14clvl') + call wrtlvl(jlvlpoc13(iogrp), LVL_POC13(iogrp), rnacc*1e3, 0.,cmpflg,'detoc13lvl') + call wrtlvl(jlvldoc13(iogrp), LVL_DOC13(iogrp), rnacc*1e3, 0.,cmpflg,'dissoc13lvl') + call wrtlvl(jlvlcalc13(iogrp), LVL_CALC13(iogrp), rnacc*1e3, 0.,cmpflg,'calc13lvl') + call wrtlvl(jlvlphyto13(iogrp), LVL_PHYTO13(iogrp), rnacc*1e3, 0.,cmpflg,'phyc13lvl') + call wrtlvl(jlvlgrazer13(iogrp), LVL_GRAZER13(iogrp), rnacc*1e3, 0.,cmpflg,'zooc13lvl') + end if + if (use_AGG) then + call wrtlvl(jlvlnos(iogrp), LVL_NOS(iogrp), rnacc, 0.,cmpflg,'noslvl') + call wrtlvl(jlvlwphy(iogrp), LVL_WPHY(iogrp), rnacc, 0.,cmpflg,'wphylvl') + call wrtlvl(jlvlwnos(iogrp), LVL_WNOS(iogrp), rnacc, 0.,cmpflg,'wnoslvl') + call wrtlvl(jlvleps(iogrp), LVL_EPS(iogrp), rnacc, 0.,cmpflg,'epslvl') + call wrtlvl(jlvlasize(iogrp), LVL_ASIZE(iogrp), rnacc, 0.,cmpflg,'asizelvl') + end if + if (use_CFC) then + call wrtlvl(jlvlcfc11(iogrp), LVL_CFC11(iogrp), rnacc*1e3, 0.,cmpflg,'cfc11lvl') + call wrtlvl(jlvlcfc12(iogrp), LVL_CFC12(iogrp), rnacc*1e3, 0.,cmpflg,'cfc12lvl') + call wrtlvl(jlvlsf6(iogrp), LVL_SF6(iogrp), rnacc*1e3, 0.,cmpflg,'sf6lvl') + end if + if (use_natDIC) then + call wrtlvl(jlvlnatco3(iogrp), LVL_NATCO3(iogrp), rnacc*1e3, 0.,cmpflg,'natco3lvl') + call wrtlvl(jlvlnatalkali(iogrp),LVL_NATALKALI(iogrp),rnacc*1e3, 0.,cmpflg,'nattalklvl') + call wrtlvl(jlvlnatdic(iogrp), LVL_NATDIC(iogrp), rnacc*1e3, 0.,cmpflg,'natdissiclvl') + call wrtlvl(jlvlnatcalc(iogrp), LVL_NATCALC(iogrp), rnacc*1e3, 0.,cmpflg,'natcalclvl') + call wrtlvl(jlvlnatph(iogrp), LVL_NATPH(iogrp), -1., 0.,cmpflg,'natphlvl') + call wrtlvl(jlvlnatomegaa(iogrp),LVL_NATOMEGAA(iogrp),rnacc, 0.,cmpflg,'natomegaalvl') + call wrtlvl(jlvlnatomegac(iogrp),LVL_NATOMEGAC(iogrp),rnacc, 0.,cmpflg,'natomegaclvl') + end if + if (use_BROMO) then + call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') + end if ! --- Store sediment fields -#ifndef sedbypass - call wrtsdm(jpowaic(iogrp), SDM_POWAIC(iogrp), rnacc*1e3, 0.,cmpflg,'powdic') - call wrtsdm(jpowaal(iogrp), SDM_POWAAL(iogrp), rnacc*1e3, 0.,cmpflg,'powalk') - call wrtsdm(jpowaph(iogrp), SDM_POWAPH(iogrp), rnacc*1e3, 0.,cmpflg,'powpho') - call wrtsdm(jpowaox(iogrp), SDM_POWAOX(iogrp), rnacc*1e3, 0.,cmpflg,'powox') - call wrtsdm(jpown2(iogrp), SDM_POWN2(iogrp), rnacc*1e3, 0.,cmpflg,'pown2') - call wrtsdm(jpowno3(iogrp), SDM_POWNO3(iogrp), rnacc*1e3, 0.,cmpflg,'powno3') - call wrtsdm(jpowasi(iogrp), SDM_POWASI(iogrp), rnacc*1e3, 0.,cmpflg,'powsi') - call wrtsdm(jssso12(iogrp), SDM_SSSO12(iogrp), rnacc*1e3, 0.,cmpflg,'ssso12') - call wrtsdm(jssssil(iogrp), SDM_SSSSIL(iogrp), rnacc*1e3, 0.,cmpflg,'ssssil') - call wrtsdm(jsssc12(iogrp), SDM_SSSC12(iogrp), rnacc*1e3, 0.,cmpflg,'sssc12') - call wrtsdm(jssster(iogrp), SDM_SSSTER(iogrp), rnacc, 0.,cmpflg,'ssster') + if (.not. use_sedbypass) then + call wrtsdm(jpowaic(iogrp), SDM_POWAIC(iogrp), rnacc*1e3, 0.,cmpflg,'powdic') + call wrtsdm(jpowaal(iogrp), SDM_POWAAL(iogrp), rnacc*1e3, 0.,cmpflg,'powalk') + call wrtsdm(jpowaph(iogrp), SDM_POWAPH(iogrp), rnacc*1e3, 0.,cmpflg,'powpho') + call wrtsdm(jpowaox(iogrp), SDM_POWAOX(iogrp), rnacc*1e3, 0.,cmpflg,'powox') + call wrtsdm(jpown2(iogrp), SDM_POWN2(iogrp), rnacc*1e3, 0.,cmpflg,'pown2') + call wrtsdm(jpowno3(iogrp), SDM_POWNO3(iogrp), rnacc*1e3, 0.,cmpflg,'powno3') + call wrtsdm(jpowasi(iogrp), SDM_POWASI(iogrp), rnacc*1e3, 0.,cmpflg,'powsi') + call wrtsdm(jssso12(iogrp), SDM_SSSO12(iogrp), rnacc*1e3, 0.,cmpflg,'ssso12') + call wrtsdm(jssssil(iogrp), SDM_SSSSIL(iogrp), rnacc*1e3, 0.,cmpflg,'ssssil') + call wrtsdm(jsssc12(iogrp), SDM_SSSC12(iogrp), rnacc*1e3, 0.,cmpflg,'sssc12') + call wrtsdm(jssster(iogrp), SDM_SSSTER(iogrp), rnacc, 0.,cmpflg,'ssster') - ! --- Store sediment burial fields - call wrtbur(jburssso12(iogrp), BUR_SSSO12(iogrp), rnacc*1e3, 0.,cmpflg,'buro12') - call wrtbur(jbursssc12(iogrp), BUR_SSSC12(iogrp), rnacc*1e3, 0.,cmpflg,'burc12') - call wrtbur(jburssssil(iogrp), BUR_SSSSIL(iogrp), rnacc*1e3, 0.,cmpflg,'bursil') - call wrtbur(jburssster(iogrp), BUR_SSSTER(iogrp), rnacc, 0.,cmpflg,'burter') -#endif + ! --- Store sediment burial fields + call wrtbur(jburssso12(iogrp), BUR_SSSO12(iogrp), rnacc*1e3, 0.,cmpflg,'buro12') + call wrtbur(jbursssc12(iogrp), BUR_SSSC12(iogrp), rnacc*1e3, 0.,cmpflg,'burc12') + call wrtbur(jburssssil(iogrp), BUR_SSSSIL(iogrp), rnacc*1e3, 0.,cmpflg,'bursil') + call wrtbur(jburssster(iogrp), BUR_SSSTER(iogrp), rnacc, 0.,cmpflg,'burter') + end if ! --- close netcdf file call ncfcls @@ -693,51 +681,51 @@ subroutine ncwrt_bgc(iogrp) call inisrf(jcalflx2000(iogrp),0.) call inisrf(jcalflx4000(iogrp),0.) call inisrf(jcalflx_bot(iogrp),0.) -#ifndef sedbypass - call inisrf(jsediffic(iogrp),0.) - call inisrf(jsediffal(iogrp),0.) - call inisrf(jsediffph(iogrp),0.) - call inisrf(jsediffox(iogrp),0.) - call inisrf(jsediffn2(iogrp),0.) - call inisrf(jsediffno3(iogrp),0.) - call inisrf(jsediffsi(iogrp),0.) -#endif -#ifdef cisonew - call inisrf(jco213fxd(iogrp),0.) - call inisrf(jco213fxu(iogrp),0.) - call inisrf(jco214fxd(iogrp),0.) - call inisrf(jco214fxu(iogrp),0.) -#endif -#ifdef CFC - call inisrf(jcfc11fx(iogrp),0.) - call inisrf(jcfc12fx(iogrp),0.) - call inisrf(jsf6fx(iogrp),0.) -#endif -#ifdef natDIC - call inisrf(jsrfnatdic(iogrp),0.) - call inisrf(jsrfnatalk(iogrp),0.) - call inisrf(jnatpco2(iogrp),0.) - call inisrf(jnatco2fx(iogrp),0.) - call inisrf(jsrfnatph(iogrp),0.) -#endif -#ifdef BROMO - call inisrf(jsrfbromo(iogrp),0.) - call inisrf(jbromofx(iogrp),0.) - call inisrf(jbromo_prod(iogrp),0.) - call inisrf(jbromo_uv(iogrp),0.) - call inisrf(jatmbromo(iogrp),0.) -#endif + if (.not. use_sedbypass) then + call inisrf(jsediffic(iogrp),0.) + call inisrf(jsediffal(iogrp),0.) + call inisrf(jsediffph(iogrp),0.) + call inisrf(jsediffox(iogrp),0.) + call inisrf(jsediffn2(iogrp),0.) + call inisrf(jsediffno3(iogrp),0.) + call inisrf(jsediffsi(iogrp),0.) + end if + if (use_cisonew) then + call inisrf(jco213fxd(iogrp),0.) + call inisrf(jco213fxu(iogrp),0.) + call inisrf(jco214fxd(iogrp),0.) + call inisrf(jco214fxu(iogrp),0.) + end if + if (use_CFC) then + call inisrf(jcfc11fx(iogrp),0.) + call inisrf(jcfc12fx(iogrp),0.) + call inisrf(jsf6fx(iogrp),0.) + end if + if (use_natDIC) then + call inisrf(jsrfnatdic(iogrp),0.) + call inisrf(jsrfnatalk(iogrp),0.) + call inisrf(jnatpco2(iogrp),0.) + call inisrf(jnatco2fx(iogrp),0.) + call inisrf(jsrfnatph(iogrp),0.) + end if + if (use_BROMO) then + call inisrf(jsrfbromo(iogrp),0.) + call inisrf(jbromofx(iogrp),0.) + call inisrf(jbromo_prod(iogrp),0.) + call inisrf(jbromo_uv(iogrp),0.) + call inisrf(jatmbromo(iogrp),0.) + end if call inisrf(jatmco2(iogrp),0.) -#if defined(BOXATM) - call inisrf(jatmo2(iogrp),0.) - call inisrf(jatmn2(iogrp),0.) -#endif -#ifdef cisonew - call inisrf(jatmc13(iogrp),0.) - call inisrf(jatmc14(iogrp),0.) -#endif + if (use_BOXATM) then + call inisrf(jatmo2(iogrp),0.) + call inisrf(jatmn2(iogrp),0.) + end if + if (use_cisonew) then + call inisrf(jatmc13(iogrp),0.) + call inisrf(jatmc14(iogrp),0.) + end if call inilyr(jdp(iogrp),0.) call inilyr(jdic(iogrp),0.) @@ -765,42 +753,42 @@ subroutine ncwrt_bgc(iogrp) call inilyr(jprefalk(iogrp),0.) call inilyr(jprefdic(iogrp),0.) call inilyr(jdicsat(iogrp),0.) -#ifdef cisonew - call inilyr(jdic13(iogrp),0.) - call inilyr(jdic14(iogrp),0.) - call inilyr(jd13c(iogrp),0.) - call inilyr(jd14c(iogrp),0.) - call inilyr(jbigd14c(iogrp),0.) - call inilyr(jpoc13(iogrp),0.) - call inilyr(jdoc13(iogrp),0.) - call inilyr(jcalc13(iogrp),0.) - call inilyr(jphyto13(iogrp),0.) - call inilyr(jgrazer13(iogrp),0.) -#endif -#ifdef AGG - call inilyr(jnos(iogrp),0.) - call inilyr(jwphy(iogrp),0.) - call inilyr(jwnos(iogrp),0.) - call inilyr(jeps(iogrp),0.) - call inilyr(jasize(iogrp),0.) -#endif -#ifdef CFC - call inilyr(jcfc11(iogrp),0.) - call inilyr(jcfc12(iogrp),0.) - call inilyr(jsf6(iogrp),0.) -#endif -#ifdef natDIC - call inilyr(jnatco3(iogrp),0.) - call inilyr(jnatalkali(iogrp),0.) - call inilyr(jnatdic(iogrp),0.) - call inilyr(jnatcalc(iogrp),0.) - call inilyr(jnatph(iogrp),0.) - call inilyr(jnatomegaa(iogrp),0.) - call inilyr(jnatomegac(iogrp),0.) -#endif -#ifdef BROMO - call inilyr(jbromo(iogrp),0.) -#endif + if (use_cisonew) then + call inilyr(jdic13(iogrp),0.) + call inilyr(jdic14(iogrp),0.) + call inilyr(jd13c(iogrp),0.) + call inilyr(jd14c(iogrp),0.) + call inilyr(jbigd14c(iogrp),0.) + call inilyr(jpoc13(iogrp),0.) + call inilyr(jdoc13(iogrp),0.) + call inilyr(jcalc13(iogrp),0.) + call inilyr(jphyto13(iogrp),0.) + call inilyr(jgrazer13(iogrp),0.) + end if + if (use_AGG) then + call inilyr(jnos(iogrp),0.) + call inilyr(jwphy(iogrp),0.) + call inilyr(jwnos(iogrp),0.) + call inilyr(jeps(iogrp),0.) + call inilyr(jasize(iogrp),0.) + end if + if (use_CFC) then + call inilyr(jcfc11(iogrp),0.) + call inilyr(jcfc12(iogrp),0.) + call inilyr(jsf6(iogrp),0.) + end if + if (use_natDIC) then + call inilyr(jnatco3(iogrp),0.) + call inilyr(jnatalkali(iogrp),0.) + call inilyr(jnatdic(iogrp),0.) + call inilyr(jnatcalc(iogrp),0.) + call inilyr(jnatph(iogrp),0.) + call inilyr(jnatomegaa(iogrp),0.) + call inilyr(jnatomegac(iogrp),0.) + end if + if (use_BROMO) then + call inilyr(jbromo(iogrp),0.) + end if call inilvl(jlvldic(iogrp),0.) call inilvl(jlvlalkali(iogrp),0.) @@ -827,61 +815,61 @@ subroutine ncwrt_bgc(iogrp) call inilvl(jlvlprefalk(iogrp),0.) call inilvl(jlvlprefdic(iogrp),0.) call inilvl(jlvldicsat(iogrp),0.) -#ifdef cisonew - call inilvl(jlvldic13(iogrp),0.) - call inilvl(jlvldic14(iogrp),0.) - call inilvl(jlvld13c(iogrp),0.) - call inilvl(jlvld14c(iogrp),0.) - call inilvl(jlvlbigd14c(iogrp),0.) - call inilvl(jlvlpoc13(iogrp),0.) - call inilvl(jlvldoc13(iogrp),0.) - call inilvl(jlvlcalc13(iogrp),0.) - call inilvl(jlvlphyto13(iogrp),0.) - call inilvl(jlvlgrazer13(iogrp),0.) -#endif -#ifdef AGG - call inilvl(jlvlnos(iogrp),0.) - call inilvl(jlvlwphy(iogrp),0.) - call inilvl(jlvlwnos(iogrp),0.) - call inilvl(jlvleps(iogrp),0.) - call inilvl(jlvlasize(iogrp),0.) -#endif -#ifdef CFC - call inilvl(jlvlcfc11(iogrp),0.) - call inilvl(jlvlcfc12(iogrp),0.) - call inilvl(jlvlsf6(iogrp),0.) -#endif -#ifdef natDIC - call inilvl(jlvlnatco3(iogrp),0.) - call inilvl(jlvlnatalkali(iogrp),0.) - call inilvl(jlvlnatdic(iogrp),0.) - call inilvl(jlvlnatcalc(iogrp),0.) - call inilvl(jlvlnatph(iogrp),0.) - call inilvl(jlvlnatomegaa(iogrp),0.) - call inilvl(jlvlnatomegac(iogrp),0.) -#endif -#ifdef BROMO - call inilvl(jlvlbromo(iogrp),0.) -#endif + if (use_cisonew) then + call inilvl(jlvldic13(iogrp),0.) + call inilvl(jlvldic14(iogrp),0.) + call inilvl(jlvld13c(iogrp),0.) + call inilvl(jlvld14c(iogrp),0.) + call inilvl(jlvlbigd14c(iogrp),0.) + call inilvl(jlvlpoc13(iogrp),0.) + call inilvl(jlvldoc13(iogrp),0.) + call inilvl(jlvlcalc13(iogrp),0.) + call inilvl(jlvlphyto13(iogrp),0.) + call inilvl(jlvlgrazer13(iogrp),0.) + end if + if (use_AGG) then + call inilvl(jlvlnos(iogrp),0.) + call inilvl(jlvlwphy(iogrp),0.) + call inilvl(jlvlwnos(iogrp),0.) + call inilvl(jlvleps(iogrp),0.) + call inilvl(jlvlasize(iogrp),0.) + end if + if (use_CFC) then + call inilvl(jlvlcfc11(iogrp),0.) + call inilvl(jlvlcfc12(iogrp),0.) + call inilvl(jlvlsf6(iogrp),0.) + end if + if (use_natDIC) then + call inilvl(jlvlnatco3(iogrp),0.) + call inilvl(jlvlnatalkali(iogrp),0.) + call inilvl(jlvlnatdic(iogrp),0.) + call inilvl(jlvlnatcalc(iogrp),0.) + call inilvl(jlvlnatph(iogrp),0.) + call inilvl(jlvlnatomegaa(iogrp),0.) + call inilvl(jlvlnatomegac(iogrp),0.) + end if + if (use_BROMO) then + call inilvl(jlvlbromo(iogrp),0.) + end if -#ifndef sedbypass - call inisdm(jpowaic(iogrp),0.) - call inisdm(jpowaal(iogrp),0.) - call inisdm(jpowaph(iogrp),0.) - call inisdm(jpowaox(iogrp),0.) - call inisdm(jpown2(iogrp),0.) - call inisdm(jpowno3(iogrp),0.) - call inisdm(jpowasi(iogrp),0.) - call inisdm(jssso12(iogrp),0.) - call inisdm(jssssil(iogrp),0.) - call inisdm(jsssc12(iogrp),0.) - call inisdm(jssster(iogrp),0.) + if (.not. use_sedbypass) then + call inisdm(jpowaic(iogrp),0.) + call inisdm(jpowaal(iogrp),0.) + call inisdm(jpowaph(iogrp),0.) + call inisdm(jpowaox(iogrp),0.) + call inisdm(jpown2(iogrp),0.) + call inisdm(jpowno3(iogrp),0.) + call inisdm(jpowasi(iogrp),0.) + call inisdm(jssso12(iogrp),0.) + call inisdm(jssssil(iogrp),0.) + call inisdm(jsssc12(iogrp),0.) + call inisdm(jssster(iogrp),0.) - call inibur(jburssso12(iogrp),0.) - call inibur(jbursssc12(iogrp),0.) - call inibur(jburssssil(iogrp),0.) - call inibur(jburssster(iogrp),0.) -#endif + call inibur(jburssso12(iogrp),0.) + call inibur(jbursssc12(iogrp),0.) + call inibur(jburssssil(iogrp),0.) + call inibur(jburssster(iogrp),0.) + end if nacc_bgc(iogrp)=0 @@ -889,68 +877,54 @@ end subroutine ncwrt_bgc subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) - use mod_nctools, only:ncdefvar,ncattr,ncfopn,ncdimc,ncdims, & - & nctime,ncfcls,ncedef,ncdefvar3d,ndouble - use mo_bgcmean, only: srf_kwco2,srf_pco2,srf_dmsflux,srf_co2fxd, & - & srf_kwco2khm,srf_co2kh,srf_co2khm,srf_pco2m, & - & srf_co2fxu,srf_oxflux,srf_niflux,srf_dms,srf_dmsprod, & - & srf_dms_bac,srf_dms_uv,srf_export,srf_exposi,srf_expoca, & - & srf_dic,srf_alkali,srf_phosph,srf_oxygen,srf_ano3,srf_silica, & - & srf_iron,srf_phyto,srf_ph,int_phosy,int_nfix,int_dnit, & - & flx_ndep,flx_oalk,flx_car0100,flx_car0500, & - & flx_car1000,flx_car2000,flx_car4000,flx_car_bot, & - & flx_bsi0100,flx_bsi0500,flx_bsi1000,flx_bsi2000,flx_bsi4000, & - & flx_bsi_bot,flx_cal0100,flx_cal0500,flx_cal1000,flx_cal2000, & - & flx_cal4000,flx_cal_bot,flx_sediffic,flx_sediffal, & - & flx_sediffph,flx_sediffox,flx_sediffn2,flx_sediffno3, & - & flx_sediffsi,srf_n2ofx,srf_atmco2,lyr_dp,lyr_dic, & - & lyr_alkali,lyr_phosph,lyr_oxygen,lyr_ano3,lyr_silica,lyr_doc, & - & lyr_phyto,lyr_grazer,lyr_poc,lyr_calc,lyr_opal,lyr_iron, & - & lyr_phosy,lyr_co3,lyr_ph,lyr_omegaa,lyr_omegac,lyr_n2o, & - & lyr_prefo2,lyr_o2sat,lyr_prefpo4,lyr_prefalk,lyr_prefdic, & - & lyr_dicsat,lvl_dic,lvl_alkali,lvl_phosph,lvl_oxygen,lvl_ano3, & - & lvl_silica,lvl_doc,lvl_phyto,lvl_grazer,lvl_poc,lvl_calc, & - & lvl_opal,lvl_iron,lvl_phosy,lvl_co3,lvl_ph,lvl_omegaa, & - & lvl_omegac,lvl_n2o,lvl_prefo2,lvl_o2sat,lvl_prefpo4, & - & lvl_prefalk,lvl_prefdic,lvl_dicsat -#ifdef AGG - use mo_bgcmean, only: lyr_nos,lyr_wphy,lyr_wnos,lyr_eps, & - & lyr_asize,lvl_nos,lvl_wphy,lvl_wnos,lvl_eps,lvl_asize -#endif -#if defined(BOXATM) - use mo_bgcmean, only: srf_atmo2,srf_atmn2 -#endif + use mod_nctools, only:ncdefvar,ncattr,ncfopn,ncdimc,ncdims, & + nctime,ncfcls,ncedef,ncdefvar3d,ndouble + use mo_bgcmean, only: srf_kwco2,srf_pco2,srf_dmsflux,srf_co2fxd, & + srf_kwco2khm,srf_co2kh,srf_co2khm,srf_pco2m, & + srf_co2fxu,srf_oxflux,srf_niflux,srf_dms,srf_dmsprod, & + srf_dms_bac,srf_dms_uv,srf_export,srf_exposi,srf_expoca, & + srf_dic,srf_alkali,srf_phosph,srf_oxygen,srf_ano3,srf_silica, & + srf_iron,srf_phyto,srf_ph,int_phosy,int_nfix,int_dnit, & + flx_ndep,flx_oalk,flx_car0100,flx_car0500, & + flx_car1000,flx_car2000,flx_car4000,flx_car_bot, & + flx_bsi0100,flx_bsi0500,flx_bsi1000,flx_bsi2000,flx_bsi4000, & + flx_bsi_bot,flx_cal0100,flx_cal0500,flx_cal1000,flx_cal2000, & + flx_cal4000,flx_cal_bot,flx_sediffic,flx_sediffal, & + flx_sediffph,flx_sediffox,flx_sediffn2,flx_sediffno3, & + flx_sediffsi,srf_n2ofx,srf_atmco2,lyr_dp,lyr_dic, & + lyr_alkali,lyr_phosph,lyr_oxygen,lyr_ano3,lyr_silica,lyr_doc, & + lyr_phyto,lyr_grazer,lyr_poc,lyr_calc,lyr_opal,lyr_iron, & + lyr_phosy,lyr_co3,lyr_ph,lyr_omegaa,lyr_omegac,lyr_n2o, & + lyr_prefo2,lyr_o2sat,lyr_prefpo4,lyr_prefalk,lyr_prefdic, & + lyr_dicsat,lvl_dic,lvl_alkali,lvl_phosph,lvl_oxygen,lvl_ano3, & + lvl_silica,lvl_doc,lvl_phyto,lvl_grazer,lvl_poc,lvl_calc, & + lvl_opal,lvl_iron,lvl_phosy,lvl_co3,lvl_ph,lvl_omegaa, & + lvl_omegac,lvl_n2o,lvl_prefo2,lvl_o2sat,lvl_prefpo4, & + lvl_prefalk,lvl_prefdic,lvl_dicsat, & + lyr_nos,lyr_wphy,lyr_wnos,lyr_eps, & + lyr_asize,lvl_nos,lvl_wphy,lvl_wnos,lvl_eps,lvl_asize, & + srf_atmo2,srf_atmn2, srf_bromo,srf_bromofx,int_bromopro, & + int_bromouv,srf_atmbromo,lyr_bromo,lvl_bromo, & + srf_cfc11,srf_cfc12,srf_sf6,lyr_cfc11, & + lyr_cfc12,lyr_sf6,lvl_cfc11,lvl_cfc12,lvl_sf6, & + srf_co213fxd,srf_co213fxu,srf_co214fxd, & + srf_co214fxu,srf_atmc13,srf_atmc14,lyr_dic13,lyr_dic14, & + lyr_d13c,lyr_d14c,lyr_bigd14c,lyr_poc13,lyr_doc13, & + lyr_calc13,lyr_phyto13,lyr_grazer13,lvl_dic13,lvl_dic14, & + lvl_d13c,lvl_d14c,lvl_bigd14c,lvl_poc13,lvl_doc13, & + lvl_calc13,lvl_phyto13,lvl_grazer13, & + srf_natdic,srf_natalkali,srf_natpco2, & + srf_natco2fx,srf_natph,lyr_natco3,lyr_natalkali,lyr_natdic, & + lyr_natcalc,lyr_natph,lyr_natomegaa,lyr_natomegac, & + lvl_natalkali,lvl_natdic,lvl_natcalc,lvl_natph, & + lvl_natomegaa,lvl_natomegac,lvl_natco3, & + sdm_powaic,sdm_powaal,sdm_powaph,sdm_powaox, & + sdm_pown2,sdm_powno3,sdm_powasi,sdm_ssso12,sdm_ssssil, & + sdm_sssc12,sdm_ssster,bur_ssso12,bur_sssc12,bur_ssssil,bur_ssster + use mo_control_bgc, only: use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO, & + use_sedbypass,use_BOXATM -#ifdef BROMO - use mo_bgcmean, only:srf_bromo,srf_bromofx,int_bromopro, & - & int_bromouv,srf_atmbromo,lyr_bromo,lvl_bromo -#endif -#ifdef CFC - use mo_bgcmean, only: srf_cfc11,srf_cfc12,srf_sf6,lyr_cfc11, & - & lyr_cfc12,lyr_sf6,lvl_cfc11,lvl_cfc12,lvl_sf6 -#endif -#ifdef cisonew - use mo_bgcmean, only: srf_co213fxd,srf_co213fxu,srf_co214fxd, & - & srf_co214fxu,srf_atmc13,srf_atmc14,lyr_dic13,lyr_dic14, & - & lyr_d13c,lyr_d14c,lyr_bigd14c,lyr_poc13,lyr_doc13, & - & lyr_calc13,lyr_phyto13,lyr_grazer13,lvl_dic13,lvl_dic14, & - & lvl_d13c,lvl_d14c,lvl_bigd14c,lvl_poc13,lvl_doc13, & - & lvl_calc13,lvl_phyto13,lvl_grazer13 -#endif -#ifdef natDIC - use mo_bgcmean, only: srf_natdic,srf_natalkali,srf_natpco2, & - & srf_natco2fx,srf_natph,lyr_natco3,lyr_natalkali,lyr_natdic, & - & lyr_natcalc,lyr_natph,lyr_natomegaa,lyr_natomegac, & - & lvl_natalkali,lvl_natdic,lvl_natcalc,lvl_natph, & - & lvl_natomegaa,lvl_natomegac,lvl_natco3 -#endif -#ifndef sedbypass - use mo_bgcmean, only: sdm_powaic,sdm_powaal,sdm_powaph,sdm_powaox, & - & sdm_pown2,sdm_powno3,sdm_powasi,sdm_ssso12,sdm_ssssil, & - & sdm_sssc12,sdm_ssster,bur_ssso12,bur_sssc12,bur_ssssil, & - & bur_ssster -#endif implicit none integer iogrp,cmpflg @@ -1074,87 +1048,87 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) & 'CaCO3 flux to sediment',' ','mol Ca m-2 s-1',0) call ncdefvar3d(SRF_N2OFX(iogrp),cmpflg,'p','n2oflux', & & 'N2O flux',' ','mol N2O m-2 s-1',0) -#ifndef sedbypass - call ncdefvar3d(FLX_SEDIFFIC(iogrp),cmpflg,'p','sedfdic', & - & 'diffusive DIC flux to sediment (positive downwards)', & - & ' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFAL(iogrp),cmpflg,'p','sedfalk', & - & 'diffusive alkalinity flux to sediment (positive downwards)', & - & ' ','mol m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFPH(iogrp),cmpflg,'p','sedfpho', & - & 'diffusive phosphate flux to sediment (positive downwards)', & - & ' ','mol m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFOX(iogrp),cmpflg,'p','sedfox', & - & 'diffusive oxygen flux to sediment (positive downwards)', & - & ' ','mol O2 m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFN2(iogrp),cmpflg,'p','sedfn2', & - & 'diffusive N2 flux to sediment (positive downwards)', & - & ' ','mol N2 m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFNO3(iogrp),cmpflg,'p','sedfno3', & - & 'diffusive nitrate flux to sediment (positive downwards)', & - & ' ','mol NO3 m-2 s-1',0) - call ncdefvar3d(FLX_SEDIFFSI(iogrp),cmpflg,'p','sedfsi', & - & 'diffusive silica flux to sediment (positive downwards)', & - & ' ','mol Si m-2 s-1',0) -#endif -#ifdef cisonew - call ncdefvar3d(SRF_CO213FXD(iogrp),cmpflg,'p','co213fxd', & - & 'Downward 13CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_CO213FXU(iogrp),cmpflg,'p','co213fxu', & - & 'Upward 13CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_CO214FXD(iogrp),cmpflg,'p','co214fxd', & - & 'Downward 14CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_CO214FXU(iogrp),cmpflg,'p','co214fxu', & - & 'Upward 14CO2 flux',' ','kg C m-2 s-1',0) -#endif -#ifdef CFC - call ncdefvar3d(SRF_CFC11(iogrp),cmpflg,'p','cfc11flux', & - & 'CFC-11 flux',' ','mol CFC12 m-2 s-1',0) - call ncdefvar3d(SRF_CFC12(iogrp), & - & cmpflg,'p','cfc12flux','CFC-12 flux',' ','mol CFC12 m-2 s-1',0) - call ncdefvar3d(SRF_SF6(iogrp), & - & cmpflg,'p','sf6flux','SF-6 flux',' ','mol SF6 m-2 s-1',0) -#endif -#ifdef natDIC - call ncdefvar3d(SRF_NATDIC(iogrp),cmpflg,'p','srfnatdissic', & - & 'Surface natural dissolved inorganic carbon',' ','mol C m-3',0) - call ncdefvar3d(SRF_NATALKALI(iogrp),cmpflg,'p','srfnattalk', & - & 'Surface natural alkalinity',' ','eq m-3',0) - call ncdefvar3d(SRF_NATPCO2(iogrp),cmpflg,'p', & - & 'natpco2','Surface natural PCO2',' ','uatm',0) - call ncdefvar3d(SRF_NATCO2FX(iogrp), & - & cmpflg,'p','natco2fx','Natural CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_NATPH(iogrp),cmpflg,'p','srfnatph', & - & 'Surface natural pH',' ','-log10([H+])',0) -#endif -#ifdef BROMO - call ncdefvar3d(SRF_BROMO(iogrp),cmpflg,'p','srfbromo', & - & 'Surface bromoform',' ','mol CHBr3 m-3',0) - call ncdefvar3d(SRF_BROMOfx(iogrp),cmpflg,'p','bromofx', & - & 'Surface bromoform flux',' ','mol CHBr3 m-2 s-1',0) - call ncdefvar3d(INT_BROMOPRO(iogrp),cmpflg,'p','intbromoprod', & - & 'Integrated bromoform production',' ','mol CHBr3 m-2 s-1',0) - call ncdefvar3d(INT_BROMOUV(iogrp),cmpflg,'p','intbromouv', & - & 'Integrated bromoform loss to photolysis',' ', & - & 'mol CHBr3 m-2 s-1',0) - call ncdefvar3d(SRF_ATMBROMO(iogrp),cmpflg,'p', & - & 'atmbromo','Atmospheric bromoform',' ','ppt',0) -#endif + if (.not. use_sedbypass) then + call ncdefvar3d(FLX_SEDIFFIC(iogrp),cmpflg,'p','sedfdic', & + & 'diffusive DIC flux to sediment (positive downwards)', & + & ' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFAL(iogrp),cmpflg,'p','sedfalk', & + & 'diffusive alkalinity flux to sediment (positive downwards)', & + & ' ','mol m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFPH(iogrp),cmpflg,'p','sedfpho', & + & 'diffusive phosphate flux to sediment (positive downwards)', & + & ' ','mol m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFOX(iogrp),cmpflg,'p','sedfox', & + & 'diffusive oxygen flux to sediment (positive downwards)', & + & ' ','mol O2 m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFN2(iogrp),cmpflg,'p','sedfn2', & + & 'diffusive N2 flux to sediment (positive downwards)', & + & ' ','mol N2 m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFNO3(iogrp),cmpflg,'p','sedfno3', & + & 'diffusive nitrate flux to sediment (positive downwards)', & + & ' ','mol NO3 m-2 s-1',0) + call ncdefvar3d(FLX_SEDIFFSI(iogrp),cmpflg,'p','sedfsi', & + & 'diffusive silica flux to sediment (positive downwards)', & + & ' ','mol Si m-2 s-1',0) + end if + if (use_cisonew) then + call ncdefvar3d(SRF_CO213FXD(iogrp),cmpflg,'p','co213fxd', & + & 'Downward 13CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_CO213FXU(iogrp),cmpflg,'p','co213fxu', & + & 'Upward 13CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_CO214FXD(iogrp),cmpflg,'p','co214fxd', & + & 'Downward 14CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_CO214FXU(iogrp),cmpflg,'p','co214fxu', & + & 'Upward 14CO2 flux',' ','kg C m-2 s-1',0) + end if + if (use_CFC) then + call ncdefvar3d(SRF_CFC11(iogrp),cmpflg,'p','cfc11flux', & + & 'CFC-11 flux',' ','mol CFC12 m-2 s-1',0) + call ncdefvar3d(SRF_CFC12(iogrp), & + & cmpflg,'p','cfc12flux','CFC-12 flux',' ','mol CFC12 m-2 s-1',0) + call ncdefvar3d(SRF_SF6(iogrp), & + & cmpflg,'p','sf6flux','SF-6 flux',' ','mol SF6 m-2 s-1',0) + end if + if (use_natDIC) then + call ncdefvar3d(SRF_NATDIC(iogrp),cmpflg,'p','srfnatdissic', & + & 'Surface natural dissolved inorganic carbon',' ','mol C m-3',0) + call ncdefvar3d(SRF_NATALKALI(iogrp),cmpflg,'p','srfnattalk', & + & 'Surface natural alkalinity',' ','eq m-3',0) + call ncdefvar3d(SRF_NATPCO2(iogrp),cmpflg,'p', & + & 'natpco2','Surface natural PCO2',' ','uatm',0) + call ncdefvar3d(SRF_NATCO2FX(iogrp), & + & cmpflg,'p','natco2fx','Natural CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_NATPH(iogrp),cmpflg,'p','srfnatph', & + & 'Surface natural pH',' ','-log10([H+])',0) + end if + if (use_BROMO) then + call ncdefvar3d(SRF_BROMO(iogrp),cmpflg,'p','srfbromo', & + & 'Surface bromoform',' ','mol CHBr3 m-3',0) + call ncdefvar3d(SRF_BROMOfx(iogrp),cmpflg,'p','bromofx', & + & 'Surface bromoform flux',' ','mol CHBr3 m-2 s-1',0) + call ncdefvar3d(INT_BROMOPRO(iogrp),cmpflg,'p','intbromoprod', & + & 'Integrated bromoform production',' ','mol CHBr3 m-2 s-1',0) + call ncdefvar3d(INT_BROMOUV(iogrp),cmpflg,'p','intbromouv', & + & 'Integrated bromoform loss to photolysis',' ', & + & 'mol CHBr3 m-2 s-1',0) + call ncdefvar3d(SRF_ATMBROMO(iogrp),cmpflg,'p', & + & 'atmbromo','Atmospheric bromoform',' ','ppt',0) + end if call ncdefvar3d(SRF_ATMCO2(iogrp),cmpflg,'p', & & 'atmco2','Atmospheric CO2',' ','ppm',0) -#if defined(BOXATM) - call ncdefvar3d(SRF_ATMO2(iogrp),cmpflg,'p', & - & 'atmo2','Atmospheric O2',' ','ppm',0) - call ncdefvar3d(SRF_ATMN2(iogrp),cmpflg,'p', & - & 'atmn2','Atmospheric N2',' ','ppm',0) -#endif -#ifdef cisonew - call ncdefvar3d(SRF_ATMC13(iogrp),cmpflg,'p', & - & 'atmc13','Atmospheric 13CO2',' ','ppm',0) - call ncdefvar3d(SRF_ATMC14(iogrp),cmpflg,'p', & - & 'atmc14','Atmospheric 14CO2',' ','ppm',0) -#endif + if (use_BOXATM) then + call ncdefvar3d(SRF_ATMO2(iogrp),cmpflg,'p', & + & 'atmo2','Atmospheric O2',' ','ppm',0) + call ncdefvar3d(SRF_ATMN2(iogrp),cmpflg,'p', & + & 'atmn2','Atmospheric N2',' ','ppm',0) + end if + if (use_cisonew) then + call ncdefvar3d(SRF_ATMC13(iogrp),cmpflg,'p', & + & 'atmc13','Atmospheric 13CO2',' ','ppm',0) + call ncdefvar3d(SRF_ATMC14(iogrp),cmpflg,'p', & + & 'atmc14','Atmospheric 14CO2',' ','ppm',0) + end if ! --- define 3d layer fields call ncdefvar3d(LYR_DP(iogrp),cmpflg,'p', & @@ -1209,68 +1183,68 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) & 'p_dic','Preformed DIC',' ','mol C m-3',1) call ncdefvar3d(LYR_DICSAT(iogrp),cmpflg,'p', & & 'sat_dic','Saturated DIC',' ','mol C m-3',1) -#ifdef cisonew - call ncdefvar3d(LYR_DIC13(iogrp),cmpflg,'p', & - & 'dissic13','Dissolved C13',' ','mol 13C m-3',1) - call ncdefvar3d(LYR_DIC14(iogrp),cmpflg,'p', & - & 'dissic14','Dissolved C14',' ','mol 14C m-3',1) - call ncdefvar3d(LYR_D13C(iogrp),cmpflg,'p', & - & 'delta13c','delta13C of DIC',' ','permil',1) - call ncdefvar3d(LYR_D14C(iogrp),cmpflg,'p', & - & 'delta14c','delta14C of DIC',' ','permil',1) - call ncdefvar3d(LYR_BIGD14C(iogrp),cmpflg,'p', & - & 'bigdelta14c','big delta14C of DIC',' ','permil',1) - call ncdefvar3d(LYR_POC13(iogrp),cmpflg,'p', & - & 'detoc13','Detritus13',' ','mol P m-3',1) - call ncdefvar3d(LYR_DOC13(iogrp),cmpflg,'p', & - & 'dissoc13','Dissolved organic carbon13',' ','mol P m-3',1) - call ncdefvar3d(LYR_CALC13(iogrp),cmpflg,'p', & - & 'calc13','Ca13CO3 shells',' ','mol 13C m-3',1) - call ncdefvar3d(LYR_PHYTO13(iogrp),cmpflg,'p', & - & 'phyc13','Phytoplankton13',' ','mol P m-3',1) - call ncdefvar3d(LYR_GRAZER13(iogrp),cmpflg,'p', & - & 'zooc13','Zooplankton13',' ','mol P m-3',1) -#endif -#ifdef AGG - call ncdefvar3d(LYR_NOS(iogrp),cmpflg,'p', & - & 'nos','Marine snow aggregates per cm^3 sea water',' ','1/cm^3',1) - call ncdefvar3d(LYR_WPHY(iogrp),cmpflg,'p', & - & 'wphy','Av. mass sinking speed of marine snow',' ','m/day',1) - call ncdefvar3d(LYR_WNOS(iogrp),cmpflg,'p', & - & 'wnos','Av. number sinking speed of marine snow',' ','m/day',1) - call ncdefvar3d(LYR_EPS(iogrp),cmpflg,'p', & - & 'eps','Av. size distribution exponent',' ','-',1) - call ncdefvar3d(LYR_ASIZE(iogrp),cmpflg,'p', & - & 'asize','Av. size of marine snow aggregates',' ','nb. of cells',1) -#endif -#ifdef CFC - call ncdefvar3d(LYR_CFC11(iogrp),cmpflg,'p', & - & 'cfc11','CFC-11',' ','mol cfc11 m-3',1) - call ncdefvar3d(LYR_CFC12(iogrp),cmpflg,'p', & - & 'cfc12','CFC-12',' ','mol cfc12 m-3',1) - call ncdefvar3d(LYR_SF6(iogrp),cmpflg,'p', & - & 'sf6','SF-6',' ','mol sf6 m-3',1) -#endif -#ifdef natDIC - call ncdefvar3d(LYR_NATCO3(iogrp),cmpflg,'p', & - & 'natco3','Natural Carbonate ions',' ','mol C m-3',1) - call ncdefvar3d(LYR_NATALKALI(iogrp),cmpflg,'p','nattalk', & - & 'Natural alkalinity',' ','eq m-3',1) - call ncdefvar3d(LYR_NATDIC(iogrp),cmpflg,'p','natdissic', & - & 'Natural dissolved inorganic carbon',' ','mol C m-3',1) - call ncdefvar3d(LYR_NATCALC(iogrp),cmpflg,'p','natcalc', & - & 'Natural CaCO3',' ','mol C m-3',1) - call ncdefvar3d(LYR_NATPH(iogrp),cmpflg,'p', & - & 'natph','Natural pH',' ','-log10([H+])',1) - call ncdefvar3d(LYR_NATOMEGAA(iogrp),cmpflg,'p','natomegaa', & - & 'Natural OmegaA',' ','1',1) - call ncdefvar3d(LYR_NATOMEGAC(iogrp),cmpflg,'p','natomegac', & - & 'Natural OmegaC',' ','1',1) -#endif -#ifdef BROMO - call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & - & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) -#endif + if (use_cisonew) then + call ncdefvar3d(LYR_DIC13(iogrp),cmpflg,'p', & + & 'dissic13','Dissolved C13',' ','mol 13C m-3',1) + call ncdefvar3d(LYR_DIC14(iogrp),cmpflg,'p', & + & 'dissic14','Dissolved C14',' ','mol 14C m-3',1) + call ncdefvar3d(LYR_D13C(iogrp),cmpflg,'p', & + & 'delta13c','delta13C of DIC',' ','permil',1) + call ncdefvar3d(LYR_D14C(iogrp),cmpflg,'p', & + & 'delta14c','delta14C of DIC',' ','permil',1) + call ncdefvar3d(LYR_BIGD14C(iogrp),cmpflg,'p', & + & 'bigdelta14c','big delta14C of DIC',' ','permil',1) + call ncdefvar3d(LYR_POC13(iogrp),cmpflg,'p', & + & 'detoc13','Detritus13',' ','mol P m-3',1) + call ncdefvar3d(LYR_DOC13(iogrp),cmpflg,'p', & + & 'dissoc13','Dissolved organic carbon13',' ','mol P m-3',1) + call ncdefvar3d(LYR_CALC13(iogrp),cmpflg,'p', & + & 'calc13','Ca13CO3 shells',' ','mol 13C m-3',1) + call ncdefvar3d(LYR_PHYTO13(iogrp),cmpflg,'p', & + & 'phyc13','Phytoplankton13',' ','mol P m-3',1) + call ncdefvar3d(LYR_GRAZER13(iogrp),cmpflg,'p', & + & 'zooc13','Zooplankton13',' ','mol P m-3',1) + end if + if (use_AGG) then + call ncdefvar3d(LYR_NOS(iogrp),cmpflg,'p', & + & 'nos','Marine snow aggregates per cm^3 sea water',' ','1/cm^3',1) + call ncdefvar3d(LYR_WPHY(iogrp),cmpflg,'p', & + & 'wphy','Av. mass sinking speed of marine snow',' ','m/day',1) + call ncdefvar3d(LYR_WNOS(iogrp),cmpflg,'p', & + & 'wnos','Av. number sinking speed of marine snow',' ','m/day',1) + call ncdefvar3d(LYR_EPS(iogrp),cmpflg,'p', & + & 'eps','Av. size distribution exponent',' ','-',1) + call ncdefvar3d(LYR_ASIZE(iogrp),cmpflg,'p', & + & 'asize','Av. size of marine snow aggregates',' ','nb. of cells',1) + end if + if (use_CFC) then + call ncdefvar3d(LYR_CFC11(iogrp),cmpflg,'p', & + & 'cfc11','CFC-11',' ','mol cfc11 m-3',1) + call ncdefvar3d(LYR_CFC12(iogrp),cmpflg,'p', & + & 'cfc12','CFC-12',' ','mol cfc12 m-3',1) + call ncdefvar3d(LYR_SF6(iogrp),cmpflg,'p', & + & 'sf6','SF-6',' ','mol sf6 m-3',1) + end if + if (use_natDIC) then + call ncdefvar3d(LYR_NATCO3(iogrp),cmpflg,'p', & + & 'natco3','Natural Carbonate ions',' ','mol C m-3',1) + call ncdefvar3d(LYR_NATALKALI(iogrp),cmpflg,'p','nattalk', & + & 'Natural alkalinity',' ','eq m-3',1) + call ncdefvar3d(LYR_NATDIC(iogrp),cmpflg,'p','natdissic', & + & 'Natural dissolved inorganic carbon',' ','mol C m-3',1) + call ncdefvar3d(LYR_NATCALC(iogrp),cmpflg,'p','natcalc', & + & 'Natural CaCO3',' ','mol C m-3',1) + call ncdefvar3d(LYR_NATPH(iogrp),cmpflg,'p', & + & 'natph','Natural pH',' ','-log10([H+])',1) + call ncdefvar3d(LYR_NATOMEGAA(iogrp),cmpflg,'p','natomegaa', & + & 'Natural OmegaA',' ','1',1) + call ncdefvar3d(LYR_NATOMEGAC(iogrp),cmpflg,'p','natomegac', & + & 'Natural OmegaC',' ','1',1) + end if + if (use_BROMO) then + call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & + & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) + end if ! --- define 3d level fields call ncdefvar3d(LVL_DIC(iogrp),cmpflg,'p', & @@ -1323,104 +1297,104 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) & 'p_diclvl','Preformed DIC',' ','mol C m-3',2) call ncdefvar3d(LVL_DICSAT(iogrp),cmpflg,'p', & & 'sat_diclvl','Saturated DIC',' ','mol C m-3',2) -#ifdef cisonew - call ncdefvar3d(LVL_DIC13(iogrp),cmpflg,'p', & - & 'dissic13lvl','Dissolved C13',' ','mol 13C m-3',2) - call ncdefvar3d(LVL_DIC14(iogrp),cmpflg,'p', & - & 'dissic14lvl','Dissolved C14',' ','mol 14C m-3',2) - call ncdefvar3d(LVL_D13C(iogrp),cmpflg,'p', & - & 'delta13clvl','delta13C of DIC',' ','permil',2) - call ncdefvar3d(LVL_D14C(iogrp),cmpflg,'p', & - & 'delta14clvl','delta14C of DIC',' ','permil',2) - call ncdefvar3d(LVL_BIGD14C(iogrp),cmpflg,'p', & - & 'bigdelta14clvl','big delta14C of DIC',' ','permil',2) - call ncdefvar3d(LVL_POC13(iogrp),cmpflg,'p', & - & 'detoc13lvl','Detritus13',' ','mol P m-3',2) - call ncdefvar3d(LVL_DOC13(iogrp),cmpflg,'p', & - & 'dissoc13lvl','Dissolved organic carbon13',' ','mol P m-3',2) - call ncdefvar3d(LVL_CALC13(iogrp),cmpflg,'p', & - & 'calc13lvl','Ca13CO3 shells',' ','mol 13C m-3',2) - call ncdefvar3d(LVL_PHYTO13(iogrp),cmpflg,'p', & - & 'phyc13lvl','Phytoplankton13',' ','mol P m-3',2) - call ncdefvar3d(LVL_GRAZER13(iogrp),cmpflg,'p', & - & 'zooc13lvl','Zooplankton13',' ','mol P m-3',2) -#endif -#ifdef AGG - call ncdefvar3d(LVL_NOS(iogrp),cmpflg,'p','noslvl', & - & 'Marine snow aggregates per cm^3 sea water',' ','1/cm^3',2) - call ncdefvar3d(LVL_WPHY(iogrp),cmpflg,'p','wphylvl', & - & 'Av. mass sinking speed of marine snow',' ','m/day',2) - call ncdefvar3d(LVL_WNOS(iogrp),cmpflg,'p','wnoslvl', & - & 'Av. number sinking speed of marine snow',' ','m/day',2) - call ncdefvar3d(LVL_EPS(iogrp),cmpflg,'p','epslvl', & - & 'Av. size distribution exponent',' ','-',2) - call ncdefvar3d(LVL_ASIZE(iogrp),cmpflg,'p','asizelvl', & - & 'Av. size of marine snow aggregates',' ','nb. of cells',2) -#endif -#ifdef CFC - call ncdefvar3d(LVL_CFC11(iogrp),cmpflg,'p', & - & 'cfc11lvl','CFC-11',' ','mol cfc11 m-3',2) - call ncdefvar3d(LVL_CFC12(iogrp),cmpflg,'p', & - & 'cfc12lvl','CFC-12',' ','mol cfc12 m-3',2) - call ncdefvar3d(LVL_SF6(iogrp),cmpflg,'p', & - & 'sf6lvl','SF-6',' ','mol sf6 m-3',2) -#endif -#ifdef natDIC - call ncdefvar3d(LVL_NATCO3(iogrp),cmpflg,'p', & - & 'natco3lvl','Natural Carbonate ions',' ','mol C m-3',2) - call ncdefvar3d(LVL_NATALKALI(iogrp),cmpflg,'p','nattalklvl', & - & 'Natural alkalinity',' ','eq m-3',2) - call ncdefvar3d(LVL_NATDIC(iogrp),cmpflg,'p','natdissiclvl', & - & 'Natual dissolved inorganic carbon',' ','mol C m-3',2) - call ncdefvar3d(LVL_NATCALC(iogrp),cmpflg,'p', & - & 'natcalclvl','Natural CaCO3 shells',' ','mol C m-3',2) - call ncdefvar3d(LVL_NATPH(iogrp),cmpflg,'p', & - & 'natphlvl','Natural pH',' ','-log10([H+])',2) - call ncdefvar3d(LVL_NATOMEGAA(iogrp),cmpflg,'p', & - & 'natomegaalvl','Natural OmegaA',' ','1',2) - call ncdefvar3d(LVL_NATOMEGAC(iogrp),cmpflg,'p', & - & 'natomegaclvl','Natural OmegaC',' ','1',2) -#endif -#ifdef BROMO - call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & - & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) -#endif + if (use_cisonew) then + call ncdefvar3d(LVL_DIC13(iogrp),cmpflg,'p', & + & 'dissic13lvl','Dissolved C13',' ','mol 13C m-3',2) + call ncdefvar3d(LVL_DIC14(iogrp),cmpflg,'p', & + & 'dissic14lvl','Dissolved C14',' ','mol 14C m-3',2) + call ncdefvar3d(LVL_D13C(iogrp),cmpflg,'p', & + & 'delta13clvl','delta13C of DIC',' ','permil',2) + call ncdefvar3d(LVL_D14C(iogrp),cmpflg,'p', & + & 'delta14clvl','delta14C of DIC',' ','permil',2) + call ncdefvar3d(LVL_BIGD14C(iogrp),cmpflg,'p', & + & 'bigdelta14clvl','big delta14C of DIC',' ','permil',2) + call ncdefvar3d(LVL_POC13(iogrp),cmpflg,'p', & + & 'detoc13lvl','Detritus13',' ','mol P m-3',2) + call ncdefvar3d(LVL_DOC13(iogrp),cmpflg,'p', & + & 'dissoc13lvl','Dissolved organic carbon13',' ','mol P m-3',2) + call ncdefvar3d(LVL_CALC13(iogrp),cmpflg,'p', & + & 'calc13lvl','Ca13CO3 shells',' ','mol 13C m-3',2) + call ncdefvar3d(LVL_PHYTO13(iogrp),cmpflg,'p', & + & 'phyc13lvl','Phytoplankton13',' ','mol P m-3',2) + call ncdefvar3d(LVL_GRAZER13(iogrp),cmpflg,'p', & + & 'zooc13lvl','Zooplankton13',' ','mol P m-3',2) + end if + if (use_AGG) then + call ncdefvar3d(LVL_NOS(iogrp),cmpflg,'p','noslvl', & + & 'Marine snow aggregates per cm^3 sea water',' ','1/cm^3',2) + call ncdefvar3d(LVL_WPHY(iogrp),cmpflg,'p','wphylvl', & + & 'Av. mass sinking speed of marine snow',' ','m/day',2) + call ncdefvar3d(LVL_WNOS(iogrp),cmpflg,'p','wnoslvl', & + & 'Av. number sinking speed of marine snow',' ','m/day',2) + call ncdefvar3d(LVL_EPS(iogrp),cmpflg,'p','epslvl', & + & 'Av. size distribution exponent',' ','-',2) + call ncdefvar3d(LVL_ASIZE(iogrp),cmpflg,'p','asizelvl', & + & 'Av. size of marine snow aggregates',' ','nb. of cells',2) + end if + if (use_CFC) then + call ncdefvar3d(LVL_CFC11(iogrp),cmpflg,'p', & + & 'cfc11lvl','CFC-11',' ','mol cfc11 m-3',2) + call ncdefvar3d(LVL_CFC12(iogrp),cmpflg,'p', & + & 'cfc12lvl','CFC-12',' ','mol cfc12 m-3',2) + call ncdefvar3d(LVL_SF6(iogrp),cmpflg,'p', & + & 'sf6lvl','SF-6',' ','mol sf6 m-3',2) + end if + if (use_natDIC) then + call ncdefvar3d(LVL_NATCO3(iogrp),cmpflg,'p', & + & 'natco3lvl','Natural Carbonate ions',' ','mol C m-3',2) + call ncdefvar3d(LVL_NATALKALI(iogrp),cmpflg,'p','nattalklvl', & + & 'Natural alkalinity',' ','eq m-3',2) + call ncdefvar3d(LVL_NATDIC(iogrp),cmpflg,'p','natdissiclvl', & + & 'Natual dissolved inorganic carbon',' ','mol C m-3',2) + call ncdefvar3d(LVL_NATCALC(iogrp),cmpflg,'p', & + & 'natcalclvl','Natural CaCO3 shells',' ','mol C m-3',2) + call ncdefvar3d(LVL_NATPH(iogrp),cmpflg,'p', & + & 'natphlvl','Natural pH',' ','-log10([H+])',2) + call ncdefvar3d(LVL_NATOMEGAA(iogrp),cmpflg,'p', & + & 'natomegaalvl','Natural OmegaA',' ','1',2) + call ncdefvar3d(LVL_NATOMEGAC(iogrp),cmpflg,'p', & + & 'natomegaclvl','Natural OmegaC',' ','1',2) + end if + if (use_BROMO) then + call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & + & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) + end if ! --- define sediment fields -#ifndef sedbypass - call ncdefvar3d(SDM_POWAIC(iogrp),cmpflg,'p', & - & 'powdic','PoWa DIC',' ','mol C m-3',3) - call ncdefvar3d(SDM_POWAAL(iogrp),cmpflg,'p', & - & 'powalk','PoWa alkalinity',' ','eq m-3',3) - call ncdefvar3d(SDM_POWAPH(iogrp),cmpflg,'p', & - & 'powpho','PoWa phosphorus',' ','mol P m-3',3) - call ncdefvar3d(SDM_POWAOX(iogrp),cmpflg,'p', & - & 'powox','PoWa oxygen',' ','mol O2 m-3',3) - call ncdefvar3d(SDM_POWN2(iogrp), cmpflg,'p', & - & 'pown2','PoWa N2',' ','mol N2 m-3',3) - call ncdefvar3d(SDM_POWNO3(iogrp),cmpflg,'p', & - & 'powno3','PoWa nitrate',' ','mol N m-3',3) - call ncdefvar3d(SDM_POWASI(iogrp),cmpflg,'p', & - & 'powsi','PoWa silicate',' ','mol Si m-3',3) - call ncdefvar3d(SDM_SSSO12(iogrp),cmpflg,'p', & - & 'ssso12','Sediment detritus',' ','mol P m-3',3) - call ncdefvar3d(SDM_SSSSIL(iogrp),cmpflg,'p', & - & 'ssssil','Sediment silicate',' ','mol Si m-3',3) - call ncdefvar3d(SDM_SSSC12(iogrp),cmpflg,'p', & - & 'sssc12','Sediment CaCO3',' ','mol C m-3',3) - call ncdefvar3d(SDM_SSSTER(iogrp),cmpflg,'p', & - & 'ssster','Sediment clay',' ','kg m-3',3) + if (.not. use_sedbypass) then + call ncdefvar3d(SDM_POWAIC(iogrp),cmpflg,'p', & + & 'powdic','PoWa DIC',' ','mol C m-3',3) + call ncdefvar3d(SDM_POWAAL(iogrp),cmpflg,'p', & + & 'powalk','PoWa alkalinity',' ','eq m-3',3) + call ncdefvar3d(SDM_POWAPH(iogrp),cmpflg,'p', & + & 'powpho','PoWa phosphorus',' ','mol P m-3',3) + call ncdefvar3d(SDM_POWAOX(iogrp),cmpflg,'p', & + & 'powox','PoWa oxygen',' ','mol O2 m-3',3) + call ncdefvar3d(SDM_POWN2(iogrp), cmpflg,'p', & + & 'pown2','PoWa N2',' ','mol N2 m-3',3) + call ncdefvar3d(SDM_POWNO3(iogrp),cmpflg,'p', & + & 'powno3','PoWa nitrate',' ','mol N m-3',3) + call ncdefvar3d(SDM_POWASI(iogrp),cmpflg,'p', & + & 'powsi','PoWa silicate',' ','mol Si m-3',3) + call ncdefvar3d(SDM_SSSO12(iogrp),cmpflg,'p', & + & 'ssso12','Sediment detritus',' ','mol P m-3',3) + call ncdefvar3d(SDM_SSSSIL(iogrp),cmpflg,'p', & + & 'ssssil','Sediment silicate',' ','mol Si m-3',3) + call ncdefvar3d(SDM_SSSC12(iogrp),cmpflg,'p', & + & 'sssc12','Sediment CaCO3',' ','mol C m-3',3) + call ncdefvar3d(SDM_SSSTER(iogrp),cmpflg,'p', & + & 'ssster','Sediment clay',' ','kg m-3',3) - ! --- define sediment burial fields - call ncdefvar3d(BUR_SSSO12(iogrp), & - & cmpflg,'p','buro12','Burial org carbon',' ','mol P m-2',4) - call ncdefvar3d(BUR_SSSC12(iogrp), & - & cmpflg,'p','burc12','Burial CaCO3',' ','mol C m-2',4) - call ncdefvar3d(BUR_SSSSIL(iogrp), & - & cmpflg,'p','bursil','Burial silicate',' ','mol Si m-2',4) - call ncdefvar3d(BUR_SSSTER(iogrp), & - & cmpflg,'p','burter','Burial clay',' ','kg m-2',4) -#endif + ! --- define sediment burial fields + call ncdefvar3d(BUR_SSSO12(iogrp), & + & cmpflg,'p','buro12','Burial org carbon',' ','mol P m-2',4) + call ncdefvar3d(BUR_SSSC12(iogrp), & + & cmpflg,'p','burc12','Burial CaCO3',' ','mol C m-2',4) + call ncdefvar3d(BUR_SSSSIL(iogrp), & + & cmpflg,'p','bursil','Burial silicate',' ','mol Si m-2',4) + call ncdefvar3d(BUR_SSSTER(iogrp), & + & cmpflg,'p','burter','Burial clay',' ','kg m-2',4) + end if ! --- enddef netcdf file call ncedef diff --git a/hamocc/ocprod.F90 b/hamocc/ocprod.F90 index 14d8682a..1e3de4e7 100644 --- a/hamocc/ocprod.F90 +++ b/hamocc/ocprod.F90 @@ -80,47 +80,28 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! *REAL* *ptho* - potential temperature [deg C]. ! !****************************************************************************** - use mo_carbch, only: dmspar,ocetra,satoxy,hi - use mo_sedmnt, only: prcaca,produs,prorca,silpro + use mo_carbch, only: dmspar,ocetra,satoxy,hi,fbro1,fbro2,co2star + use mo_sedmnt, only: prcaca,produs,prorca,silpro,pror13,pror14,prca13,prca14 use mo_biomod, only: atten_c,atten_uv,atten_w,bkopal,bkphy,bkzoo,bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000, & - & bsiflx_bot,calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot,carflx0100,carflx0500, & - & carflx1000,carflx2000,carflx4000,carflx_bot,dremn2o,dremopal,drempoc,dremsul,dyphy,ecan,epsher,fesoly, & - & gammap,gammaz,grami,grazra,expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy, & - & phosy3d,pi_alpha,phytomi,rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido, & - & riron,rnit,strahl,rnoi,ro2ut,ropal,spemor,wcal,wdust,wopal,wpoc,zinges + bsiflx_bot,calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot,carflx0100,carflx0500, & + carflx1000,carflx2000,carflx4000,carflx_bot,dremn2o,dremopal,drempoc,dremsul,dyphy,ecan,epsher,fesoly, & + gammap,gammaz,grami,grazra,expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy, & + phosy3d,pi_alpha,phytomi,rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido, & + riron,rnit,strahl,rnoi,ro2ut,ropal,spemor,wcal,wdust,wopal,wpoc,zinges use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy,isco212, & - & isilica,izoo - use mo_control_bgc, only: dtb,io_stdo_bgc,with_dmsph + isilica,izoo,iadust,inos,ibromo, & + icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv, & + inatalkali,inatcalc,inatsco212 + use mo_control_bgc, only: dtb,io_stdo_bgc,with_dmsph, & + use_BROMO,use_AGG,use_PBGC_OCNP_TIMESTEP,use_FB_BGC_OCE,use_AGG,use_cisonew,use_natDIC, & + use_WLIN,use_sedbypass use mo_vgrid, only: dp_min,dp_min_sink,k0100,k0500,k1000,k2000,k4000,kwrbioz,ptiestu use mod_xc, only: mnproc - -#ifdef AGG use mo_biomod, only: alar1,alar2,alar3,alow1,alow2,alow3,asize3d,calmax,cellmass,cellsink,dustd1,dustd2,dustd3,dustsink, & - & eps3d,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac,tsfac,vsmall,zdis,wmass,wnumb - use mo_param1_bgc, only: iadust,inos + eps3d,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac,tsfac,vsmall,zdis,wmass,wnumb, & + wmin,wmax,wlin,int_chbr3_prod,int_chbr3_uv,rbro,bifr13,bifr13_perm,bifr14,growth_co2,abs_oce,atten_f use mo_vgrid, only: kmle -#elif defined(WLIN) - use mo_biomod, only: wmin,wmax,wlin -#endif -#ifdef BROMO - use mo_param1_bgc, only: ibromo - use mo_biomod, only: int_chbr3_prod,int_chbr3_uv,rbro - use mo_carbch, only: fbro1,fbro2 use mo_clim_swa, only: swa_clim -#endif -#ifdef cisonew - use mo_biomod, only: bifr13,bifr13_perm,bifr14,growth_co2 - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv - use mo_sedmnt, only: pror13,pror14,prca13,prca14 - use mo_carbch, only: co2star -#endif -#ifdef natDIC - use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 -#endif -#ifdef FB_BGC_OCE - use mo_biomod, only: abs_oce,atten_f -#endif - implicit none @@ -132,29 +113,27 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) real, intent(in) :: pi_ph(kpie,kpje) ! Local varaibles + integer, parameter :: nsinkmax = 12 + real , parameter :: dms_gamma = 0.87 ! dms_ph scaling factor integer :: i,j,k,l integer :: is,kdonor - integer, parameter :: nsinkmax = 12 - real, parameter :: dms_gamma = 0.87 ! dms_ph scaling factor real :: abs_bgc(kpie,kpje,kpke) real :: tco(nsinkmax),tcn(nsinkmax),q(nsinkmax) real :: dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_ph - real :: atten,avphy,avanut,avanfe,pho,xa,xn,ya,yn,phosy, & - & avgra,grazing,avsil,avdic,graton, & - & gratpoc,grawa,bacfra,phymor,zoomor,excdoc,exud, & - & export, delsil, delcar, sterph, sterzo, remin, & - & docrem, opalrem, remin2o, aou,refra,pocrem,phyrem - + real :: atten,avphy,avanut,avanfe,pho,xa,xn,ya,yn,phosy + real :: avgra,grazing,avsil,avdic,graton + real :: gratpoc,grawa,bacfra,phymor,zoomor,excdoc,exud + real :: export, delsil, delcar, sterph, sterzo, remin + real :: docrem, opalrem, remin2o, aou,refra,pocrem,phyrem real :: zoothresh,phythresh real :: temp,temfa,phofa ! temperature and irradiation factor for photosynthesis real :: absorption,absorption_uv real :: dmsprod,dms_bac,dms_uv real :: dtr,dz real :: wpocd,wcald,wopald,dagg -#ifdef sedbypass + ! sedbypass real :: florca,flcaca,flsil -#endif -#ifdef cisonew + ! cisonew real :: phygrowth real :: phosy13,phosy14 real :: grazing13,grazing14 @@ -177,11 +156,9 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) real :: rem13,rem14 real :: rco213,rco214,rdoc13,rdoc14,rdet13,rdet14 real :: rphy13,rphy14,rzoo13,rzoo14 -#ifdef sedbypass + ! sedbypass real :: flor13,flor14,flca13,flca14 -#endif -#endif -#ifdef AGG + ! AGG real :: aggregate(kpie,kpje,kpke) real :: dustagg(kpie,kpje,kpke) real :: avmass, avnos, anosloss @@ -189,12 +166,9 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) real :: TopM,TopF, snow,fshear,sagg1,sagg2,sagg4 real :: sett_agg,shear_agg,effsti,dfirst,dshagg,dsett real :: wnos,wnosd -#endif -#ifdef BROMO + ! BROMO real :: bro_beta,bro_uv real :: abs_uv(kpie,kpje,kpke) -#endif - ! set variables for diagnostic output to zero expoor (:,:) = 0. @@ -221,14 +195,15 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) intdms_bac(:,:) = 0. intdms_uv (:,:) = 0. phosy3d (:,:,:) = 0. -#ifdef BROMO - int_chbr3_uv (:,:) = 0. - int_chbr3_prod (:,:) = 0. -#endif -#ifdef AGG - eps3d(:,:,:) = 0. - asize3d(:,:,:) = 0. -#endif + + if (use_BROMO) then + int_chbr3_uv (:,:) = 0. + int_chbr3_prod (:,:) = 0. + end if + if (use_AGG) then + eps3d(:,:,:) = 0. + asize3d(:,:,:) = 0. + end if ! parameter for DMS scheme (dmspar defined in MO_PARAM_BGC) dmsp6 = dmspar(6) @@ -239,25 +214,24 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) dmsp1 = dmspar(1) -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'beginning of OCRPOD ' - endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif - + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'beginning of OCRPOD ' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) + end if ! Calculate swr absorption by water and phytoplankton abs_bgc(:,:,:) = 0. -#ifdef BROMO - abs_uv(:,:,:) = 0. -#endif -#ifdef FB_BGC_OCE - abs_oce(:,:,:) = 0. - abs_oce(:,:,1) = 1. -#endif + if (use_BROMO) then + abs_uv(:,:,:) = 0. + end if + if (use_FB_BGC_OCE) then + abs_oce(:,:,:) = 0. + abs_oce(:,:,1) = 1. + endif !$OMP PARALLEL DO PRIVATE(i,k,absorption,absorption_uv,atten,dz) do j = 1,kpje @@ -277,15 +251,15 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! Average light intensity in layer k atten = atten_w + atten_c * max(0.,ocetra(i,j,k,iphy)) abs_bgc(i,j,k) = ((absorption/atten)* (1.-exp(-atten*dz)))/dz -#ifdef BROMO - abs_uv(i,j,k) = ((absorption_uv/atten_uv)*(1.-exp(-atten_uv*dz)))/dz -#endif -#ifdef FB_BGC_OCE - abs_oce(i,j,k) = abs_oce(i,j,k) * absorption - if (k == 2) then - abs_oce(i,j,2) = atten_f * absorption + if (use_BROMO) then + abs_uv(i,j,k) = ((absorption_uv/atten_uv)*(1.-exp(-atten_uv*dz)))/dz + endif + if (use_FB_BGC_OCE) then + abs_oce(i,j,k) = abs_oce(i,j,k) * absorption + if (k == 2) then + abs_oce(i,j,2) = atten_f * absorption + endif endif -#endif ! Radiation intensity I_0 at the top of next layer absorption = absorption * exp(-atten*dz) @@ -305,19 +279,13 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) !$OMP ,phosy,ya,yn,grazing,graton,gratpoc,grawa,bacfra,phymor & !$OMP ,zoomor,excdoc,exud,export,delsil,delcar,dmsprod & !$OMP ,dms_bac,dms_uv,dtr,phofa,temfa,zoothresh,dms_ph,dz & -# ifdef AGG !$OMP ,avmass,avnos,zmornos & -# endif -# ifdef cisonew !$OMP ,rco213,rco214,rphy13,rphy14,rzoo13,rzoo14,grazing13,grazing14 & !$OMP ,graton13,graton14,gratpoc13,gratpoc14,grawa13,grawa14 & !$OMP ,phosy13,phosy14,bacfra13,bacfra14,phymor13,phymor14,zoomor13 & !$OMP ,zoomor14,excdoc13,excdoc14,exud13,exud14,export13,export14 & !$OMP ,delcar13,delcar14,dtr13,dtr14,bifr13,bifr14 & -# endif -# ifdef BROMO !$OMP ,bro_beta,bro_uv & -# endif !$OMP ,i,k) loop1: do j = 1,kpje @@ -327,9 +295,9 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then -#ifdef AGG - avmass = ocetra(i,j,k,iphy) + ocetra(i,j,k,idet) -#endif /*AGG*/ + if (use_AGG) then + avmass = ocetra(i,j,k,iphy) + ocetra(i,j,k,idet) + end if temp = min(40.,max(-3.,ptho(i,j,k))) phofa = pi_alpha * strahl(i,j) * abs_bgc(i,j,k) @@ -366,73 +334,74 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) excdoc = gammaz*zoothresh ! excretion of doc by zooplankton export = zoomor*(1.-ecan) + phymor + gratpoc ! ecan=.95, gratpoc= .2*grazing -#ifdef cisonew -! calculation of isotope fractionation during photosynthesis (Laws 1997) - if(ocetra(i,j,k,iphy) < phytomi) then - bifr13 = 1. - else - phygrowth = ((ocetra(i,j,k,iphy)+phosy)/ocetra(i,j,k,iphy))/dtb ! Growth rate phytoplankton [1/d] - growth_co2 = phygrowth/(co2star(i,j,k)*1.e6+safediv) ! CO2* in [mol/kg] - bifr13_perm = (6.03 + 5.5*growth_co2)/(0.225 + growth_co2) ! Permil (~20) - bifr13_perm = max(5.,min(26.,bifr13_perm)) ! Limit the range to [5,26] - bifr13 = (1000. - bifr13_perm) / 1000. ! Fractionation factor 13c (~0.98) - endif + if (use_cisonew) then + ! calculation of isotope fractionation during photosynthesis (Laws 1997) + if(ocetra(i,j,k,iphy) < phytomi) then + bifr13 = 1. + else + phygrowth = ((ocetra(i,j,k,iphy)+phosy)/ocetra(i,j,k,iphy))/dtb ! Growth rate phytoplankton [1/d] + growth_co2 = phygrowth/(co2star(i,j,k)*1.e6+safediv) ! CO2* in [mol/kg] + bifr13_perm = (6.03 + 5.5*growth_co2)/(0.225 + growth_co2) ! Permil (~20) + bifr13_perm = max(5.,min(26.,bifr13_perm)) ! Limit the range to [5,26] + bifr13 = (1000. - bifr13_perm) / 1000. ! Fractionation factor 13c (~0.98) + endif + + bifr14 = bifr13**2 - bifr14 = bifr13**2 + ! calculation of 13C and 14C equivalent of biology + rco213 = ocetra(i,j,k,isco213)/(ocetra(i,j,k,isco212)+safediv) + rco214 = ocetra(i,j,k,isco214)/(ocetra(i,j,k,isco212)+safediv) + rphy13 = ocetra(i,j,k,iphy13)/(ocetra(i,j,k,iphy)+safediv) + rphy14 = ocetra(i,j,k,iphy14)/(ocetra(i,j,k,iphy)+safediv) + rzoo13 = ocetra(i,j,k,izoo13)/(ocetra(i,j,k,izoo)+safediv) + rzoo14 = ocetra(i,j,k,izoo14)/(ocetra(i,j,k,izoo)+safediv) -! calculation of 13C and 14C equivalent of biology - rco213 = ocetra(i,j,k,isco213)/(ocetra(i,j,k,isco212)+safediv) - rco214 = ocetra(i,j,k,isco214)/(ocetra(i,j,k,isco212)+safediv) - rphy13 = ocetra(i,j,k,iphy13)/(ocetra(i,j,k,iphy)+safediv) - rphy14 = ocetra(i,j,k,iphy14)/(ocetra(i,j,k,iphy)+safediv) - rzoo13 = ocetra(i,j,k,izoo13)/(ocetra(i,j,k,izoo)+safediv) - rzoo14 = ocetra(i,j,k,izoo14)/(ocetra(i,j,k,izoo)+safediv) + phosy13 = phosy*bifr13*rco213 + phosy14 = phosy*bifr14*rco214 - phosy13 = phosy*bifr13*rco213 - phosy14 = phosy*bifr14*rco214 + grazing13 = grazing*rphy13 + grazing14 = grazing*rphy14 - grazing13 = grazing*rphy13 - grazing14 = grazing*rphy14 + graton13 = epsher*(1.-zinges)*grazing13 + graton14 = epsher*(1.-zinges)*grazing14 - graton13 = epsher*(1.-zinges)*grazing13 - graton14 = epsher*(1.-zinges)*grazing14 + gratpoc13 = (1.-epsher)*grazing13 + gratpoc14 = (1.-epsher)*grazing14 - gratpoc13 = (1.-epsher)*grazing13 - gratpoc14 = (1.-epsher)*grazing14 + grawa13 = epsher*zinges*grazing13 + grawa14 = epsher*zinges*grazing14 - grawa13 = epsher*zinges*grazing13 - grawa14 = epsher*zinges*grazing14 + bacfra13 = remido*ocetra(i,j,k,idoc13) + bacfra14 = remido*ocetra(i,j,k,idoc14) - bacfra13 = remido*ocetra(i,j,k,idoc13) - bacfra14 = remido*ocetra(i,j,k,idoc14) + phymor13 = phymor*rphy13 + phymor14 = phymor*rphy14 - phymor13 = phymor*rphy13 - phymor14 = phymor*rphy14 + zoomor13 = zoomor*rzoo13 + zoomor14 = zoomor*rzoo14 - zoomor13 = zoomor*rzoo13 - zoomor14 = zoomor*rzoo14 + excdoc13 = excdoc*rzoo13 + excdoc14 = excdoc*rzoo14 - excdoc13 = excdoc*rzoo13 - excdoc14 = excdoc*rzoo14 + exud13 = exud*rphy13 + exud14 = exud*rphy14 - exud13 = exud*rphy13 - exud14 = exud*rphy14 + export13 = zoomor13*(1.-ecan) + phymor13 + gratpoc13 + export14 = zoomor14*(1.-ecan) + phymor14 + gratpoc14 + end if - export13 = zoomor13*(1.-ecan) + phymor13 + gratpoc13 - export14 = zoomor14*(1.-ecan) + phymor14 + gratpoc14 -#endif -#ifdef AGG - delsil = MIN(ropal*phosy*avsil/(avsil+bkopal),0.5*avsil) - delcar = rcalc*MIN(calmax*phosy,(phosy-delsil/ropal)) -! definition of delcar13/14 for the AGG scheme currently missing -#else - delsil = MIN(ropal*export*avsil/(avsil+bkopal),0.5*avsil) - delcar = rcalc * export * bkopal/(avsil+bkopal) -#ifdef cisonew - delcar13 = rcalc * export13 * bkopal/(avsil+bkopal) - delcar14 = rcalc * export14 * bkopal/(avsil+bkopal) -#endif -#endif + if (use_AGG) then + delsil = MIN(ropal*phosy*avsil/(avsil+bkopal),0.5*avsil) + delcar = rcalc*MIN(calmax*phosy,(phosy-delsil/ropal)) + ! definition of delcar13/14 for the AGG scheme currently missing + else + delsil = MIN(ropal*export*avsil/(avsil+bkopal),0.5*avsil) + delcar = rcalc * export * bkopal/(avsil+bkopal) + if (use_cisonew) then + delcar13 = rcalc * export13 * bkopal/(avsil+bkopal) + delcar14 = rcalc * export14 * bkopal/(avsil+bkopal) + end if + end if if(with_dmsph) then dms_ph = 1. + (-log10(hi(i,j,1)) - pi_ph(i,j))*dms_gamma @@ -458,81 +427,81 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ocetra(i,j,k,izoo) = ocetra(i,j,k,izoo)+grawa-excdoc-zoomor ocetra(i,j,k,idoc) = ocetra(i,j,k,idoc)-bacfra+excdoc+exud ocetra(i,j,k,icalc) = ocetra(i,j,k,icalc)+delcar -#ifdef cisonew - dtr13 = bacfra13-phosy13+graton13+ecan*zoomor13 - dtr14 = bacfra14-phosy14+graton14+ecan*zoomor14 - - ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)+export13 - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)+export14 - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)-delcar13+rcar*dtr13 - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)-delcar14+rcar*dtr14 - ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)+phosy13-grazing13-phymor13-exud13 - ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)+phosy14-grazing14-phymor14-exud14 - ocetra(i,j,k,izoo13) = ocetra(i,j,k,izoo13)+grawa13-excdoc13-zoomor13 - ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)+grawa14-excdoc14-zoomor14 - ocetra(i,j,k,idoc13) = ocetra(i,j,k,idoc13)-bacfra13+excdoc13+exud13 - ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)-bacfra14+excdoc14+exud14 - ocetra(i,j,k,icalc13) = ocetra(i,j,k,icalc13)+delcar13 - ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)+delcar14 -#endif -#ifdef natDIC - ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)-delcar+rcar*dtr - ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-2.*delcar-(rnit+1)*dtr - ocetra(i,j,k,inatcalc) = ocetra(i,j,k,inatcalc)+delcar -#endif + if (use_cisonew) then + dtr13 = bacfra13-phosy13+graton13+ecan*zoomor13 + dtr14 = bacfra14-phosy14+graton14+ecan*zoomor14 + + ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)+export13 + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)+export14 + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)-delcar13+rcar*dtr13 + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)-delcar14+rcar*dtr14 + ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)+phosy13-grazing13-phymor13-exud13 + ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)+phosy14-grazing14-phymor14-exud14 + ocetra(i,j,k,izoo13) = ocetra(i,j,k,izoo13)+grawa13-excdoc13-zoomor13 + ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)+grawa14-excdoc14-zoomor14 + ocetra(i,j,k,idoc13) = ocetra(i,j,k,idoc13)-bacfra13+excdoc13+exud13 + ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)-bacfra14+excdoc14+exud14 + ocetra(i,j,k,icalc13) = ocetra(i,j,k,icalc13)+delcar13 + ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)+delcar14 + end if + if (use_natDIC) then + ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)-delcar+rcar*dtr + ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-2.*delcar-(rnit+1)*dtr + ocetra(i,j,k,inatcalc) = ocetra(i,j,k,inatcalc)+delcar + end if ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)-delsil+dremopal*ocetra(i,j,k,iopal) ocetra(i,j,k,iopal) = ocetra(i,j,k,iopal)+delsil-dremopal*ocetra(i,j,k,iopal) ocetra(i,j,k,iiron) = ocetra(i,j,k,iiron)+dtr*riron & & - relaxfe*MAX(ocetra(i,j,k,iiron)-fesoly,0.) -#ifdef BROMO -! Bromo source from phytoplankton production and sink to photolysis -! Hense and Quack (200) Pg537 Decay time scale is 30days =0.0333/day -! sinks owing to degradation by nitrifiers (Pg 538 of Hense and Quack, -! 2009) is omitted because the magnitude is more than 2 order smaller -! than sink through halide substitution & hydrolysis (Fig. 3) -! Assume that only 30% of incoming radiation are UV (i.e. 50% of non-PAR -! radiation; PAR radiationis assume to be 40% of incoming radiation) - bro_beta = rbro*(fbro1*avsil/(avsil+bkopal)+fbro2*bkopal/(avsil+bkopal)) - if (swa_clim(i,j,1) > 0.) then - bro_uv = 0.0333*dtb*0.3*(strahl(i,j)/swa_clim(i,j,1))*abs_uv(i,j,k)*ocetra(i,j,k,ibromo) - else - bro_uv = 0.0 - endif - ocetra(i,j,k,ibromo) = ocetra(i,j,k,ibromo)+bro_beta*phosy-bro_uv -#endif -#ifdef AGG -!*********************************************************************** -! effects of biological processes on number of particles: -! photosynthesis creates POM -! exudation deletes POM -! grazing deletes POM; but only the fraction that is not egested as -! fecal pellets again (grawa remains in zoo, graton goes to po4) -! none of the processes at the current time is assumed to change -! the size distribution (subject to change) -! NOTE that phosy, exud etc. are in kmol/m3! -! Thus divide by avmass (kmol/m3) -!********************************************************************** - - if(avmass > 0.) then - avnos = ocetra(i,j,k,inos) - anosloss = (phosy-exud-graton-grawa)*avnos/avmass - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+anosloss - endif - -!*********************************************************************** -! dead zooplankton corpses come with their own, flat distribution -! this flow even takes place if there is neither nos nor mass -! NOTE: zoomor is in kmol/m3!! Thus multiply flow by 1.e+6 -!*********************************************************************** + if (use_BROMO) then + ! Bromo source from phytoplankton production and sink to photolysis + ! Hense and Quack (200) Pg537 Decay time scale is 30days =0.0333/day + ! sinks owing to degradation by nitrifiers (Pg 538 of Hense and Quack, + ! 2009) is omitted because the magnitude is more than 2 order smaller + ! than sink through halide substitution & hydrolysis (Fig. 3) + ! Assume that only 30% of incoming radiation are UV (i.e. 50% of non-PAR + ! radiation; PAR radiationis assume to be 40% of incoming radiation) + bro_beta = rbro*(fbro1*avsil/(avsil+bkopal)+fbro2*bkopal/(avsil+bkopal)) + if (swa_clim(i,j,1) > 0.) then + bro_uv = 0.0333*dtb*0.3*(strahl(i,j)/swa_clim(i,j,1))*abs_uv(i,j,k)*ocetra(i,j,k,ibromo) + else + bro_uv = 0.0 + endif + ocetra(i,j,k,ibromo) = ocetra(i,j,k,ibromo)+bro_beta*phosy-bro_uv + end if + + if (use_AGG) then + + !*********************************************************************** + ! effects of biological processes on number of particles: + ! photosynthesis creates POM + ! exudation deletes POM + ! grazing deletes POM; but only the fraction that is not egested as + ! fecal pellets again (grawa remains in zoo, graton goes to po4) + ! none of the processes at the current time is assumed to change + ! the size distribution (subject to change) + ! NOTE that phosy, exud etc. are in kmol/m3! + ! Thus divide by avmass (kmol/m3) + !********************************************************************** - zmornos = zoomor * (1.-ecan) * zdis * 1.e+6 - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+zmornos + if(avmass > 0.) then + avnos = ocetra(i,j,k,inos) + anosloss = (phosy-exud-graton-grawa)*avnos/avmass + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+anosloss + endif -#endif /*AGG*/ + !*********************************************************************** + ! dead zooplankton corpses come with their own, flat distribution + ! this flow even takes place if there is neither nos nor mass + ! NOTE: zoomor is in kmol/m3!! Thus multiply flow by 1.e+6 + !*********************************************************************** + zmornos = zoomor * (1.-ecan) * zdis * 1.e+6 + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+zmornos + end if -! add up for total inventory and output + ! add up for total inventory and output dz = pddpo(i,j,k) expoor(i,j) = expoor(i,j) +export*rcar*dz @@ -541,10 +510,12 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) intdmsprod(i,j) = intdmsprod(i,j)+dmsprod*dz intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz intdms_uv(i,j) = intdms_uv (i,j)+dms_uv*dz -#ifdef BROMO - int_chbr3_uv(i,j) = int_chbr3_uv (i,j) + bro_uv*dz - int_chbr3_prod(i,j) = int_chbr3_prod (i,j) + bro_beta*phosy*dz -#endif + + if (use_BROMO) then + int_chbr3_uv(i,j) = int_chbr3_uv (i,j) + bro_uv*dz + int_chbr3_prod(i,j) = int_chbr3_prod (i,j) + bro_beta*phosy*dz + end if + intphosy(i,j) = intphosy(i,j) +phosy*rcar*dz ! primary production in kmol C m-2 phosy3d(i,j,k) = phosy*rcar ! primary production in kmol C m-3 @@ -556,24 +527,20 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) !$OMP END PARALLEL DO -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'in OCRPOD after 1st bio prod' + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'in OCRPOD after 1st bio prod' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif !$OMP PARALLEL DO PRIVATE(phythresh,zoothresh,sterph,sterzo,remin & !$OMP ,opalrem,aou,refra,dms_bac,pocrem,docrem,phyrem,dz & -# ifdef AGG !$OMP ,avmass,avnos,zmornos & -# endif -# ifdef cisonew !$OMP ,rphy13,rphy14,rzoo13,rzoo14,rdet13,rdet14,rdoc13,rdoc14 & !$OMP ,sterph13,sterph14,sterzo13,sterzo14,pocrem13,pocrem14 & !$OMP ,docrem13,docrem14,phyrem13,phyrem14 & -# endif !$OMP ,i,k) loop2: do j = 1,kpje @@ -581,62 +548,62 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) do k = kwrbioz(i,j)+1,kpke if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then -#ifdef AGG - avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) -#endif /*AGG*/ + if (use_AGG) then + avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) + endif temp = min(40.,max(-3.,ptho(i,j,k))) phythresh = MAX(0.,(ocetra(i,j,k,iphy)-2.*phytomi)) zoothresh = MAX(0.,(ocetra(i,j,k,izoo)-2.*grami)) sterph = 0.5*dyphy*phythresh ! phytoplankton to detritus sterzo = spemor*zoothresh*zoothresh ! quadratic mortality -#ifdef cisonew - rphy13 = ocetra(i,j,k,iphy13)/(ocetra(i,j,k,iphy)+safediv) - rphy14 = ocetra(i,j,k,iphy14)/(ocetra(i,j,k,iphy)+safediv) - rzoo13 = ocetra(i,j,k,izoo13)/(ocetra(i,j,k,izoo)+safediv) - rzoo14 = ocetra(i,j,k,izoo14)/(ocetra(i,j,k,izoo)+safediv) - rdet13 = ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) - rdet14 = ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) - rdoc13 = ocetra(i,j,k,idoc13)/(ocetra(i,j,k,idoc)+safediv) - rdoc14 = ocetra(i,j,k,idoc14)/(ocetra(i,j,k,idoc)+safediv) - - sterph13 = sterph*rphy13 - sterph14 = sterph*rphy14 - sterzo13 = sterzo*rzoo13 - sterzo14 = sterzo*rzoo14 -#endif + if (use_cisonew) then + rphy13 = ocetra(i,j,k,iphy13)/(ocetra(i,j,k,iphy)+safediv) + rphy14 = ocetra(i,j,k,iphy14)/(ocetra(i,j,k,iphy)+safediv) + rzoo13 = ocetra(i,j,k,izoo13)/(ocetra(i,j,k,izoo)+safediv) + rzoo14 = ocetra(i,j,k,izoo14)/(ocetra(i,j,k,izoo)+safediv) + rdet13 = ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) + rdet14 = ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) + rdoc13 = ocetra(i,j,k,idoc13)/(ocetra(i,j,k,idoc)+safediv) + rdoc14 = ocetra(i,j,k,idoc14)/(ocetra(i,j,k,idoc)+safediv) + + sterph13 = sterph*rphy13 + sterph14 = sterph*rphy14 + sterzo13 = sterzo*rzoo13 + sterzo14 = sterzo*rzoo14 + endif ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy)-sterph ocetra(i,j,k,izoo) = ocetra(i,j,k,izoo)-sterzo -#ifdef cisonew - ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)-sterph13 - ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)-sterph14 - ocetra(i,j,k,izoo13) = ocetra(i,j,k,izoo13)-sterzo13 - ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)-sterzo14 -#endif + if (use_cisonew) then + ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)-sterph13 + ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)-sterph14 + ocetra(i,j,k,izoo13) = ocetra(i,j,k,izoo13)-sterzo13 + ocetra(i,j,k,izoo14) = ocetra(i,j,k,izoo14)-sterzo14 + endif if(ocetra(i,j,k,ioxygen) > 5.e-8) then pocrem = MIN(drempoc*ocetra(i,j,k,idet),0.33*ocetra(i,j,k,ioxygen)/ro2ut) docrem = MIN( remido*ocetra(i,j,k,idoc),0.33*ocetra(i,j,k,ioxygen)/ro2ut) phyrem = MIN(0.5*dyphy*phythresh, 0.33*ocetra(i,j,k,ioxygen)/ro2ut) -#ifdef cisonew - pocrem13 = pocrem*rdet13 - pocrem14 = pocrem*rdet14 - docrem13 = docrem*rdoc13 - docrem14 = docrem*rdoc14 - phyrem13 = phyrem*rphy13 - phyrem14 = phyrem*rphy14 -#endif + if (use_cisonew) then + pocrem13 = pocrem*rdet13 + pocrem14 = pocrem*rdet14 + docrem13 = docrem*rdoc13 + docrem14 = docrem*rdoc14 + phyrem13 = phyrem*rphy13 + phyrem14 = phyrem*rphy14 + endif else pocrem = 0. docrem = 0. phyrem = 0. -#ifdef cisonew - pocrem13 = 0. - docrem13 = 0. - phyrem13 = 0. - pocrem14 = 0. - docrem14 = 0. - phyrem14 = 0. -#endif + if (use_cisonew) then + pocrem13 = 0. + docrem13 = 0. + phyrem13 = 0. + pocrem14 = 0. + docrem14 = 0. + phyrem14 = 0. + endif endif ocetra(i,j,k,idet) = ocetra(i,j,k,idet) - pocrem + sterph + sterzo @@ -652,21 +619,21 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-ro2ut*remin ocetra(i,j,k,iiron) = ocetra(i,j,k,iiron)+remin*riron & & -relaxfe*MAX(ocetra(i,j,k,iiron)-fesoly,0.) -#ifdef natDIC - ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*remin - ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-(rnit+1)*remin -#endif -#ifdef cisonew - ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-pocrem13+sterph13+sterzo13 - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-pocrem14+sterph14+sterzo14 - ocetra(i,j,k,idoc13) = ocetra(i,j,k,idoc13)-docrem13 - ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)-docrem14 - ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)-phyrem13 - ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)-phyrem14 - - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*(pocrem13+docrem13+phyrem13) - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*(pocrem14+docrem14+phyrem14) -#endif + if (use_natDIC) then + ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*remin + ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-(rnit+1)*remin + endif + if (use_cisonew) then + ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-pocrem13+sterph13+sterzo13 + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-pocrem14+sterph14+sterzo14 + ocetra(i,j,k,idoc13) = ocetra(i,j,k,idoc13)-docrem13 + ocetra(i,j,k,idoc14) = ocetra(i,j,k,idoc14)-docrem14 + ocetra(i,j,k,iphy13) = ocetra(i,j,k,iphy13)-phyrem13 + ocetra(i,j,k,iphy14) = ocetra(i,j,k,iphy14)-phyrem14 + + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*(pocrem13+docrem13+phyrem13) + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*(pocrem14+docrem14+phyrem14) + endif !*********************************************************************** ! as ragueneau (2000) notes, Si(OH)4sat is about 1000 umol, but ! Si(OH)4 varies only between 0-100 umol @@ -693,24 +660,24 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) dz = pddpo(i,j,k) intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz -#ifdef AGG -!*********************************************************************** -! loss of snow numbers due to remineralization of poc -! gain of snow numbers due to zooplankton mortality -! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) -!*********************************************************************** - if(avmass > 0.) then - avnos = ocetra(i,j,k,inos) - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-remin*avnos/avmass - endif -!*********************************************************************** -! dead zooplankton corpses come with their own, flat distribution -! this flow even takes place if there is neither nos nor mass -! NOTE: zoomor is in kmol/m3!! Thus multiply flow by 1.e+6 -!*********************************************************************** - zmornos = sterzo * zdis * 1.e+6 - ocetra(i,j,k,inos) = ocetra(i,j,k,inos) + zmornos -#endif /*AGG*/ + if (use_AGG) then + !*********************************************************************** + ! loss of snow numbers due to remineralization of poc + ! gain of snow numbers due to zooplankton mortality + ! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) + !*********************************************************************** + if(avmass > 0.) then + avnos = ocetra(i,j,k,inos) + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-remin*avnos/avmass + endif + !*********************************************************************** + ! dead zooplankton corpses come with their own, flat distribution + ! this flow even takes place if there is neither nos nor mass + ! NOTE: zoomor is in kmol/m3!! Thus multiply flow by 1.e+6 + !*********************************************************************** + zmornos = sterzo * zdis * 1.e+6 + ocetra(i,j,k,inos) = ocetra(i,j,k,inos) + zmornos + endif/*AGG*/ endif enddo @@ -718,42 +685,36 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) enddo loop2 !$OMP END PARALLEL DO -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'in OCRPOD after poc remin' + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'in OCRPOD after poc remin' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif !$OMP PARALLEL DO PRIVATE(remin,remin2o,dz & -# ifdef AGG !$OMP ,avmass,avnos & -# endif -#ifdef cisonew !$OMP ,rem13,rem14 & -#endif !$OMP ,i,k) loop3: do j = 1,kpje do i = 1,kpie do k = kwrbioz(i,j)+1,kpke if(omask(i,j) > 0.5) then if(ocetra(i,j,k,ioxygen) < 5.e-7 .and. pddpo(i,j,k) > dp_min) then - - -#ifdef AGG - avmass = ocetra(i,j,k,iphy) + ocetra(i,j,k,idet) -#endif /*AGG*/ + if (use_AGG) then + avmass = ocetra(i,j,k,iphy) + ocetra(i,j,k,idet) + endif remin = 0.05 * drempoc * MIN(ocetra(i,j,k,idet), & & 0.5 * ocetra(i,j,k,iano3) / rdnit1) remin2o = dremn2o * MIN(ocetra(i,j,k,idet), & & 0.003 * ocetra(i,j,k,ian2o) / rdn2o1) -#ifdef cisonew - rem13 = (remin+remin2o)*ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) - rem14 = (remin+remin2o)*ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) -#endif + if (use_cisonew) then + rem13 = (remin+remin2o)*ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) + rem14 = (remin+remin2o)*ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) + endif ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)+(rdnit1-1)*remin-remin2o ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*(remin+remin2o) ocetra(i,j,k,idet) = ocetra(i,j,k,idet)-(remin+remin2o) @@ -762,31 +723,31 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ocetra(i,j,k,igasnit) = ocetra(i,j,k,igasnit)+rdnit2*remin+rdn2o2*remin2o ocetra(i,j,k,iiron) = ocetra(i,j,k,iiron)+riron*(remin+remin2o) ocetra(i,j,k,ian2o) = ocetra(i,j,k,ian2o)-rdn2o1*remin2o -#ifdef natDIC - ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)+(rdnit1-1)*remin-remin2o - ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*(remin+remin2o) -#endif -#ifdef cisonew - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*rem13 - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*rem14 - ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-rem13 - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-rem14 -#endif - -! nitrate loss through denitrification in kmol N m-2 + if (use_natDIC) then + ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)+(rdnit1-1)*remin-remin2o + ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*(remin+remin2o) + endif + if (use_cisonew) then + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*rem13 + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*rem14 + ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-rem13 + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-rem14 + endif + + ! nitrate loss through denitrification in kmol N m-2 dz = pddpo(i,j,k) intdnit(i,j) = intdnit(i,j) + rdnit0*remin*dz -#ifdef AGG -!*********************************************************************** -! loss of snow numbers due to remineralization of poc -! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) -!*********************************************************************** - if(avmass > 0.) then - avnos = ocetra(i,j,k,inos) - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-(remin+remin2o)*avnos/avmass - endif -#endif /*AGG*/ + if (use_AGG) then + !*********************************************************************** + ! loss of snow numbers due to remineralization of poc + ! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) + !*********************************************************************** + if(avmass > 0.) then + avnos = ocetra(i,j,k,inos) + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-(remin+remin2o)*avnos/avmass + endif + endif/*AGG*/ endif endif @@ -796,13 +757,13 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) !$OMP END PARALLEL DO -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'in OCRPOD after remin n2o' + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'in OCRPOD after remin n2o' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif !sulphate reduction ! introduced 11.5.2007 to improve poc-remineralisation in the @@ -814,12 +775,8 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! does it make sense to check for oxygen and nitrate deficit? !$OMP PARALLEL DO PRIVATE(remin & -# ifdef AGG !$OMP ,avmass,avnos & -# endif -#ifdef cisonew !$OMP ,rem13,rem14 & -#endif !$OMP ,i,k) loop4: do j = 1,kpje do i = 1,kpie @@ -827,41 +784,41 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) if(omask(i,j) > 0.5 .and. pddpo(i,j,k) > dp_min) then if(ocetra(i,j,k,ioxygen) < 5.e-7 .and. ocetra(i,j,k,iano3) < 3.e-6) then -#ifdef AGG - avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) -#endif /*AGG*/ + if (use_AGG) then + avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) + endif remin = dremsul*ocetra(i,j,k,idet) -#ifdef cisonew - rem13 = remin*ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) - rem14 = remin*ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) -#endif + if (use_cisonew) then + rem13 = remin*ocetra(i,j,k,idet13)/(ocetra(i,j,k,idet)+safediv) + rem14 = remin*ocetra(i,j,k,idet14)/(ocetra(i,j,k,idet)+safediv) + endif ocetra(i,j,k,idet) = ocetra(i,j,k,idet)-remin ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-(rnit+1)*remin ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*remin ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+remin ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+rnit*remin ocetra(i,j,k,iiron) = ocetra(i,j,k,iiron)+riron*remin -#ifdef natDIC - ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-(rnit+1)*remin - ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*remin -#endif -#ifdef cisonew - ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-rem13 - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-rem14 - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*rem13 - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*rem14 -#endif - -#ifdef AGG -!*********************************************************************** -! loss of snow numbers due to remineralization of poc -! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) -!*********************************************************************** - if(avmass > 0.) then - avnos = ocetra(i,j,k,inos) - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-remin*avnos/avmass + if (use_natDIC) then + ocetra(i,j,k,inatalkali) = ocetra(i,j,k,inatalkali)-(rnit+1)*remin + ocetra(i,j,k,inatsco212) = ocetra(i,j,k,inatsco212)+rcar*remin + endif + if (use_cisonew) then + ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)-rem13 + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)-rem14 + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+rcar*rem13 + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+rcar*rem14 + endif + + if (use_AGG) then + !*********************************************************************** + ! loss of snow numbers due to remineralization of poc + ! NOTE that remin is in kmol/m3. Thus divide by avmass (kmol/m3) + !*********************************************************************** + if(avmass > 0.) then + avnos = ocetra(i,j,k,inos) + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-remin*avnos/avmass + endif endif -#endif /*AGG*/ endif endif @@ -871,175 +828,175 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) !$OMP END PARALLEL DO ! end sulphate reduction -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'in OCRPOD after sulphate reduction ' + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'in OCRPOD after sulphate reduction ' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif -#ifdef AGG + if (use_AGG) then + + !**********************AGGREGATION*************************************** + ! General: + ! Sinking speed, size distribution and aggregation are calculated + ! as in Kriest and Evans, 2000. I assume that opal and calcium carbonate + ! sink at the same speed as P (mass). + ! + ! Sinking speed and aggregation: I assume that if there is no phosphorous mass, + ! the sinking speed is the minimum sinking speed of aggregates. I further + ! assume that then there are no particles, and that the rate of aggregation + ! is 0. This scheme removes no P in the absence of P, but still opal and/or + ! calcium carbonate. + ! This could or should be changed, because silica as well as carbonate + ! shell will add to the aggregate mass, and should be considered. + ! Puh. Does anyone know functional relationships between + ! size and Si or CaCO3? Perhaps on a later version, I have to + ! take the relationship bewteen weight and size? + ! + ! Size distribution and resulting loss of marine snow aggregates due to + ! aggregation (aggregate(i,j,k)) and sinking speed of mass and numbers + ! (wmass(i,j,k) and wnumb(i,j,k) are calculated in a loop over 2-kpke. + ! + !************************************************************************ + + wmass(:,:,:) = 0.0 + wnumb(:,:,:) = 0.0 + aggregate(:,:,:) = 0.0 + dustagg(:,:,:) = 0.0 + + do k = 1,kpke + do j = 1,kpje + do i = 1,kpie + + if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then + + !*********************************************************************** + ! Have a special resetting for numbers, that fixes their conc. to one + ! depending on mass of marine snow: + ! Compartments have already been set to 0 in + ! ADVECTION_BGC.h and OCTDIFF_BGC.h. + ! Ensure that if there is no mass, there are no particles, and + ! that the number of particles is in the right range (this is crude, but + ! is supposed to happen only due to numerical errors such as truncation or + ! overshoots during advection) + ! (1) avnos<>avmass, such that Nbar (=Mass/Nos/cellmass) <=1: decrease numbers + ! such that Nbar=1.1 (i.e. 1.1 cells per aggregate, set in BELEG_PARM) + !************************************************************************ + avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) + snow = avmass*1.e+6 + + if(avmass > 0.) then + + ! Set minimum particle number to nmldmin in the mixed layer. This is to prevent + ! very small values of nos (and asscociated high sinking speed if there is mass) + ! in high latitudes during winter + if ( k <= kmle(i,j) ) then + ocetra(i,j,k,inos) = MAX(nmldmin,ocetra(i,j,k,inos)) + endif + + ocetra(i,j,k,inos) = MAX(snow*pupper,ocetra(i,j,k,inos)) + ocetra(i,j,k,inos) = MIN(snow*plower,ocetra(i,j,k,inos)) + + avnos = ocetra(i,j,k,inos) + eps = ((1.+ FractDim)*snow-avnos*cellmass)/(snow-avnos*cellmass) + + ! prevent epsilon from becoming exactly one of the values which are + ! needed for the division (guide from??js) + if (abs(eps-3.) < 1.e-15) eps = 3.+ vsmall + if (abs(eps-4.) < 1.e-15) eps = 4.+ vsmall + if (abs(eps-3.-SinkExp) < 1.e-15) eps = 3.+SinkExp+vsmall + if (abs(eps-1.-SinkExp-FractDim) < 1.e-15) & + & eps = 1.+SinkExp+FractDim+vsmall + + e1 = 1. - eps + e2 = 2. - eps + e3 = 3. - eps + e4 = 4. - eps + es1 = e1 + SinkExp + es3 = e3 + SinkExp + TopF = (alar1/alow1)**e1 + TopM = TopF * TMFac + + ! SINKING SPEED FOR THIS LAYER + wmass(i,j,k) = cellsink * ( (FractDim+e1)/ (FractDim+es1) & + & + TopM * TSFac * SinkExp / (FractDim+es1)) + wnumb(i,j,k) = cellsink * (e1/es1 + TopF*TSFac*SinkExp/es1) + + ! AGGREGATION + + ! As a first step, assume that shear in the mixed layer is high and + ! zero below. + if ( k <= kmle(i,j) ) then + fshear = fsh + else + fshear = 0. + endif + + + ! shear kernel: + sagg1 = (TopF-1.) * (TopF*alar3-alow3) * e1 / e4 & + & + 3. * (TopF*alar1-alow1) & + & * (TopF*alar2-alow2) * e1 * e1 / (e2*e3) + sagg2 = TopF*((alar3 + 3. & + & * (alar2*alow1*e1/e2 + alar1*alow2*e1/e3) + alow3*e1/e4) & + & - TopF*alar3*(1.+3*( e1/e2+ e1/e3)+ e1/e4)) + sagg4 = TopF * TopF * 4. * alar3 + shear_agg = (sagg1+sagg2+sagg4) * fshear + + ! settlement kernel: + sagg1 = (TopF * TopF * alar2 * TSFac - alow2) & + & * SinkExp / (es3 * e3 * (es3 + e1)) & + & + alow2 * ((1. - TopF * TSFac) / (e3 * es1) & + & - (1. - TopF) / (es3*e1)) + sagg2 = TopF * e1 * (TSFac * ( alow2 - TopF * alar2) / e3 & + & - (alow2 - TopF * alar2 * TSFac) / es3) + sett_agg = (e1*e1*sagg1+sagg2) * fse + + effsti = Stick * (ocetra(i,j,k,iopal)*1.e+6/ropal)/ & + & ((ocetra(i,j,k,iopal) * 1.e+6 / ropal) + snow) + + aggregate(i,j,k) = (shear_agg+sett_agg) * effsti * avnos * avnos + + ! dust aggregation: + ! shear kernel: + dfirst = dustd3 + 3. * dustd2 * alar1 + 3. * dustd1 * alar2 + alar3 + dshagg = e1 * fsh * (dfirst * TopF / e1 - ( & + & (TopF-1.)/e1*dustd3 + 3.*(TopF*alar1-alow1)/e2*dustd2 & + & + 3.*(TopF*alar2-alow2)/e3*dustd1 + (TopF*alar3-alow3)/e4)) + + ! settlement kernel: + dsett = fse * dustd2 * ((e1+SinkExp*TopF*TSFac)/es1-dustsink/cellsink) + + dustagg(i,j,k) = effsti * avnos * ocetra(i,j,k,ifdust) & + & * (dshagg+dsett) + + eps3d(i,j,k) = eps + asize3d(i,j,k) = snow / avnos / cellmass + + else + + wmass(i,j,k) = cellsink + wnumb(i,j,k) = 0. + aggregate(i,j,k) = 0. + dustagg(i,j,k) = 0. + ocetra(i,j,k,inos) = 0. + + eps3d(i,j,k) = 1. + asize3d(i,j,k) = 0. + + endif ! avmass > 0 + + endif ! pddpo > dp_min .and. omask > 0.5 + enddo ! i=1,kpie + enddo ! j=1,kpje + enddo ! k=1,kpke -!**********************AGGREGATION*************************************** -! General: -! Sinking speed, size distribution and aggregation are calculated -! as in Kriest and Evans, 2000. I assume that opal and calcium carbonate -! sink at the same speed as P (mass). -! -! Sinking speed and aggregation: I assume that if there is no phosphorous mass, -! the sinking speed is the minimum sinking speed of aggregates. I further -! assume that then there are no particles, and that the rate of aggregation -! is 0. This scheme removes no P in the absence of P, but still opal and/or -! calcium carbonate. -! This could or should be changed, because silica as well as carbonate -! shell will add to the aggregate mass, and should be considered. -! Puh. Does anyone know functional relationships between -! size and Si or CaCO3? Perhaps on a later version, I have to -! take the relationship bewteen weight and size? -! -! Size distribution and resulting loss of marine snow aggregates due to -! aggregation (aggregate(i,j,k)) and sinking speed of mass and numbers -! (wmass(i,j,k) and wnumb(i,j,k) are calculated in a loop over 2-kpke. -! -!************************************************************************ - - wmass(:,:,:) = 0.0 - wnumb(:,:,:) = 0.0 - aggregate(:,:,:) = 0.0 - dustagg(:,:,:) = 0.0 - - do k = 1,kpke - do j = 1,kpje - do i = 1,kpie - - if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - -!*********************************************************************** -! Have a special resetting for numbers, that fixes their conc. to one -! depending on mass of marine snow: -! Compartments have already been set to 0 in -! ADVECTION_BGC.h and OCTDIFF_BGC.h. -! Ensure that if there is no mass, there are no particles, and -! that the number of particles is in the right range (this is crude, but -! is supposed to happen only due to numerical errors such as truncation or -! overshoots during advection) -! (1) avnos<>avmass, such that Nbar (=Mass/Nos/cellmass) <=1: decrease numbers -! such that Nbar=1.1 (i.e. 1.1 cells per aggregate, set in MO_PARAM_BGC) -!************************************************************************ - avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) - snow = avmass*1.e+6 - - if(avmass > 0.) then - -! Set minimum particle number to nmldmin in the mixed layer. This is to prevent -! very small values of nos (and asscociated high sinking speed if there is mass) -! in high latitudes during winter - if ( k <= kmle(i,j) ) then - ocetra(i,j,k,inos) = MAX(nmldmin,ocetra(i,j,k,inos)) - endif - - ocetra(i,j,k,inos) = MAX(snow*pupper,ocetra(i,j,k,inos)) - ocetra(i,j,k,inos) = MIN(snow*plower,ocetra(i,j,k,inos)) - - avnos = ocetra(i,j,k,inos) - eps = ((1.+ FractDim)*snow-avnos*cellmass)/(snow-avnos*cellmass) - -! prevent epsilon from becoming exactly one of the values which are -! needed for the division (guide from??js) - if (abs(eps-3.) < 1.e-15) eps = 3.+ vsmall - if (abs(eps-4.) < 1.e-15) eps = 4.+ vsmall - if (abs(eps-3.-SinkExp) < 1.e-15) eps = 3.+SinkExp+vsmall - if (abs(eps-1.-SinkExp-FractDim) < 1.e-15) & - & eps = 1.+SinkExp+FractDim+vsmall - - e1 = 1. - eps - e2 = 2. - eps - e3 = 3. - eps - e4 = 4. - eps - es1 = e1 + SinkExp - es3 = e3 + SinkExp - TopF = (alar1/alow1)**e1 - TopM = TopF * TMFac - -! SINKING SPEED FOR THIS LAYER - wmass(i,j,k) = cellsink * ( (FractDim+e1)/ (FractDim+es1) & - & + TopM * TSFac * SinkExp / (FractDim+es1)) - wnumb(i,j,k) = cellsink * (e1/es1 + TopF*TSFac*SinkExp/es1) - -! AGGREGATION - -! As a first step, assume that shear in the mixed layer is high and -! zero below. - if ( k <= kmle(i,j) ) then - fshear = fsh - else - fshear = 0. - endif - - -! shear kernel: - sagg1 = (TopF-1.) * (TopF*alar3-alow3) * e1 / e4 & - & + 3. * (TopF*alar1-alow1) & - & * (TopF*alar2-alow2) * e1 * e1 / (e2*e3) - sagg2 = TopF*((alar3 + 3. & - & * (alar2*alow1*e1/e2 + alar1*alow2*e1/e3) + alow3*e1/e4) & - & - TopF*alar3*(1.+3*( e1/e2+ e1/e3)+ e1/e4)) - sagg4 = TopF * TopF * 4. * alar3 - shear_agg = (sagg1+sagg2+sagg4) * fshear - -! settlement kernel: - sagg1 = (TopF * TopF * alar2 * TSFac - alow2) & - & * SinkExp / (es3 * e3 * (es3 + e1)) & - & + alow2 * ((1. - TopF * TSFac) / (e3 * es1) & - & - (1. - TopF) / (es3*e1)) - sagg2 = TopF * e1 * (TSFac * ( alow2 - TopF * alar2) / e3 & - & - (alow2 - TopF * alar2 * TSFac) / es3) - sett_agg = (e1*e1*sagg1+sagg2) * fse - - effsti = Stick * (ocetra(i,j,k,iopal)*1.e+6/ropal)/ & - & ((ocetra(i,j,k,iopal) * 1.e+6 / ropal) + snow) - - aggregate(i,j,k) = (shear_agg+sett_agg) * effsti * avnos * avnos - -! dust aggregation: -! shear kernel: - dfirst = dustd3 + 3. * dustd2 * alar1 + 3. * dustd1 * alar2 + alar3 - dshagg = e1 * fsh * (dfirst * TopF / e1 - ( & - & (TopF-1.)/e1*dustd3 + 3.*(TopF*alar1-alow1)/e2*dustd2 & - & + 3.*(TopF*alar2-alow2)/e3*dustd1 + (TopF*alar3-alow3)/e4)) - -! settlement kernel: - dsett = fse * dustd2 * ((e1+SinkExp*TopF*TSFac)/es1-dustsink/cellsink) - - dustagg(i,j,k) = effsti * avnos * ocetra(i,j,k,ifdust) & - & * (dshagg+dsett) - - eps3d(i,j,k) = eps - asize3d(i,j,k) = snow / avnos / cellmass - - else - - wmass(i,j,k) = cellsink - wnumb(i,j,k) = 0. - aggregate(i,j,k) = 0. - dustagg(i,j,k) = 0. - ocetra(i,j,k,inos) = 0. - - eps3d(i,j,k) = 1. - asize3d(i,j,k) = 0. - - endif ! avmass > 0 - - endif ! pddpo > dp_min .and. omask > 0.5 - enddo ! i=1,kpie - enddo ! j=1,kpje - enddo ! k=1,kpke - -#endif /*AGG*/ + endif ! @@ -1050,9 +1007,7 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! sedimentation=w*dt*C(ks,T+dt) ! !$OMP PARALLEL DO PRIVATE(kdonor,wpoc,wpocd,wcal,wcald,wopal,wopald & -#if defined(AGG) !$OMP ,wnos,wnosd,dagg & -#endif !$OMP ,i,k) do j = 1,kpje do i = 1,kpie @@ -1069,59 +1024,59 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) if( pddpo(i,j,k) > dp_min ) then tco( 1) = tco( 1) + ocetra(i,j,k,idet )*pddpo(i,j,k) tco( 2) = tco( 2) + ocetra(i,j,k,icalc )*pddpo(i,j,k) -#ifdef natDIC - tco( 3) = tco( 3) + ocetra(i,j,k,inatcalc)*pddpo(i,j,k) -#endif + if (use_natDIC) then + tco( 3) = tco( 3) + ocetra(i,j,k,inatcalc)*pddpo(i,j,k) + endif tco( 4) = tco( 4) + ocetra(i,j,k,iopal )*pddpo(i,j,k) tco( 5) = tco( 5) + ocetra(i,j,k,ifdust)*pddpo(i,j,k) -#if defined(AGG) - tco( 6) = tco( 6) + ocetra(i,j,k,iphy )*pddpo(i,j,k) - tco( 7) = tco( 7) + ocetra(i,j,k,inos )*pddpo(i,j,k) - tco( 8) = tco( 8) + ocetra(i,j,k,iadust)*pddpo(i,j,k) -#endif -#ifdef cisonew - tco( 9) = tco( 9) + ocetra(i,j,k,idet13 )*pddpo(i,j,k) - tco(10) = tco(10) + ocetra(i,j,k,idet14 )*pddpo(i,j,k) - tco(11) = tco(11) + ocetra(i,j,k,icalc13)*pddpo(i,j,k) - tco(12) = tco(12) + ocetra(i,j,k,icalc14)*pddpo(i,j,k) -#endif + if (use_AGG) then + tco( 6) = tco( 6) + ocetra(i,j,k,iphy )*pddpo(i,j,k) + tco( 7) = tco( 7) + ocetra(i,j,k,inos )*pddpo(i,j,k) + tco( 8) = tco( 8) + ocetra(i,j,k,iadust)*pddpo(i,j,k) + endif + if (use_cisonew) then + tco( 9) = tco( 9) + ocetra(i,j,k,idet13 )*pddpo(i,j,k) + tco(10) = tco(10) + ocetra(i,j,k,idet14 )*pddpo(i,j,k) + tco(11) = tco(11) + ocetra(i,j,k,icalc13)*pddpo(i,j,k) + tco(12) = tco(12) + ocetra(i,j,k,icalc14)*pddpo(i,j,k) + endif endif if(pddpo(i,j,k) > dp_min_sink) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wpocd = wmass(i,j,kdonor) - wcal = wmass(i,j,k) - wcald = wmass(i,j,kdonor) - wopal = wmass(i,j,k) - wopald = wmass(i,j,kdonor) - wnos = wnumb(i,j,k) - wnosd = wnumb(i,j,kdonor) - wdust = dustsink - dagg = dustagg(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) - wpocd = min(wmin+wlin*ptiestu(i,j,kdonor),wmax) - wcald = wcal - wopald = wopal - dagg = 0.0 -#else - wpocd = wpoc - wcald = wcal - wopald = wopal - dagg = 0.0 -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wpocd = wmass(i,j,kdonor) + wcal = wmass(i,j,k) + wcald = wmass(i,j,kdonor) + wopal = wmass(i,j,k) + wopald = wmass(i,j,kdonor) + wnos = wnumb(i,j,k) + wnosd = wnumb(i,j,kdonor) + wdust = dustsink + dagg = dustagg(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + wpocd = min(wmin+wlin*ptiestu(i,j,kdonor),wmax) + wcald = wcal + wopald = wopal + dagg = 0.0 + else + wpocd = wpoc + wcald = wcal + wopald = wopal + dagg = 0.0 + end if if( k == 1 ) then wpocd = 0.0 wcald = 0.0 wopald = 0.0 -#if defined(AGG) - wnosd = 0.0 -#elif defined(WLIN) - wpoc = wmin -#endif + if (use_AGG) then + wnosd = 0.0 + else if (use_WLIN) then + wpoc = wmin + end if endif ocetra(i,j,k,idet) = (ocetra(i,j,k ,idet) * pddpo(i,j,k) & @@ -1130,64 +1085,64 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ocetra(i,j,k,icalc) = (ocetra(i,j,k ,icalc) * pddpo(i,j,k) & & + ocetra(i,j,kdonor,icalc)*wcald)/ & & (pddpo(i,j,k)+wcal) -#ifdef cisonew - ocetra(i,j,k,idet13) = (ocetra(i,j,k ,idet13) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,idet13)*wpocd)/ & - & (pddpo(i,j,k)+wpoc) - ocetra(i,j,k,idet14) = (ocetra(i,j,k ,idet14) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,idet14)*wpocd)/ & - & (pddpo(i,j,k)+wpoc) - ocetra(i,j,k,icalc13) = (ocetra(i,j,k ,icalc13) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,icalc13)*wcald)/ & - & (pddpo(i,j,k)+wcal) - ocetra(i,j,k,icalc14) = (ocetra(i,j,k ,icalc14) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,icalc14)*wcald)/ & - & (pddpo(i,j,k)+wcal) -#endif -#ifdef natDIC - ocetra(i,j,k,inatcalc) = (ocetra(i,j,k,inatcalc) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,inatcalc)*wcald)/ & - & (pddpo(i,j,k)+wcal) -#endif + if (use_cisonew) then + ocetra(i,j,k,idet13) = (ocetra(i,j,k ,idet13) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,idet13)*wpocd)/ & + & (pddpo(i,j,k)+wpoc) + ocetra(i,j,k,idet14) = (ocetra(i,j,k ,idet14) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,idet14)*wpocd)/ & + & (pddpo(i,j,k)+wpoc) + ocetra(i,j,k,icalc13) = (ocetra(i,j,k ,icalc13) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,icalc13)*wcald)/ & + & (pddpo(i,j,k)+wcal) + ocetra(i,j,k,icalc14) = (ocetra(i,j,k ,icalc14) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,icalc14)*wcald)/ & + & (pddpo(i,j,k)+wcal) + endif + if (use_natDIC) then + ocetra(i,j,k,inatcalc) = (ocetra(i,j,k,inatcalc) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,inatcalc)*wcald)/ & + & (pddpo(i,j,k)+wcal) + endif ocetra(i,j,k,iopal) = (ocetra(i,j,k ,iopal) * pddpo(i,j,k) & & + ocetra(i,j,kdonor,iopal)*wopald)/ & & (pddpo(i,j,k)+wopal) ocetra(i,j,k,ifdust) = (ocetra(i,j,k ,ifdust) * pddpo(i,j,k) & & + ocetra(i,j,kdonor,ifdust)*wdust)/ & & (pddpo(i,j,k)+wdust) - dagg -#ifdef AGG - ocetra(i,j,k,iphy) = (ocetra(i,j,k ,iphy) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,iphy)*wpocd)/ & - & (pddpo(i,j,k)+wpoc) - ocetra(i,j,k,inos) = (ocetra(i,j,k ,inos)*pddpo(i,j,k) & - & + ocetra(i,j,kdonor,inos)*wnosd)/ & - & (pddpo(i,j,k)+wnos) - aggregate(i,j,k) - ocetra(i,j,k,iadust) = (ocetra(i,j,k ,iadust) * pddpo(i,j,k) & - & + ocetra(i,j,kdonor,iadust)*wpocd)/ & - & (pddpo(i,j,k)+wpoc) + dagg -#endif + if (use_AGG) then + ocetra(i,j,k,iphy) = (ocetra(i,j,k ,iphy) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,iphy)*wpocd)/ & + & (pddpo(i,j,k)+wpoc) + ocetra(i,j,k,inos) = (ocetra(i,j,k ,inos)*pddpo(i,j,k) & + & + ocetra(i,j,kdonor,inos)*wnosd)/ & + & (pddpo(i,j,k)+wnos) - aggregate(i,j,k) + ocetra(i,j,k,iadust) = (ocetra(i,j,k ,iadust) * pddpo(i,j,k) & + & + ocetra(i,j,kdonor,iadust)*wpocd)/ & + & (pddpo(i,j,k)+wpoc) + dagg + endif kdonor = k else if( pddpo(i,j,k) > dp_min ) then ocetra(i,j,k,idet) = ocetra(i,j,kdonor,idet) ocetra(i,j,k,icalc) = ocetra(i,j,kdonor,icalc) -#ifdef cisonew - ocetra(i,j,k,idet13) = ocetra(i,j,kdonor,idet13) - ocetra(i,j,k,idet14) = ocetra(i,j,kdonor,idet14) - ocetra(i,j,k,icalc13) = ocetra(i,j,kdonor,icalc13) - ocetra(i,j,k,icalc14) = ocetra(i,j,kdonor,icalc14) -#endif -#ifdef natDIC - ocetra(i,j,k,inatcalc) = ocetra(i,j,kdonor,inatcalc) -#endif + if (use_cisonew) then + ocetra(i,j,k,idet13) = ocetra(i,j,kdonor,idet13) + ocetra(i,j,k,idet14) = ocetra(i,j,kdonor,idet14) + ocetra(i,j,k,icalc13) = ocetra(i,j,kdonor,icalc13) + ocetra(i,j,k,icalc14) = ocetra(i,j,kdonor,icalc14) + endif + if (use_natDIC) then + ocetra(i,j,k,inatcalc) = ocetra(i,j,kdonor,inatcalc) + endif ocetra(i,j,k,iopal) = ocetra(i,j,kdonor,iopal) ocetra(i,j,k,ifdust) = ocetra(i,j,kdonor,ifdust) -#ifdef AGG - ocetra(i,j,k,iphy) = ocetra(i,j,kdonor,iphy) - ocetra(i,j,k,inos) = ocetra(i,j,kdonor,inos) - ocetra(i,j,k,iadust) = ocetra(i,j,kdonor,iadust) -#endif + if (use_AGG) then + ocetra(i,j,k,iphy) = ocetra(i,j,kdonor,iphy) + ocetra(i,j,k,inos) = ocetra(i,j,kdonor,inos) + ocetra(i,j,k,iadust) = ocetra(i,j,kdonor,iadust) + endif endif ! pddpo > dp_min_sink @@ -1196,22 +1151,22 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) if( pddpo(i,j,k) > dp_min ) then tcn( 1) = tcn( 1) + ocetra(i,j,k,idet )*pddpo(i,j,k) tcn( 2) = tcn( 2) + ocetra(i,j,k,icalc )*pddpo(i,j,k) -#ifdef natDIC - tcn( 3) = tcn( 3) + ocetra(i,j,k,inatcalc)*pddpo(i,j,k) -#endif + if (use_natDIC) then + tcn( 3) = tcn( 3) + ocetra(i,j,k,inatcalc)*pddpo(i,j,k) + endif tcn( 4) = tcn( 4) + ocetra(i,j,k,iopal )*pddpo(i,j,k) tcn( 5) = tcn( 5) + ocetra(i,j,k,ifdust)*pddpo(i,j,k) -#if defined(AGG) - tcn( 6) = tcn( 6) + ocetra(i,j,k,iphy )*pddpo(i,j,k) - tcn( 7) = tcn( 7) + ocetra(i,j,k,inos )*pddpo(i,j,k) - tcn( 8) = tcn( 8) + ocetra(i,j,k,iadust)*pddpo(i,j,k) -#endif -#ifdef cisonew - tcn( 9) = tcn( 9) + ocetra(i,j,k,idet13 )*pddpo(i,j,k) - tcn(10) = tcn(10) + ocetra(i,j,k,idet14 )*pddpo(i,j,k) - tcn(11) = tcn(11) + ocetra(i,j,k,icalc13)*pddpo(i,j,k) - tcn(12) = tcn(12) + ocetra(i,j,k,icalc14)*pddpo(i,j,k) -#endif + if (use_AGG) then + tcn( 6) = tcn( 6) + ocetra(i,j,k,iphy )*pddpo(i,j,k) + tcn( 7) = tcn( 7) + ocetra(i,j,k,inos )*pddpo(i,j,k) + tcn( 8) = tcn( 8) + ocetra(i,j,k,iadust)*pddpo(i,j,k) + endif + if (use_cisonew) then + tcn( 9) = tcn( 9) + ocetra(i,j,k,idet13 )*pddpo(i,j,k) + tcn(10) = tcn(10) + ocetra(i,j,k,idet14 )*pddpo(i,j,k) + tcn(11) = tcn(11) + ocetra(i,j,k,icalc13)*pddpo(i,j,k) + tcn(12) = tcn(12) + ocetra(i,j,k,icalc14)*pddpo(i,j,k) + endif endif enddo ! loop k=1,kpke @@ -1220,22 +1175,22 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! Add fluxes to sediment to new total column inventory tcn( 1) = tcn( 1) + ocetra(i,j,kdonor,idet )*wpoc tcn( 2) = tcn( 2) + ocetra(i,j,kdonor,icalc )*wcal -#ifdef natDIC - tcn( 3) = tcn( 3) + ocetra(i,j,kdonor,inatcalc)*wcal -#endif + if (use_natDIC) then + tcn( 3) = tcn( 3) + ocetra(i,j,kdonor,inatcalc)*wcal + endif tcn( 4) = tcn( 4) + ocetra(i,j,kdonor,iopal )*wopal tcn( 5) = tcn( 5) + ocetra(i,j,kdonor,ifdust)*wdust -#if defined(AGG) - tcn( 6) = tcn( 6) + ocetra(i,j,kdonor,iphy )*wpoc - tcn( 7) = tcn( 7) + ocetra(i,j,kdonor,inos )*wnos - tcn( 8) = tcn( 8) + ocetra(i,j,kdonor,iadust)*wpoc -#endif -#ifdef cisonew - tcn( 9) = tcn( 9) + ocetra(i,j,kdonor,idet13 )*wpoc - tcn(10) = tcn(10) + ocetra(i,j,kdonor,idet14 )*wpoc - tcn(11) = tcn(11) + ocetra(i,j,kdonor,icalc13)*wcal - tcn(12) = tcn(12) + ocetra(i,j,kdonor,icalc14)*wcal -#endif + if (use_AGG) then + tcn( 6) = tcn( 6) + ocetra(i,j,kdonor,iphy )*wpoc + tcn( 7) = tcn( 7) + ocetra(i,j,kdonor,inos )*wnos + tcn( 8) = tcn( 8) + ocetra(i,j,kdonor,iadust)*wpoc + endif + if (use_cisonew) then + tcn( 9) = tcn( 9) + ocetra(i,j,kdonor,idet13 )*wpoc + tcn(10) = tcn(10) + ocetra(i,j,kdonor,idet14 )*wpoc + tcn(11) = tcn(11) + ocetra(i,j,kdonor,icalc13)*wcal + tcn(12) = tcn(12) + ocetra(i,j,kdonor,icalc14)*wcal + endif ! Do columnwise multiplicative mass conservation correction q(:) = 1.0 @@ -1246,55 +1201,56 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) if( pddpo(i,j,k) > dp_min ) then ocetra(i,j,k,idet ) = ocetra(i,j,k,idet )*q(1) ocetra(i,j,k,icalc ) = ocetra(i,j,k,icalc )*q(2) -#ifdef natDIC - ocetra(i,j,k,inatcalc) = ocetra(i,j,k,inatcalc)*q(3) -#endif + if (use_natDIC) then + ocetra(i,j,k,inatcalc) = ocetra(i,j,k,inatcalc)*q(3) + endif ocetra(i,j,k,iopal ) = ocetra(i,j,k,iopal )*q(4) ocetra(i,j,k,ifdust) = ocetra(i,j,k,ifdust)*q(5) -#if defined(AGG) - ocetra(i,j,k,iphy ) = ocetra(i,j,k,iphy )*q(6) - ocetra(i,j,k,inos ) = ocetra(i,j,k,inos )*q(7) - ocetra(i,j,k,iadust) = ocetra(i,j,k,iadust)*q(8) -#endif -#ifdef cisonew - ocetra(i,j,k,idet13 ) = ocetra(i,j,k,idet13 )*q(9) - ocetra(i,j,k,idet14 ) = ocetra(i,j,k,idet14 )*q(10) - ocetra(i,j,k,icalc13) = ocetra(i,j,k,icalc13)*q(11) - ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)*q(12) -#endif + if (use_AGG) then + ocetra(i,j,k,iphy ) = ocetra(i,j,k,iphy )*q(6) + ocetra(i,j,k,inos ) = ocetra(i,j,k,inos )*q(7) + ocetra(i,j,k,iadust) = ocetra(i,j,k,iadust)*q(8) + endif + if (use_cisonew) then + ocetra(i,j,k,idet13 ) = ocetra(i,j,k,idet13 )*q(9) + ocetra(i,j,k,idet14 ) = ocetra(i,j,k,idet14 )*q(10) + ocetra(i,j,k,icalc13) = ocetra(i,j,k,icalc13)*q(11) + ocetra(i,j,k,icalc14) = ocetra(i,j,k,icalc14)*q(12) + endif endif enddo ! Fluxes to sediment, layers thinner than dp_min_sink are ignored. ! Note that kdonor=kbo(i,j) by definition since kbo is the lowermost ! layer thicker than dp_min_sink. -#if defined(AGG) - prorca(i,j) = ocetra(i,j,kdonor,iphy )*wpoc & - & + ocetra(i,j,kdonor,idet )*wpoc - prcaca(i,j) = ocetra(i,j,kdonor,icalc )*wcal - silpro(i,j) = ocetra(i,j,kdonor,iopal )*wopal - produs(i,j) = ocetra(i,j,kdonor,ifdust)*wdust & - & + ocetra(i,j,kdonor,iadust)*wpoc -#ifdef cisonew - pror13(i,j) = ocetra(i,j,kdonor,iphy13)*wpoc & - & + ocetra(i,j,kdonor,idet13)*wpoc - pror14(i,j) = ocetra(i,j,kdonor,iphy14)*wpoc & - & + ocetra(i,j,kdonor,idet14)*wpoc - prca13(i,j) = ocetra(i,j,kdonor,icalc13)*wcal - prca14(i,j) = ocetra(i,j,kdonor,icalc14)*wcal -#endif -#else - prorca(i,j) = ocetra(i,j,kdonor,idet )*wpoc - prcaca(i,j) = ocetra(i,j,kdonor,icalc )*wcal - silpro(i,j) = ocetra(i,j,kdonor,iopal )*wopal - produs(i,j) = ocetra(i,j,kdonor,ifdust)*wdust -#ifdef cisonew - pror13(i,j) = ocetra(i,j,kdonor,idet13 )*wpoc - prca13(i,j) = ocetra(i,j,kdonor,icalc13)*wcal - pror14(i,j) = ocetra(i,j,kdonor,idet14 )*wpoc - prca14(i,j) = ocetra(i,j,kdonor,icalc14)*wcal -#endif -#endif + if (use_AGG) then + prorca(i,j) = ocetra(i,j,kdonor,iphy )*wpoc & + & + ocetra(i,j,kdonor,idet )*wpoc + prcaca(i,j) = ocetra(i,j,kdonor,icalc )*wcal + silpro(i,j) = ocetra(i,j,kdonor,iopal )*wopal + produs(i,j) = ocetra(i,j,kdonor,ifdust)*wdust & + & + ocetra(i,j,kdonor,iadust)*wpoc + + if (use_cisonew) then + pror13(i,j) = ocetra(i,j,kdonor,iphy13)*wpoc & + & + ocetra(i,j,kdonor,idet13)*wpoc + pror14(i,j) = ocetra(i,j,kdonor,iphy14)*wpoc & + & + ocetra(i,j,kdonor,idet14)*wpoc + prca13(i,j) = ocetra(i,j,kdonor,icalc13)*wcal + prca14(i,j) = ocetra(i,j,kdonor,icalc14)*wcal + end if + else + prorca(i,j) = ocetra(i,j,kdonor,idet )*wpoc + prcaca(i,j) = ocetra(i,j,kdonor,icalc )*wcal + silpro(i,j) = ocetra(i,j,kdonor,iopal )*wopal + produs(i,j) = ocetra(i,j,kdonor,ifdust)*wdust + if (use_cisonew) then + pror13(i,j) = ocetra(i,j,kdonor,idet13 )*wpoc + prca13(i,j) = ocetra(i,j,kdonor,icalc13)*wcal + pror14(i,j) = ocetra(i,j,kdonor,idet14 )*wpoc + prca14(i,j) = ocetra(i,j,kdonor,icalc14)*wcal + endif + end if endif ! omask > 0.5 enddo ! loop i=1,kpie @@ -1315,19 +1271,19 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! 100 m k = k0100(i,j) if(k > 0) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wcal = wmass(i,j,k) - wopal = wmass(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) -#endif - -#if defined(AGG) - carflx0100(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc -#else - carflx0100(i,j) = ocetra(i,j,k,idet)*rcar*wpoc -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wcal = wmass(i,j,k) + wopal = wmass(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + end if + + if (use_AGG) then + carflx0100(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc + else + carflx0100(i,j) = ocetra(i,j,k,idet)*rcar*wpoc + end if bsiflx0100(i,j) = ocetra(i,j,k,iopal)*wopal calflx0100(i,j) = ocetra(i,j,k,icalc)*wcal endif @@ -1335,19 +1291,19 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! 500 m k = k0500(i,j) if(k > 0) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wcal = wmass(i,j,k) - wopal = wmass(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) -#endif - -#if defined(AGG) - carflx0500(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc -#else - carflx0500(i,j) = ocetra(i,j,k,idet)*rcar*wpoc -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wcal = wmass(i,j,k) + wopal = wmass(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + end if + + if (use_AGG) then + carflx0500(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc + else + carflx0500(i,j) = ocetra(i,j,k,idet)*rcar*wpoc + end if bsiflx0500(i,j) = ocetra(i,j,k,iopal)*wopal calflx0500(i,j) = ocetra(i,j,k,icalc)*wcal endif @@ -1355,19 +1311,19 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! 1000 m k = k1000(i,j) if(k > 0) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wcal = wmass(i,j,k) - wopal = wmass(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) -#endif - -#if defined(AGG) - carflx1000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc -#else - carflx1000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wcal = wmass(i,j,k) + wopal = wmass(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + end if + + if (use_AGG) then + carflx1000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc + else + carflx1000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc + end if bsiflx1000(i,j) = ocetra(i,j,k,iopal)*wopal calflx1000(i,j) = ocetra(i,j,k,icalc)*wcal endif @@ -1375,19 +1331,19 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! 2000 m k = k2000(i,j) if(k > 0) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wcal = wmass(i,j,k) - wopal = wmass(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) -#endif - -#if defined(AGG) - carflx2000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc -#else - carflx2000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wcal = wmass(i,j,k) + wopal = wmass(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + end if + + if (use_AGG) then + carflx2000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc + else + carflx2000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc + end if bsiflx2000(i,j) = ocetra(i,j,k,iopal)*wopal calflx2000(i,j) = ocetra(i,j,k,icalc)*wcal endif @@ -1395,19 +1351,19 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! 4000 m k = k4000(i,j) if(k > 0) then -#if defined(AGG) - wpoc = wmass(i,j,k) - wcal = wmass(i,j,k) - wopal = wmass(i,j,k) -#elif defined(WLIN) - wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) -#endif - -#if defined(AGG) - carflx4000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc -#else - carflx4000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc -#endif + if (use_AGG) then + wpoc = wmass(i,j,k) + wcal = wmass(i,j,k) + wopal = wmass(i,j,k) + else if (use_WLIN) then + wpoc = min(wmin+wlin*ptiestu(i,j,k), wmax) + end if + + if (use_AGG) then + carflx4000(i,j) = (ocetra(i,j,k,idet)+ocetra(i,j,k,iphy))*rcar*wpoc + else + carflx4000(i,j) = ocetra(i,j,k,idet)*rcar*wpoc + end if bsiflx4000(i,j) = ocetra(i,j,k,iopal)*wopal calflx4000(i,j) = ocetra(i,j,k,icalc)*wcal endif @@ -1422,78 +1378,71 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) enddo !$OMP END PARALLEL DO + if (use_sedbypass) then + + ! If sediment bypass is activated, fluxes to the sediment are distributed + ! over the water column. Detritus is kept as detritus, while opal and CaCO3 + ! are remineralised instantanously + + !$OMP PARALLEL DO PRIVATE( & + !$OMP dz,florca,flcaca,flsil & + !$OMP ,flor13,flor14,flca13,flca14 & + !$OMP ,i,k) + do j=1,kpje + do i = 1,kpie + if(omask(i,j) > 0.5) then + + ! calculate depth of water column + dz = 0.0 + do k = 1,kpke + + if( pddpo(i,j,k) > dp_min ) dz = dz+pddpo(i,j,k) + + enddo + + florca = prorca(i,j)/dz + flcaca = prcaca(i,j)/dz + flsil = silpro(i,j)/dz + prorca(i,j) = 0. + prcaca(i,j) = 0. + silpro(i,j) = 0. + if (use_cisonew) then + flor13 = pror13(i,j)/dz + flor14 = pror13(i,j)/dz + flca13 = prca13(i,j)/dz + flca14 = prca14(i,j)/dz + pror13(i,j) = 0. + pror14(i,j) = 0. + prca13(i,j) = 0. + prca14(i,j) = 0. + endif - - -#ifdef sedbypass -! If sediment bypass is activated, fluxes to the sediment are distributed -! over the water column. Detritus is kept as detritus, while opal and CaCO3 -! are remineralised instantanously - -!$OMP PARALLEL DO PRIVATE( & -!$OMP dz,florca,flcaca,flsil & -#ifdef cisonew -!$OMP ,flor13,flor14,flca13,flca14 & -#endif -!$OMP ,i,k) - do j=1,kpje - do i = 1,kpie - if(omask(i,j) > 0.5) then - - ! calculate depth of water column - dz = 0.0 - do k = 1,kpke - - if( pddpo(i,j,k) > dp_min ) dz = dz+pddpo(i,j,k) - + do k = 1,kpke + if( pddpo(i,j,k) <= dp_min ) cycle + + ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+florca + ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)+2.*flcaca + ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+flcaca + ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+flsil + if (use_cisonew) then + ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)+flor13 + ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)+flor14 + ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+flca13 + ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+flca14 + endif + enddo ! k=1,kpke + + endif ! omask > 0.5 enddo + enddo + end if - florca = prorca(i,j)/dz - flcaca = prcaca(i,j)/dz - flsil = silpro(i,j)/dz - prorca(i,j) = 0. - prcaca(i,j) = 0. - silpro(i,j) = 0. -#ifdef cisonew - flor13 = pror13(i,j)/dz - flor14 = pror13(i,j)/dz - flca13 = prca13(i,j)/dz - flca14 = prca14(i,j)/dz - pror13(i,j) = 0. - pror14(i,j) = 0. - prca13(i,j) = 0. - prca14(i,j) = 0. -#endif - - do k = 1,kpke - - if( pddpo(i,j,k) <= dp_min ) cycle - - ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+florca - ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)+2.*flcaca - ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+flcaca - ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+flsil -#ifdef cisonew - ocetra(i,j,k,idet13) = ocetra(i,j,k,idet13)+flor13 - ocetra(i,j,k,idet14) = ocetra(i,j,k,idet14)+flor14 - ocetra(i,j,k,isco213) = ocetra(i,j,k,isco213)+flca13 - ocetra(i,j,k,isco214) = ocetra(i,j,k,isco214)+flca14 -#endif - enddo ! k=1,kpke - - endif ! omask > 0.5 - enddo - enddo -#endif - - -#ifdef PBGC_OCNP_TIMESTEP - if (mnproc == 1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'in OCRPOD after sinking poc ' + if (use_PBGC_OCNP_TIMESTEP) then + if (mnproc == 1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'in OCRPOD after sinking poc ' + endif + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) -#endif - end subroutine ocprod diff --git a/hamocc/powach.F90 b/hamocc/powach.F90 index 540d4c94..b43a0bc6 100644 --- a/hamocc/powach.F90 +++ b/hamocc/powach.F90 @@ -62,19 +62,13 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) use mo_carbch, only: co3,keqb,ocetra,sedfluxo use mo_chemcon, only: calcon use mo_sedmnt, only: porwat,porsol,powtra,produs,prcaca,prorca,rno3,seddw,sedhpl,sedlay,silpro,disso_sil,silsat,disso_poc, & - & sed_denit,disso_caco3 + sed_denit,disso_caco3,pror13,pror14,prca13,prca14 use mo_biomod, only: rnit,ro2ut - use mo_control_bgc, only: dtbgc + use mo_control_bgc, only: dtbgc,use_cisonew use mo_param1_bgc, only: ioxygen,ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isilica,isssc12,issso12,issssil, & - & issster, ks + issster,ks,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv use mo_vgrid, only: kbo,bolay -#ifdef cisonew - use mo_param1_bgc, only: ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv - use mo_sedmnt, only: pror13,pror14,prca13,prca14 -#endif - - implicit none integer, intent(in) :: kpie,kpje,kpke,kbnd @@ -85,22 +79,17 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) ! Local variables integer :: i,j,k,l - real :: sedb1(kpie,0:ks),sediso(kpie,0:ks) real :: solrat(kpie,ks),powcar(kpie,ks) real :: aerob(kpie,ks),anaerob(kpie,ks) -#ifdef cisonew - real :: aerob13(kpie,ks),anaerob13(kpie,ks) - real :: aerob14(kpie,ks),anaerob14(kpie,ks) -#endif + real :: aerob13(kpie,ks),anaerob13(kpie,ks) ! cisonew + real :: aerob14(kpie,ks),anaerob14(kpie,ks) ! cisonew real :: dissot, undsa, posol real :: umfa, denit, saln, rrho, alk, c, sit, pt real :: K1, K2, Kb, Kw, Ks1, Kf, Ksi, K1p, K2p, K3p real :: ah1, ac, cu, cb, cc, satlev real :: ratc13, ratc14, rato13, rato14, poso13, poso14 - - ! number of iterations for carchm_solve - integer, parameter :: niter = 5 + integer, parameter :: niter = 5 ! number of iterations for carchm_solve !****************************************************************************** ! accelerated sediment @@ -133,12 +122,12 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) powcar(i,k) = 0. anaerob(i,k)= 0. aerob(i,k) = 0. -#ifdef cisonew - anaerob13(i,k)=0. - aerob13(i,k) =0. - anaerob14(i,k)=0. - aerob14(i,k) =0. -#endif + if (use_cisonew) then + anaerob13(i,k)=0. + aerob13(i,k) =0. + anaerob14(i,k)=0. + aerob14(i,k) =0. + end if enddo enddo @@ -288,12 +277,12 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) endif sedlay(i,j,1,issso12) = & & sedlay(i,j,1,issso12) + prorca(i,j) / (porsol(i,j,1)*seddw(1)) -#ifdef cisonew - sedlay(i,j,1,issso13) = & - & sedlay(i,j,1,issso13) + pror13(i,j) / (porsol(i,j,1)*seddw(1)) - sedlay(i,j,1,issso14) = & - & sedlay(i,j,1,issso14) + pror14(i,j) / (porsol(i,j,1)*seddw(1)) -#endif + if (use_cisonew) then + sedlay(i,j,1,issso13) = & + & sedlay(i,j,1,issso13) + pror13(i,j) / (porsol(i,j,1)*seddw(1)) + sedlay(i,j,1,issso14) = & + & sedlay(i,j,1,issso14) + pror14(i,j) / (porsol(i,j,1)*seddw(1)) + end if endif enddo @@ -309,25 +298,25 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) solrat(i,k) = sedlay(i,j,k,issso12) * dissot/(1. + dissot*sediso(i,k)) posol = sediso(i,k)*solrat(i,k) aerob(i,k) = posol*umfa !this has P units: kmol P/m3 of pore water -#ifdef cisonew - rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12) + safediv) - rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12) + safediv) - poso13 = posol*rato13 - poso14 = posol*rato14 - aerob13(i,k) = poso13*umfa !this has P units: kmol P/m3 of pore water - aerob14(i,k) = poso14*umfa !this has P units: kmol P/m3 of pore water -#endif + if (use_cisonew) then + rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12) + safediv) + rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12) + safediv) + poso13 = posol*rato13 + poso14 = posol*rato14 + aerob13(i,k) = poso13*umfa !this has P units: kmol P/m3 of pore water + aerob14(i,k) = poso14*umfa !this has P units: kmol P/m3 of pore water + end if sedlay(i,j,k,issso12) = sedlay(i,j,k,issso12) - posol powtra(i,j,k,ipowaph) = powtra(i,j,k,ipowaph) + posol*umfa powtra(i,j,k,ipowno3) = powtra(i,j,k,ipowno3) + posol*rnit*umfa powtra(i,j,k,ipowaox) = sediso(i,k) -#ifdef cisonew - sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 - sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 - ! is this correct? no correspondance in the lines above - powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13*umfa - powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14*umfa -#endif + if (use_cisonew) then + sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 + sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 + ! is this correct? no correspondance in the lines above + powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13*umfa + powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14*umfa + end if endif enddo enddo @@ -345,25 +334,25 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) & sedlay(i,j,k,issso12)) umfa = porsol(i,j,k)/porwat(i,j,k) anaerob(i,k) = posol*umfa !this has P units: kmol P/m3 of pore water -#ifdef cisonew - rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12) + safediv) - rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12) + safediv) - poso13 = posol * rato13 - poso14 = posol * rato14 - anaerob13(i,k) = poso13*umfa !this has P units: kmol P/m3 of pore water - anaerob14(i,k) = poso14*umfa !this has P units: kmol P/m3 of pore water -#endif + if (use_cisonew) then + rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12) + safediv) + rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12) + safediv) + poso13 = posol * rato13 + poso14 = posol * rato14 + anaerob13(i,k) = poso13*umfa !this has P units: kmol P/m3 of pore water + anaerob14(i,k) = poso14*umfa !this has P units: kmol P/m3 of pore water + end if sedlay(i,j,k,issso12) = sedlay(i,j,k,issso12) - posol powtra(i,j,k,ipowaph) = powtra(i,j,k,ipowaph) + posol*umfa powtra(i,j,k,ipowno3) = powtra(i,j,k,ipowno3) - 98.*posol*umfa powtra(i,j,k,ipown2) = powtra(i,j,k,ipown2) + 57.*posol*umfa -#ifdef cisonew - sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 - sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 - ! is this correct? no corresponance in the lines above - powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13*umfa - powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14*umfa -#endif + if (use_cisonew) then + sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 + sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 + ! is this correct? no corresponance in the lines above + powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13*umfa + powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14*umfa + end if endif endif enddo @@ -379,21 +368,21 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) umfa = porsol(i,j,k) / porwat(i,j,k) !this overwrites anaerob from denitrification. added =anaerob+..., works anaerob(i,k) = anaerob(i,k) + posol*umfa !this has P units: kmol P/m3 of pore water -#ifdef cisonew - rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12)+safediv) - rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12)+safediv) - poso13 = posol * rato13 - poso14 = posol * rato14 - anaerob13(i,k) = anaerob13(i,k) + poso13*umfa !this has P units: kmol P/m3 of pore water - anaerob14(i,k) = anaerob13(i,k) + poso14*umfa !this has P units: kmol P/m3 of pore water -#endif + if (use_cisonew) then + rato13 = sedlay(i,j,k,issso13) / (sedlay(i,j,k,issso12)+safediv) + rato14 = sedlay(i,j,k,issso14) / (sedlay(i,j,k,issso12)+safediv) + poso13 = posol * rato13 + poso14 = posol * rato14 + anaerob13(i,k) = anaerob13(i,k) + poso13*umfa !this has P units: kmol P/m3 of pore water + anaerob14(i,k) = anaerob13(i,k) + poso14*umfa !this has P units: kmol P/m3 of pore water + end if sedlay(i,j,k,issso12) = sedlay(i,j,k,issso12) - posol powtra(i,j,k,ipowaph) = powtra(i,j,k,ipowaph) + posol*umfa powtra(i,j,k,ipowno3) = powtra(i,j,k,ipowno3) + posol*umfa*rno3 -#ifdef cisonew - sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 - sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 -#endif + if (use_cisonew) then + sedlay(i,j,k,issso13) = sedlay(i,j,k,issso13) - poso13 + sedlay(i,j,k,issso14) = sedlay(i,j,k,issso14) - poso14 + end if endif endif enddo @@ -491,12 +480,12 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) if(omask(i,j) > 0.5) then sedlay(i,j,1,isssc12) = & & sedlay(i,j,1,isssc12) + prcaca(i,j) / (porsol(i,j,1)*seddw(1)) -#ifdef cisonew - sedlay(i,j,1,isssc13) = & - & sedlay(i,j,1,isssc13) + prca13(i,j) / (porsol(i,j,1)*seddw(1)) - sedlay(i,j,1,isssc14) = & - & sedlay(i,j,1,isssc14) + prca14(i,j) / (porsol(i,j,1)*seddw(1)) -#endif + if (use_cisonew) then + sedlay(i,j,1,isssc13) = & + & sedlay(i,j,1,isssc13) + prca13(i,j) / (porsol(i,j,1)*seddw(1)) + sedlay(i,j,1,isssc14) = & + & sedlay(i,j,1,isssc14) + prca14(i,j) / (porsol(i,j,1)*seddw(1)) + end if endif enddo @@ -513,25 +502,25 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) solrat(i,k) = sedlay(i,j,k,isssc12) & & * dissot / (1. + dissot * sediso(i,k)) posol = sediso(i,k) * solrat(i,k) -#ifdef cisonew - ratc13 = sedlay(i,j,k,isssc13) / (sedlay(i,j,k,isssc12) + safediv) - ratc14 = sedlay(i,j,k,isssc14) / (sedlay(i,j,k,isssc12) + safediv) - poso13 = posol * ratc13 - poso14 = posol * ratc14 -#endif + if (use_cisonew) then + ratc13 = sedlay(i,j,k,isssc13) / (sedlay(i,j,k,isssc12) + safediv) + ratc14 = sedlay(i,j,k,isssc14) / (sedlay(i,j,k,isssc12) + safediv) + poso13 = posol * ratc13 + poso14 = posol * ratc14 + end if sedlay(i,j,k,isssc12) = sedlay(i,j,k,isssc12) - posol powtra(i,j,k,ipowaic) = powtra(i,j,k,ipowaic) & & + posol * umfa + (aerob(i,k) + anaerob(i,k)) * 122. powtra(i,j,k,ipowaal) = powtra(i,j,k,ipowaal) & & + 2. * posol * umfa - 16. * (aerob(i,k) + anaerob(i,k)) -#ifdef cisonew - sedlay(i,j,k,isssc13) = sedlay(i,j,k,isssc13) - poso13 - sedlay(i,j,k,isssc14) = sedlay(i,j,k,isssc14) - poso14 - powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13 * umfa & - & + (aerob13(i,k) + anaerob13(i,k)) * 122. - powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14 * umfa & - & + (aerob14(i,k) + anaerob14(i,k)) * 122. -#endif + if (use_cisonew) then + sedlay(i,j,k,isssc13) = sedlay(i,j,k,isssc13) - poso13 + sedlay(i,j,k,isssc14) = sedlay(i,j,k,isssc14) - poso14 + powtra(i,j,k,ipowc13) = powtra(i,j,k,ipowc13) + poso13 * umfa & + & + (aerob13(i,k) + anaerob13(i,k)) * 122. + powtra(i,j,k,ipowc14) = powtra(i,j,k,ipowc14) + poso14 * umfa & + & + (aerob14(i,k) + anaerob14(i,k)) * 122. + end if endif enddo enddo @@ -564,12 +553,12 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) silpro(i,j) = 0. prorca(i,j) = 0. prcaca(i,j) = 0. -#ifdef cisonew - pror13(i,j) = 0. - pror14(i,j) = 0. - prca13(i,j) = 0. - prca14(i,j) = 0. -#endif + if (use_cisonew) then + pror13(i,j) = 0. + pror14(i,j) = 0. + prca13(i,j) = 0. + prca14(i,j) = 0. + end if produs(i,j) = 0. enddo enddo diff --git a/hamocc/profile_gd.F90 b/hamocc/profile_gd.F90 index cdc72971..a31ce46d 100644 --- a/hamocc/profile_gd.F90 +++ b/hamocc/profile_gd.F90 @@ -47,12 +47,12 @@ subroutine profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) use mo_control_bgc, only: io_stdo_bgc use mo_vgrid, only: ptiestw use mo_param1_bgc, only: ialkali,iano3,ioxygen,iphosph,isco212,isilica -#ifdef cisonew - use mo_param1_bgc, only: isco213,isco214 -#endif -#ifdef natDIC - use mo_param1_bgc, only: inatalkali,inatsco212 -#endif +! cisonew +use mo_param1_bgc, only: isco213,isco214 +! natDIC +use mo_param1_bgc, only: inatalkali,inatsco212 +use mo_control_bgc, only: use_natDIC,use_cisonew + implicit none integer, intent(in) :: kpie,kpje,kpke,kbnd @@ -82,19 +82,19 @@ subroutine profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) -#ifdef natDIC -no = nflds+1 -nflds = nflds+nread_ndic -vname(no:nflds) = (/'dic', 'alk'/) - ifld(no:nflds) = (/inatsco212,inatalkali/) -#endif - -#ifdef cisonew -no = nflds+1 -nflds = nflds+nread_ciso -vname(no:nflds) = (/'d13', 'd14'/) - ifld(no:nflds) = (/isco213,isco214/) -#endif + if (use_natDIC) then + no = nflds+1 + nflds = nflds+nread_ndic + vname(no:nflds) = (/'dic', 'alk'/) + ifld(no:nflds) = (/inatsco212,inatalkali/) + end if + + if (use_cisonew) then + no = nflds+1 + nflds = nflds+nread_ciso + vname(no:nflds) = (/'d13', 'd14'/) + ifld(no:nflds) = (/isco213,isco214/) + end if do n = 1, nflds ! Loop over tracer diff --git a/hamocc/sedshi.F90 b/hamocc/sedshi.F90 index 4d032d3b..e5415364 100644 --- a/hamocc/sedshi.F90 +++ b/hamocc/sedshi.F90 @@ -53,10 +53,10 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu use mo_biomod, only: rcar - use mo_param1_bgc, only: isssc12,issssil,issso12,issster,ks,nsedtra -#ifdef cisonew - use mo_param1_bgc, only: isssc13,isssc14,issso13,issso14 -#endif + use mo_param1_bgc, only: isssc12,issssil,issso12,issster,ks,nsedtra, & + isssc13,isssc14,issso13,issso14 + use mo_control_bgc, only: use_cisonew + implicit none INTEGER :: kpie,kpje,i,j,k,l,iv @@ -230,16 +230,17 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) sedlay(i,j,ks,issster)=sedlay(i,j,ks,issster) & & +refill*burial(i,j,issster)/frac -#ifdef cisonew - sedlay(i,j,ks,issso13)=sedlay(i,j,ks,issso13) & - & +refill*burial(i,j,issso13)/frac - sedlay(i,j,ks,isssc13)=sedlay(i,j,ks,isssc13) & - & +refill*burial(i,j,isssc13)/frac - sedlay(i,j,ks,issso14)=sedlay(i,j,ks,issso14) & - & +refill*burial(i,j,issso14)/frac - sedlay(i,j,ks,isssc14)=sedlay(i,j,ks,isssc14) & - & +refill*burial(i,j,isssc14)/frac -#endif + if (use_cisonew) then + sedlay(i,j,ks,issso13)=sedlay(i,j,ks,issso13) & + & +refill*burial(i,j,issso13)/frac + sedlay(i,j,ks,isssc13)=sedlay(i,j,ks,isssc13) & + & +refill*burial(i,j,isssc13)/frac + sedlay(i,j,ks,issso14)=sedlay(i,j,ks,issso14) & + & +refill*burial(i,j,issso14)/frac + sedlay(i,j,ks,isssc14)=sedlay(i,j,ks,isssc14) & + & +refill*burial(i,j,isssc14)/frac + end if + ! account for losses in buried sediment burial(i,j,issso12) = burial(i,j,issso12) & & - refill*burial(i,j,issso12) @@ -249,16 +250,16 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) & - refill*burial(i,j,issssil) burial(i,j,issster) = burial(i,j,issster) & & - refill*burial(i,j,issster) -#ifdef cisonew - burial(i,j,issso13) = burial(i,j,issso13) & - & - refill*burial(i,j,issso13) - burial(i,j,isssc13) = burial(i,j,isssc13) & - & - refill*burial(i,j,isssc13) - burial(i,j,issso14) = burial(i,j,issso14) & - & - refill*burial(i,j,issso14) - burial(i,j,isssc14) = burial(i,j,isssc14) & - & - refill*burial(i,j,isssc14) -#endif + if (use_cisonew) then + burial(i,j,issso13) = burial(i,j,issso13) & + & - refill*burial(i,j,issso13) + burial(i,j,isssc13) = burial(i,j,isssc13) & + & - refill*burial(i,j,isssc13) + burial(i,j,issso14) = burial(i,j,issso14) & + & - refill*burial(i,j,issso14) + burial(i,j,isssc14) = burial(i,j,isssc14) & + & - refill*burial(i,j,isssc14) + end if endif enddo !end i-loop enddo !end j-loop @@ -299,6 +300,5 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) enddo !end k-loop - RETURN - END + END SUBROUTINE SEDSHI diff --git a/phy/mod_ifdefs.F90 b/phy/mod_ifdefs.F90 new file mode 100644 index 00000000..624060e0 --- /dev/null +++ b/phy/mod_ifdefs.F90 @@ -0,0 +1,22 @@ +module mod_ifdefs + + implicit none + public + +#ifdef TRC + logical, parameter :: use_TRC = .true. +#else + logical, parameter :: use_TRC = .false. +#endif +#ifdef TKE + logical, parameter :: use_TKE = .true. +#else + logical, parameter :: use_TKE = .false. +#endif +#ifdef IDLAGE + logical, parameter :: use_IDLAGE = .true. +#else + logical, parameter :: use_IDLAGE = .false. +#endif + +end module mod_ifdefs diff --git a/phy/restart_wt.F b/phy/restart_wt.F index 77faa50b..619d8607 100644 --- a/phy/restart_wt.F +++ b/phy/restart_wt.F @@ -62,9 +62,12 @@ subroutine restart_wt use mod_seaice, only: ficem, hicem, hsnwm, iagem #if defined(TRC) && (defined(TKE) || defined(IDLAGE)) use mod_tracers, only: itrtke, itrgls, itriag, trc -# ifdef TKE +#ifdef TKE use mod_tke, only: L_scale -# endif +#endif +#endif +#ifdef HAMOCC + use mo_control_bgc, only : use_BROMO #endif c implicit none @@ -370,8 +373,10 @@ subroutine restart_wt call wrtrst('mltpot',trim(c5p)//' time',mltpot,ip) call wrtrst('flxco2',trim(c5p)//' time',flxco2,ip) call wrtrst('flxdms',trim(c5p)//' time',flxdms,ip) -#ifdef BROMO - call wrtrst('flxbrf',trim(c5p)//' time',flxbrf,ip) +#ifdef HAMOCC + if (use_BROMO) then + call wrtrst('flxbrf',trim(c5p)//' time',flxbrf,ip) + end if #endif endif c @@ -901,6 +906,9 @@ subroutine defvar_restart(c5p,c5u,c5v,c5q) c --- ------------------------------------------------------------------ use mod_dia use mod_forcing, only: sprfac +#ifdef HAMOCC + use mo_control_bgc, only : use_BROMO +#endif c implicit none c @@ -1046,8 +1054,10 @@ subroutine defvar_restart(c5p,c5u,c5v,c5q) call defvarrst('mltpot',trim(c5p)//' time') call defvarrst('flxco2',trim(c5p)//' time') call defvarrst('flxdms',trim(c5p)//' time') -#ifdef BROMO - call defvarrst('flxbrf',trim(c5p)//' time') +#ifdef HAMOCC + if (use_BROMO) then + call defvarrst('flxbrf',trim(c5p)//' time') + end if #endif endif c diff --git a/trc/mod_tracers.F90 b/trc/mod_tracers.F90 index 6952fa40..85d27d34 100644 --- a/trc/mod_tracers.F90 +++ b/trc/mod_tracers.F90 @@ -90,7 +90,7 @@ subroutine allocate_tracers ! --------------------------------------------------------------------------- #ifdef HAMOCC - use mo_param1_bgc, only: nocetra + use mo_param1_bgc, only: init_indices, nocetra #endif implicit none @@ -100,6 +100,7 @@ subroutine allocate_tracers ! Number of HAMOCC tracers. #ifdef HAMOCC + call init_indices() ntrbgc = nocetra itrbgc = ntrocn - natr + ntrtke + ntrgls + ntriag + 1 #else diff --git a/trc/restart_trcrd.F90 b/trc/restart_trcrd.F90 index bbe636fe..aff3fba1 100644 --- a/trc/restart_trcrd.F90 +++ b/trc/restart_trcrd.F90 @@ -32,8 +32,12 @@ subroutine restart_trcrd(rstfnm_ocn) logical :: error character(len=256) :: rstfnm_ocntrc -#ifdef HAMOCC + ! HAMOCC character(len=256) :: rstfnm_hamocc +#ifdef HAMOCC + logical :: use_hamocc = .true. +#else + logical :: use_hamocc = .false. #endif ! ! --- ------------------------------------------------------------------ @@ -48,14 +52,14 @@ subroutine restart_trcrd(rstfnm_ocn) call xcstop('(restat_trcrd)') stop '(restart_trcrd)' endif -#ifdef HAMOCC - call restart_getfile(rstfnm_ocn, 'rbgc', rstfnm_hamocc, error) - if (error) then - write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!' - call xcstop('(restat_trcrd)') - stop '(restart_trcrd)' - endif -#endif + if (use_HAMOCC) then + call restart_getfile(rstfnm_ocn, 'rbgc', rstfnm_hamocc, error) + if (error) then + write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!' + call xcstop('(restat_trcrd)') + stop '(restart_trcrd)' + endif + end if else call restart_getfile(rstfnm_ocn, 'resttrc', rstfnm_ocntrc, error) if (error) then @@ -63,21 +67,21 @@ subroutine restart_trcrd(rstfnm_ocn) call xcstop('(restat_trcrd)') stop '(restart_trcrd)' endif -#ifdef HAMOCC - call restart_getfile(rstfnm_ocn, 'restbgc', rstfnm_hamocc, error) - if (error) then - write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!' - call xcstop('(restat_trcrd)') - stop '(restart_trcrd)' - endif -#endif + if (use_HAMOCC) then + call restart_getfile(rstfnm_ocn, 'restbgc', rstfnm_hamocc, error) + if (error) then + write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!' + call xcstop('(restat_trcrd)') + stop '(restart_trcrd)' + endif + end if endif endif call xcbcst(rstfnm_ocntrc) -#ifdef HAMOCC - call xcbcst(rstfnm_hamocc) -#endif + if (use_HAMOCC) then + call xcbcst(rstfnm_hamocc) + end if ! ! --- ------------------------------------------------------------------ @@ -86,9 +90,9 @@ subroutine restart_trcrd(rstfnm_ocn) ! call restart_ocntrcrd(rstfnm_ocntrc) -#ifdef HAMOCC - call hamocc_init(1,rstfnm_hamocc) -#endif + if (use_HAMOCC) then + call hamocc_init(1,rstfnm_hamocc) + end if return end subroutine restart_trcrd